git.iko.soy/typeable/servant
on master help sign in
QQ more tests and cleanup.
99e7904Julian K. Arni
example/greet.hs−6
compare with master
unifiedsplit
@@ -55,12 +55,6 @@ type TestApi =
55 :<|> "greet" :> ReqBody Greet :> Post Greet
55 :<|> "greet" :> ReqBody Greet :> Post Greet
56 :<|> "delete" :> Capture "greetid" Text :> Delete
56 :<|> "delete" :> Capture "greetid" Text :> Delete
57
57
58−type TestApi2 = [sitemap|
59−GET hello/name:Text/?capital:Bool () -> Greet
60−POST greet Greet -> Greet
61−DELETE delete/greetid:Text ()
62−|]
63−
64testApi :: Proxy TestApi
58testApi :: Proxy TestApi
65testApi = Proxy
59testApi = Proxy
66
60
src/Servant/API/QQ.hs+8−8
@@ -41,13 +41,13 @@ infixr 6 >:
41
41
42
42
43instance ExpSYM Type Type where
43instance ExpSYM Type Type where
44− lit name r = (LitT (StrTyLit name)) >: r
44+ lit name r = LitT (StrTyLit name) >: r
45− capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
45+ capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
46− (ConT $ mkName typ)) >: r
46+ (ConT $ mkName typ) >: r
47− reqBody typ r = (AppT (ConT ''ReqBody) (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)))
48+ queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))
49− (ConT $ mkName typ)) >: r
49+ (ConT $ mkName typ) >: r
50− conj x y = AppT (AppT (ConT ''(:>)) x) y
50+ conj x = AppT (AppT (ConT ''(:>)) x)
51 get typ = AppT (ConT ''Get) (ConT $ mkName typ)
51 get typ = AppT (ConT ''Get) (ConT $ mkName typ)
52 post typ = AppT (ConT ''Post) (ConT $ mkName typ)
52 post typ = AppT (ConT ''Post) (ConT $ mkName typ)
53 put typ = AppT (ConT ''Put) (ConT $ mkName typ)
53 put typ = AppT (ConT ''Put) (ConT $ mkName typ)
@@ -84,7 +84,7 @@ readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
84readAll :: String -> Type
84readAll :: String -> Type
85readAll s = foldr1 union $ mapMaybe readEntry $ words <$> lines s
85readAll s = foldr1 union $ mapMaybe readEntry $ words <$> lines s
86 where union :: Type -> Type -> Type
86 where union :: Type -> Type -> Type
87− union a b = AppT (AppT (ConT ''(:<|>)) a) b
87+ union a = AppT (AppT (ConT ''(:<|>)) a)
88
88
89sitemap :: QuasiQuoter
89sitemap :: QuasiQuoter
90sitemap = QuasiQuoter { quoteExp = undefined
90sitemap = QuasiQuoter { quoteExp = undefined
test/Servant/API/QQSpec.hs+51−1
@@ -18,7 +18,7 @@ import Servant.API
18-- Types for testing
18-- Types for testing
19--------------------------------------------------------------------------
19--------------------------------------------------------------------------
20
20
21−
21+-- Methods ---------------------------------------------------------------
22type SimpleGet = [sitemap|
22type SimpleGet = [sitemap|
23GET hello ()
23GET hello ()
24|]
24|]
@@ -43,12 +43,47 @@ POST hello Bool
43type SimplePost2' = "hello" :> Post Bool
43type SimplePost2' = "hello" :> Post Bool
44type SimplePost2'' = "hello" :> Post ()
44type SimplePost2'' = "hello" :> Post ()
45
45
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+
46type SimpleReqBody = [sitemap|
60type SimpleReqBody = [sitemap|
47POST hello () -> Bool
61POST hello () -> Bool
48|]
62|]
49type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
63type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
50type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
64type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
51
65
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)
52--------------------------------------------------------------------------
87--------------------------------------------------------------------------
53-- Spec
88-- Spec
54--------------------------------------------------------------------------
89--------------------------------------------------------------------------
@@ -66,9 +101,24 @@ spec = do
66 (u::SimplePost) ~= (u::SimplePost'' ) ~> False
101 (u::SimplePost) ~= (u::SimplePost'' ) ~> False
67 (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
102 (u::SimplePost2) ~= (u::SimplePost2' ) ~> True
68 (u::SimplePost2) ~= (u::SimplePost2'') ~> False
103 (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
69 it "Handles simple request body types" $ do
109 it "Handles simple request body types" $ do
70 (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
110 (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
71 (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
111 (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
72
122
73
123
74--------------------------------------------------------------------------
124--------------------------------------------------------------------------