From c6264dd20245fa0661acd53476418c31654d764f Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Wed, 29 Oct 2014 13:10:04 +0100
Subject: [PATCH] Add queryParam.
And update names.
---
example/greet.hs | 6 +++---
servant.cabal | 1 +
src/Servant/API.hs | 2 +-
src/Servant/API/QQ.hs | 30 +++++++++++++++++++-----------
4 files changed, 24 insertions(+), 15 deletions(-)
diff --git a/example/greet.hs b/example/greet.hs
index 10674072..08995168 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -56,9 +56,9 @@ type TestApi =
:<|> "delete" :> Capture "greetid" Text :> Delete
type TestApi2 = [sitemap|
-GET hello/name:Text/capital:Bool () -> Greet
-POST greet Greet -> Greet
-DELETE delete/greetid:Text ()
+GET hello/name:Text/?capital:Bool () -> Greet
+POST greet Greet -> Greet
+DELETE delete/greetid:Text ()
|]
testApi :: Proxy TestApi
diff --git a/servant.cabal b/servant.cabal
index 01650b1f..dcfc65bf 100644
--- a/servant.cabal
+++ b/servant.cabal
@@ -46,6 +46,7 @@ library
, network-uri
, wai
, warp
+ , safe
, transformers
, template-haskell
, text
diff --git a/src/Servant/API.hs b/src/Servant/API.hs
index be283f06..3065e12f 100644
--- a/src/Servant/API.hs
+++ b/src/Servant/API.hs
@@ -35,7 +35,7 @@ import Servant.API.Get
import Servant.API.Post
import Servant.API.Put
import Servant.API.QueryParam
-import Servant.API.QQ
+import Servant.API.QQ (sitemap)
import Servant.API.ReqBody
import Servant.API.Sub
import Servant.API.Union
diff --git a/src/Servant/API/QQ.hs b/src/Servant/API/QQ.hs
index 18315532..482bff46 100644
--- a/src/Servant/API/QQ.hs
+++ b/src/Servant/API/QQ.hs
@@ -11,20 +11,23 @@ import Data.List.Split (splitOn)
import Data.Maybe (mapMaybe)
import Language.Haskell.TH.Quote
import Language.Haskell.TH
+import Safe (headMay)
import Servant.API.Capture
import Servant.API.Get
import Servant.API.Post
import Servant.API.Put
import Servant.API.Delete
-import Servant.API.RQBody
+import Servant.API.QueryParam
+import Servant.API.ReqBody
import Servant.API.Sub
import Servant.API.Union
class ExpSYM repr' repr | repr -> repr', repr' -> repr where
lit :: String -> repr' -> repr
capture :: String -> String -> repr -> repr
- rqBody :: String -> repr -> repr
+ reqBody :: String -> repr -> repr
+ queryParam :: String -> String -> repr -> repr
conj :: repr' -> repr -> repr
get :: String -> repr
post :: String -> repr
@@ -41,13 +44,15 @@ instance ExpSYM Type Type where
lit name r = (LitT (StrTyLit name)) >: r
capture name typ r = (AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))
(ConT $ mkName typ)) >: r
- rqBody typ r = (AppT (ConT ''RQBody) (ConT $ mkName typ)) >: r
- conj x y = AppT (AppT (ConT ''(:>)) x) y
- get typ = AppT (ConT ''Get) (ConT $ mkName typ)
- post typ = AppT (ConT ''Post) (ConT $ mkName typ)
- put typ = AppT (ConT ''Put) (ConT $ mkName typ)
- delete "()" = ConT ''Delete
- delete _ = error "Delete does not return a request body"
+ reqBody typ r = (AppT (ConT ''ReqBody) (ConT $ mkName typ)) >: r
+ queryParam name typ r = (AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))
+ (ConT $ mkName typ)) >: r
+ conj x y = AppT (AppT (ConT ''(:>)) x) y
+ get typ = AppT (ConT ''Get) (ConT $ mkName typ)
+ post typ = AppT (ConT ''Post) (ConT $ mkName typ)
+ put typ = AppT (ConT ''Put) (ConT $ mkName typ)
+ delete "()" = ConT ''Delete
+ delete _ = error "Delete does not return a request body"
readEntry :: ExpSYM r r => [String] -> Maybe r
readEntry [] = Nothing
@@ -61,7 +66,7 @@ readEntry (met:xs:typ) = case met of
rd m = case typ' of
[] -> readEntry' xs $ m "()"
[rsp] -> readEntry' xs $ m rsp
- (rqbd:[rsp]) -> readEntry' xs $ rqBody rqbd $ m rsp
+ (rqbd:[rsp]) -> readEntry' xs $ reqBody rqbd $ m rsp
_ -> error "Only functions of one argument allowed!"
readEntry x = error $ "Wrong number of elems in line: " ++ show x
@@ -70,7 +75,10 @@ readEntry' [] _ = Nothing
readEntry' xs r = Just $ foldr1 (.) (tRepr <$> splitOn "/" xs) r
where
tRepr y | [x] <- splitOn ":" y = lit x
- | a:[b] <- splitOn ":" y = capture a b
+ | a:[b] <- splitOn ":" y = case headMay a of
+ Just '?' -> queryParam (tail a) b
+ Just _ -> capture a b
+ Nothing -> error "Expecting something after '/'"
| otherwise = error "Only one ':' per section"
readAll :: String -> Type