@@ -14,24 +14,80 @@ import Test.Hspec
1414import Servant.API
1515{-import Servant.API.QQ-}
1616
17−data HTrue
18−data HFalse
17+--------------------------------------------------------------------------
18+-- Types for testing
19+--------------------------------------------------------------------------
1920
20−-- Kiselyov's Type Equality predicate
21−class TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
22−instance TypeEq x x HTrue where { areEq _ _ = True }
23−instance b ~ HFalse => TypeEq x y b where { areEq _ _ = False}
2421
2522type SimpleGet = [sitemap|
2623GET hello ()
2724|]
28−
2925type SimpleGet' = "hello" :> Get ()
3026type SimpleGet'' = "hello" :> Get Bool
3127
28+type SimpleGet2 = [sitemap|
29+GET hello Bool
30+|]
31+type SimpleGet2' = "hello" :> Get Bool
32+type SimpleGet2'' = "hello" :> Get Int
33+
34+type SimplePost = [sitemap|
35+POST hello ()
36+|]
37+type SimplePost' = "hello" :> Post ()
38+type SimplePost'' = "hello" :> Post Bool
39+
40+type SimplePost2 = [sitemap|
41+POST hello Bool
42+|]
43+type SimplePost2' = "hello" :> Post Bool
44+type SimplePost2'' = "hello" :> Post ()
45+
46+type SimpleReqBody = [sitemap|
47+POST hello () -> Bool
48+|]
49+type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
50+type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
51+
52+--------------------------------------------------------------------------
53+-- Spec
54+--------------------------------------------------------------------------
55+
3256spec :: Spec
3357spec = do
3458 describe "'sitemap' QuasiQuoter" $ do
3559 it "Handles simple GET types" $ do
36− areEq (undefined::SimpleGet) (undefined::SimpleGet') `shouldBe` True
37− areEq (undefined::SimpleGet) (undefined::SimpleGet'') `shouldBe` False
60+ (u::SimpleGet) ~= (u::SimpleGet' ) ~> True
61+ (u::SimpleGet) ~= (u::SimpleGet'' ) ~> False
62+ (u::SimpleGet2) ~= (u::SimpleGet2' ) ~> True
63+ (u::SimpleGet2) ~= (u::SimpleGet2'') ~> False
64+ it "Handles simple POST types" $ do
65+ (u::SimplePost) ~= (u::SimplePost' ) ~> True
66+ (u::SimplePost) ~= (u::SimplePost'' ) ~> False
67+ (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
68+ (u::SimplePost2) ~= (u::SimplePost2'') ~> False
69+ it "Handles simple request body types" $ do
70+ (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
71+ (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
72+
73+
74+--------------------------------------------------------------------------
75+-- Utilities
76+--------------------------------------------------------------------------
77+data HTrue
78+data HFalse
79+
80+-- Kiselyov's Type Equality predicate
81+class TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
82+instance TypeEq x x HTrue where { areEq _ _ = True }
83+instance b ~ HFalse => TypeEq x y b where { areEq _ _ = False}
84+
85+infix 4 ~=
86+(~=) :: TypeEq x y b => x -> y -> Bool
87+(~=) = areEq
88+
89+u :: a
90+u = undefined
91+
92+infix 3 ~>
93+(~>) = shouldBe