eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add queryParam.

Browse source 
And update names.
This commit is contained in:
Julian K. Arni 2014-10-29 13:10:04 +01:00
parent 1f6c3c4009
commit c6264dd202
4 changed files with 24 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
example/greet.hs
View file

@ -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

1
servant.cabal
View file

@ -46,6 +46,7 @@ library
, network-uri
, wai
, warp
, safe
, transformers
, template-haskell
, text

2
src/Servant/API.hs
View file

@ -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

30
src/Servant/API/QQ.hs
View file

@ -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