git.iko.soy/typeable/servant
on master help sign in
QQ more tests and cleanup.
commit99e790492a3d34324f2452559c881ffce3244a6d authorJulian K. Arni <jkarni@gmail.com> dateWed 29 Oct 2014, 14:54 (12 years ago) parentd2f7e12
3 files changed+59−15
compare with master
unifiedsplit
example/greet.hs−6 src/Servant/API/QQ.hs+8−8 test/Servant/API/QQSpec.hs+51−1
example/greet.hs−6
@@ -55,12 +55,6 @@ type TestApi =
5555 :<|> "greet" :> ReqBody Greet :> Post Greet
5656 :<|> "delete" :> Capture "greetid" Text :> Delete
5757
58−type TestApi2 = [sitemap|
59−GET hello/name:Text/?capital:Bool () -> Greet
60−POST greet Greet -> Greet
61−DELETE delete/greetid:Text ()
62−|]
63−
6458testApi :: Proxy TestApi
6559testApi = Proxy
6660
src/Servant/API/QQ.hs+8−8
@@ -41,13 +41,13 @@ infixr 6 >:
4141
4242
4343instance ExpSYM Type Type where
44− lit name r = (LitT (StrTyLit name)) >: r
45− capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
46− (ConT $ mkName typ)) >: r
47− reqBody typ r = (AppT (ConT ''ReqBody) (ConT $ mkName typ)) >: r
48− queryParam name typ r = (AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))
49− (ConT $ mkName typ)) >: r
50− conj x y = AppT (AppT (ConT ''(:>)) x) y
44+ lit name r = LitT (StrTyLit name) >: r
45+ capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
46+ (ConT $ mkName typ) >: r
47+ reqBody typ r = AppT (ConT ''ReqBody) (ConT $ mkName typ) >: r
48+ queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))
49+ (ConT $ mkName typ) >: r
50+ conj x = AppT (AppT (ConT ''(:>)) x)
5151 get typ = AppT (ConT ''Get) (ConT $ mkName typ)
5252 post typ = AppT (ConT ''Post) (ConT $ mkName typ)
5353 put typ = AppT (ConT ''Put) (ConT $ mkName typ)
@@ -84,7 +84,7 @@ readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
8484readAll :: String -> Type
8585readAll s = foldr1 union $ mapMaybe readEntry $ words <$> lines s
8686 where union :: Type -> Type -> Type
87− union a b = AppT (AppT (ConT ''(:<|>)) a) b
87+ union a = AppT (AppT (ConT ''(:<|>)) a)
8888
8989sitemap :: QuasiQuoter
9090sitemap = QuasiQuoter { quoteExp = undefined
test/Servant/API/QQSpec.hs+51−1
@@ -18,7 +18,7 @@ import Servant.API
1818-- Types for testing
1919--------------------------------------------------------------------------
2020
21−
21+-- Methods ---------------------------------------------------------------
2222type SimpleGet = [sitemap|
2323GET hello ()
2424|]
@@ -43,12 +43,47 @@ POST hello Bool
4343type SimplePost2' = "hello" :> Post Bool
4444type SimplePost2'' = "hello" :> Post ()
4545
46+type SimplePut = [sitemap|
47+PUT hello ()
48+|]
49+type SimplePut' = "hello" :> Put ()
50+type SimplePut'' = "hello" :> Put Bool
51+
52+type SimplePut2 = [sitemap|
53+PUT hello Bool
54+|]
55+type SimplePut2' = "hello" :> Put Bool
56+type SimplePut2'' = "hello" :> Put ()
57+
58+-- Parameters ------------------------------------------------------------
59+
4660type SimpleReqBody = [sitemap|
4761POST hello () -> Bool
4862|]
4963type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
5064type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
5165
66+type SimpleCapture = [sitemap|
67+POST hello/p:Int Bool
68+|]
69+type SimpleCapture' = "hello" :> Capture "p" Int :> Post Bool
70+type SimpleCapture'' = "hello" :> Capture "r" Int :> Post Bool
71+type SimpleCapture''' = "hello" :> Capture "p" Bool :> Post Bool
72+
73+type SimpleQueryParam = [sitemap|
74+POST hello/?p:Int Bool
75+|]
76+type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool
77+type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
78+type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> Post Bool
79+
80+-- Combinations ----------------------------------------------------------
81+
82+type TwoPaths = [sitemap|
83+POST hello Bool
84+GET hello Bool
85+|]
86+type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
5287--------------------------------------------------------------------------
5388-- Spec
5489--------------------------------------------------------------------------
@@ -66,9 +101,24 @@ spec = do
66101 (u::SimplePost) ~= (u::SimplePost'' ) ~> False
67102 (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
68103 (u::SimplePost2) ~= (u::SimplePost2'') ~> False
104+ it "Handles simple PUT types" $ do
105+ (u::SimplePut) ~= (u::SimplePut' ) ~> True
106+ (u::SimplePut) ~= (u::SimplePut'' ) ~> False
107+ (u::SimplePut2) ~= (u::SimplePut2' ) ~> True
108+ (u::SimplePut2) ~= (u::SimplePut2'') ~> False
69109 it "Handles simple request body types" $ do
70110 (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
71111 (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
112+ it "Handles simple captures" $ do
113+ (u::SimpleCapture) ~= (u::SimpleCapture' ) ~> True
114+ (u::SimpleCapture) ~= (u::SimpleCapture'') ~> False
115+ (u::SimpleCapture) ~= (u::SimpleCapture''') ~> False
116+ it "Handles simple querystring parameters" $ do
117+ (u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
118+ (u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
119+ (u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
120+ it "Handles multiples paths" $ do
121+ (u::TwoPaths) ~= (u::TwoPaths') ~> True
72122
73123
74124--------------------------------------------------------------------------