git.iko.soy/typeable/servant
on master help sign in
More QQ tests.
d2f7e12Julian K. Arni
test/Servant/API/QQSpec.hs+65−9
compare with master
unifiedsplit
@@ -14,24 +14,80 @@ import Test.Hspec
14import Servant.API
14import Servant.API
15{-import Servant.API.QQ-}
15{-import Servant.API.QQ-}
16
16
17−data HTrue
17+--------------------------------------------------------------------------
18−data HFalse
18+-- Types for testing
19+--------------------------------------------------------------------------
19
20
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}
24
21
25type SimpleGet = [sitemap|
22type SimpleGet = [sitemap|
26GET hello ()
23GET hello ()
27|]
24|]
28−
29type SimpleGet' = "hello" :> Get ()
25type SimpleGet' = "hello" :> Get ()
30type SimpleGet'' = "hello" :> Get Bool
26type SimpleGet'' = "hello" :> Get Bool
31
27
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+
32spec :: Spec
56spec :: Spec
33spec = do
57spec = do
34 describe "'sitemap' QuasiQuoter" $ do
58 describe "'sitemap' QuasiQuoter" $ do
35 it "Handles simple GET types" $ do
59 it "Handles simple GET types" $ do
36− areEq (undefined::SimpleGet) (undefined::SimpleGet') `shouldBe` True
60+ (u::SimpleGet) ~= (u::SimpleGet' ) ~> True
37− areEq (undefined::SimpleGet) (undefined::SimpleGet'') `shouldBe` False
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