@@ -3,12 +3,13 @@
33{-# LANGUAGE TypeOperators #-}
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedStrings #-}
67{-# LANGUAGE ScopedTypeVariables #-}
78module Servant.API.QueryParam where
89
10+import Data.Maybe
911import Data.Proxy
1012import Data.String.Conversions
11−import Data.Text
1213import GHC.TypeLits
1314import Network.HTTP.Types
1415import Network.Wai
@@ -18,9 +19,9 @@ import Servant.Docs
1819import Servant.Server
1920import Servant.Utils.Text
2021
21−-- * Query String parameter lookup
22+-- * Single query string parameter lookup
2223
23−-- | Your must implement:
24+-- | You must implement:
2425--
2526-- - a @'FromText' a@ instance for serving
2627-- - a @'ToText' a@ instance for (client-side) querying
@@ -57,7 +58,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
5758 clientWithRoute (Proxy :: Proxy sublayout) $
5859 appendToQueryString pname mparamText req
5960
60− where pname = pack pname'
61+ where pname = cs pname'
6162 pname' = symbolVal (Proxy :: Proxy sym)
6263 mparamText = fmap toText mparam
6364
@@ -70,3 +71,74 @@ instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
7071 where sublayoutP = Proxy :: Proxy sublayout
7172 paramP = Proxy :: Proxy (QueryParam sym a)
7273 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)