git.iko.soy/servant
on master help sign in
Add queryParam.
c6264ddJulian K. Arni
example/greet.hs+3−3
compare with master
unifiedsplit
@@ -56,9 +56,9 @@ type TestApi =
56 :<|> "delete" :> Capture "greetid" Text :> Delete
56 :<|> "delete" :> Capture "greetid" Text :> Delete
57
57
58type TestApi2 = [sitemap|
58type TestApi2 = [sitemap|
59−GET hello/name:Text/capital:Bool () -> Greet
59+GET hello/name:Text/?capital:Bool () -> Greet
60−POST greet Greet -> Greet
60+POST greet Greet -> Greet
61−DELETE delete/greetid:Text ()
61+DELETE delete/greetid:Text ()
62|]
62|]
63
63
64testApi :: Proxy TestApi
64testApi :: Proxy TestApi
servant.cabal+1
@@ -46,6 +46,7 @@ library
46 , network-uri
46 , network-uri
47 , wai
47 , wai
48 , warp
48 , warp
49+ , safe
49 , transformers
50 , transformers
50 , template-haskell
51 , template-haskell
51 , text
52 , text
src/Servant/API.hs+1−1
@@ -35,7 +35,7 @@ import Servant.API.Get
35import Servant.API.Post
35import Servant.API.Post
36import Servant.API.Put
36import Servant.API.Put
37import Servant.API.QueryParam
37import Servant.API.QueryParam
38−import Servant.API.QQ
38+import Servant.API.QQ (sitemap)
39import Servant.API.ReqBody
39import Servant.API.ReqBody
40import Servant.API.Sub
40import Servant.API.Sub
41import Servant.API.Union
41import Servant.API.Union
src/Servant/API/QQ.hs+19−11
@@ -11,20 +11,23 @@ import Data.List.Split (splitOn)
11import Data.Maybe (mapMaybe)
11import Data.Maybe (mapMaybe)
12import Language.Haskell.TH.Quote
12import Language.Haskell.TH.Quote
13import Language.Haskell.TH
13import Language.Haskell.TH
14+import Safe (headMay)
14
15
15import Servant.API.Capture
16import Servant.API.Capture
16import Servant.API.Get
17import Servant.API.Get
17import Servant.API.Post
18import Servant.API.Post
18import Servant.API.Put
19import Servant.API.Put
19import Servant.API.Delete
20import Servant.API.Delete
20−import Servant.API.RQBody
21+import Servant.API.QueryParam
22+import Servant.API.ReqBody
21import Servant.API.Sub
23import Servant.API.Sub
22import Servant.API.Union
24import Servant.API.Union
23
25
24class ExpSYM repr' repr | repr -> repr', repr' -> repr where
26class ExpSYM repr' repr | repr -> repr', repr' -> repr where
25 lit :: String -> repr' -> repr
27 lit :: String -> repr' -> repr
26 capture :: String -> String -> repr -> repr
28 capture :: String -> String -> repr -> repr
27− rqBody :: String -> repr -> repr
29+ reqBody :: String -> repr -> repr
30+ queryParam :: String -> String -> repr -> repr
28 conj :: repr' -> repr -> repr
31 conj :: repr' -> repr -> repr
29 get :: String -> repr
32 get :: String -> repr
30 post :: String -> repr
33 post :: String -> repr
@@ -41,13 +44,15 @@ instance ExpSYM Type Type where
41 lit name r = (LitT (StrTyLit name)) >: r
44 lit name r = (LitT (StrTyLit name)) >: r
42 capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
45 capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
43 (ConT $ mkName typ)) >: r
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)))
44− rqBody typ r = (AppT (ConT ''RQBody) (ConT $ mkName typ)) >: r
49+ (ConT $ mkName typ)) >: r
45− conj x y = AppT (AppT (ConT ''(:>)) x) y
50+ conj x y = AppT (AppT (ConT ''(:>)) x) y
46− get typ = AppT (ConT ''Get) (ConT $ mkName typ)
51+ get typ = AppT (ConT ''Get) (ConT $ mkName typ)
47− post typ = AppT (ConT ''Post) (ConT $ mkName typ)
52+ post typ = AppT (ConT ''Post) (ConT $ mkName typ)
48− put typ = AppT (ConT ''Put) (ConT $ mkName typ)
53+ put typ = AppT (ConT ''Put) (ConT $ mkName typ)
49− delete "()" = ConT ''Delete
54+ delete "()" = ConT ''Delete
50− delete _ = error "Delete does not return a request body"
55+ delete _ = error "Delete does not return a request body"
51
56
52readEntry :: ExpSYM r r => [String] -> Maybe r
57readEntry :: ExpSYM r r => [String] -> Maybe r
53readEntry [] = Nothing
58readEntry [] = Nothing
@@ -61,7 +66,7 @@ readEntry (met:xs:typ) = case met of
61 rd m = case typ' of
66 rd m = case typ' of
62 [] -> readEntry' xs $ m "()"
67 [] -> readEntry' xs $ m "()"
63 [rsp] -> readEntry' xs $ m rsp
68 [rsp] -> readEntry' xs $ m rsp
64− (rqbd:[rsp]) -> readEntry' xs $ rqBody rqbd $ m rsp
69+ (rqbd:[rsp]) -> readEntry' xs $ reqBody rqbd $ m rsp
65 _ -> error "Only functions of one argument allowed!"
70 _ -> error "Only functions of one argument allowed!"
66readEntry x = error $ "Wrong number of elems in line: " ++ show x
71readEntry x = error $ "Wrong number of elems in line: " ++ show x
67
72
@@ -70,7 +75,10 @@ readEntry' [] _ = Nothing
70readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
75readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
71 where
76 where
72 tRepr y | [x] <- splitOn ":" y = lit x
77 tRepr y | [x] <- splitOn ":" y = lit x
78+ | a:[b] <- splitOn ":" y = case headMay a of
79+ Just '?' -> queryParam (tail a) b
73− | a:[b] <- splitOn ":" y = capture a b
80+ Just _ -> capture a b
81+ Nothing -> error "Expecting something after '/'"
74 | otherwise = error "Only one ':' per section"
82 | otherwise = error "Only one ':' per section"
75
83
76readAll :: String -> Type
84readAll :: String -> Type