From d2f7e12bd915f278f68fefbba13593feeeaa9b3e Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Wed, 29 Oct 2014 14:37:52 +0100
Subject: [PATCH] More QQ tests.

---
 test/Servant/API/QQSpec.hs | 78 ++++++++++++++++++++++++++++++++------
 1 file changed, 67 insertions(+), 11 deletions(-)

diff --git a/test/Servant/API/QQSpec.hs b/test/Servant/API/QQSpec.hs
index 9a201911..e0afa90f 100644
--- a/test/Servant/API/QQSpec.hs
+++ b/test/Servant/API/QQSpec.hs
@@ -14,6 +14,66 @@ import Test.Hspec
 import Servant.API
 {-import Servant.API.QQ-}
 
+--------------------------------------------------------------------------
+-- Types for testing
+--------------------------------------------------------------------------
+
+
+type SimpleGet = [sitemap|
+GET  hello  ()
+|]
+type SimpleGet' = "hello" :> Get ()
+type SimpleGet'' = "hello" :> Get Bool
+
+type SimpleGet2 = [sitemap|
+GET  hello  Bool
+|]
+type SimpleGet2' = "hello" :> Get Bool
+type SimpleGet2'' = "hello" :> Get Int
+
+type SimplePost = [sitemap|
+POST  hello  ()
+|]
+type SimplePost' = "hello" :> Post ()
+type SimplePost'' = "hello" :> Post Bool
+
+type SimplePost2 = [sitemap|
+POST  hello  Bool
+|]
+type SimplePost2' = "hello" :> Post Bool
+type SimplePost2'' = "hello" :> Post ()
+
+type SimpleReqBody = [sitemap|
+POST  hello  () -> Bool
+|]
+type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
+type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
+
+--------------------------------------------------------------------------
+-- Spec
+--------------------------------------------------------------------------
+
+spec :: Spec
+spec = do
+    describe "'sitemap' QuasiQuoter" $ do
+        it "Handles simple GET types" $ do
+            (u::SimpleGet)  ~= (u::SimpleGet'  ) ~> True
+            (u::SimpleGet)  ~= (u::SimpleGet'' ) ~> False
+            (u::SimpleGet2) ~= (u::SimpleGet2' ) ~> True
+            (u::SimpleGet2) ~= (u::SimpleGet2'') ~> False
+        it "Handles simple POST types" $ do
+            (u::SimplePost)  ~= (u::SimplePost'  ) ~> True
+            (u::SimplePost)  ~= (u::SimplePost'' ) ~> False
+            (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
+            (u::SimplePost2) ~= (u::SimplePost2'') ~> False
+        it "Handles simple request body types" $ do
+            (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
+            (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
+
+
+--------------------------------------------------------------------------
+-- Utilities
+--------------------------------------------------------------------------
 data HTrue
 data HFalse
 
@@ -22,16 +82,12 @@ class  TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
 instance               TypeEq x x HTrue where { areEq _ _ = True }
 instance b ~ HFalse => TypeEq x y b where     { areEq _ _ = False}
 
-type SimpleGet = [sitemap|
-GET  hello  ()
-|]
+infix 4 ~=
+(~=) :: TypeEq x y b => x -> y -> Bool
+(~=) = areEq
 
-type SimpleGet' = "hello" :> Get ()
-type SimpleGet'' = "hello" :> Get Bool
+u :: a
+u = undefined
 
-spec :: Spec
-spec = do
-    describe "'sitemap' QuasiQuoter" $ do
-        it "Handles simple GET types" $ do
-            areEq (undefined::SimpleGet) (undefined::SimpleGet') `shouldBe` True
-            areEq (undefined::SimpleGet) (undefined::SimpleGet'') `shouldBe` False
+infix 3 ~>
+(~>) = shouldBe