git.iko.soy/typeable/servant
on master help sign in
server and client support for QueryParams (list of values in query string) and QueryFlag (value-less query string argument)
bab2bc7Alp Mestanogullari
src/Servant/API/QueryParam.hs+76−4
compare with master
unifiedsplit
@@ -3,12 +3,13 @@
3{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE ScopedTypeVariables #-}
7module Servant.API.QueryParam where
8module Servant.API.QueryParam where
8
9
10+import Data.Maybe
9import Data.Proxy
11import Data.Proxy
10import Data.String.Conversions
12import Data.String.Conversions
11−import Data.Text
12import GHC.TypeLits
13import GHC.TypeLits
13import Network.HTTP.Types
14import Network.HTTP.Types
14import Network.Wai
15import Network.Wai
@@ -18,9 +19,9 @@ import Servant.Docs
18import Servant.Server
19import Servant.Server
19import Servant.Utils.Text
20import Servant.Utils.Text
20
21
21−-- * Query String parameter lookup
22+-- * Single query string parameter lookup
22
23
23−-- | Your must implement:
24+-- | You must implement:
24--
25--
25-- - a @'FromText' a@ instance for serving
26-- - a @'FromText' a@ instance for serving
26-- - a @'ToText' a@ instance for (client-side) querying
27-- - a @'ToText' a@ instance for (client-side) querying
@@ -57,7 +58,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
57 clientWithRoute (Proxy :: Proxy sublayout) $
58 clientWithRoute (Proxy :: Proxy sublayout) $
58 appendToQueryString pname mparamText req
59 appendToQueryString pname mparamText req
59
60
60− where pname = pack pname'
61+ where pname = cs pname'
61 pname' = symbolVal (Proxy :: Proxy sym)
62 pname' = symbolVal (Proxy :: Proxy sym)
62 mparamText = fmap toText mparam
63 mparamText = fmap toText mparam
63
64
@@ -70,3 +71,74 @@ instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
70 where sublayoutP = Proxy :: Proxy sublayout
71 where sublayoutP = Proxy :: Proxy sublayout
71 paramP = Proxy :: Proxy (QueryParam sym a)
72 paramP = Proxy :: Proxy (QueryParam sym a)
72 action' = over params (|> toParam paramP) action
73 action' = over params (|> toParam paramP) action
74+
75+-- | Retrieve a list from the query string.
76+data QueryParams sym a
77+
78+instance (KnownSymbol sym, FromText a, HasServer sublayout)
79+ => HasServer (QueryParams sym a :> sublayout) where
80+
81+ type Server (QueryParams sym a :> sublayout) =
82+ [a] -> Server sublayout
83+
84+ route Proxy subserver request respond = do
85+ let querytext = parseQueryText $ rawQueryString request
86+ -- if sym is "foo", we look for query string parameters
87+ -- named "foo" or "foo[]" and call fromText on the
88+ -- corresponding values
89+ parameters = filter looksLikeParam querytext
90+ values = catMaybes $ map (convert . snd) parameters
91+
92+ route (Proxy :: Proxy sublayout) (subserver values) request respond
93+
94+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
95+ looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
96+ convert Nothing = Nothing
97+ convert (Just v) = fromText v
98+
99+instance (KnownSymbol sym, ToText a, HasClient sublayout)
100+ => HasClient (QueryParams sym a :> sublayout) where
101+
102+ type Client (QueryParams sym a :> sublayout) =
103+ [a] -> Client sublayout
104+
105+ clientWithRoute Proxy req paramlist =
106+ clientWithRoute (Proxy :: Proxy sublayout) $
107+ foldr (appendToQueryString pname) req paramlist'
108+
109+ where pname = cs pname'
110+ pname' = symbolVal (Proxy :: Proxy sym)
111+ paramlist' = map (Just . toText) paramlist
112+
113+-- | Retrieve a value-less boolean from the query string.
114+data QueryFlag a
115+
116+instance (KnownSymbol sym, HasServer sublayout)
117+ => HasServer (QueryFlag sym :> sublayout) where
118+
119+ type Server (QueryFlag sym :> sublayout) =
120+ Bool -> Server sublayout
121+
122+ route Proxy subserver request respond = do
123+ let querytext = parseQueryText $ rawQueryString request
124+ param = case lookup paramname querytext of
125+ Just Nothing -> True -- param is there, with no value
126+ _ -> False -- param not in the query string or with a value
127+
128+ route (Proxy :: Proxy sublayout) (subserver param) request respond
129+
130+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
131+
132+instance (KnownSymbol sym, HasClient sublayout)
133+ => HasClient (QueryFlag sym :> sublayout) where
134+
135+ type Client (QueryFlag sym :> sublayout) =
136+ Bool -> Client sublayout
137+
138+ clientWithRoute Proxy req flag =
139+ clientWithRoute (Proxy :: Proxy sublayout) $
140+ if flag
141+ then appendToQueryString paramname Nothing req
142+ else req
143+
144+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
src/Servant/Client.hs+3−4
@@ -39,10 +39,9 @@ appendToQueryString :: Text -- ^ param name
39 -> Maybe Text -- ^ param value
39 -> Maybe Text -- ^ param value
40 -> Req
40 -> Req
41 -> Req
41 -> Req
42−appendToQueryString pname pvalue req
42+appendToQueryString pname pvalue req =
43− | pvalue == Nothing = req
44− | otherwise = req { qs = qs req ++ [(pname, pvalue)]
43+ req { qs = qs req ++ [(pname, pvalue)]
45− }
44+ }
46
45
47setRQBody :: ByteString -> Req -> Req
46setRQBody :: ByteString -> Req -> Req
48setRQBody b req = req { reqBody = b }
47setRQBody b req = req { reqBody = b }