git.iko.soy/servant
on 69041cc help sign in
servant/src/Servant/API/QueryParam.hs
169 lines 5.9 kB history raw
1{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8module Servant.API.QueryParam where
10import Data.List
11import Data.Maybe
12import Data.Proxy
13import Data.String.Conversions
14import GHC.TypeLits
15import Network.HTTP.Types
16import Network.Wai
17import Servant.API.Sub
18import Servant.Client
19import Servant.Common.Req
20import Servant.Common.Text
21import Servant.Docs
22import Servant.Server
24-- * Single query string parameter lookup
26-- | You must implement:
27--
28-- - a @'FromText' a@ instance for serving
29-- - a @'ToText' a@ instance for (client-side) querying
30-- - a @'ToParam' ('QueryParam' sym a)@ instance for automatic documentation generation
31data QueryParam sym a
33instance (KnownSymbol sym, FromText a, HasServer sublayout)
34 => HasServer (QueryParam sym a :> sublayout) where
36 type Server (QueryParam sym a :> sublayout) =
37 Maybe a -> Server sublayout
39 route Proxy subserver request respond = do
40 let querytext = parseQueryText $ rawQueryString request
41 param =
42 case lookup paramname querytext of
43 Nothing -> Nothing -- param absent from the query string
44 Just Nothing -> Nothing -- param present with no value -> Nothing
45 Just (Just v) -> fromText v -- if present, we try to convert to
46 -- the right type
48 route (Proxy :: Proxy sublayout) (subserver param) request respond
50 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
52instance (KnownSymbol sym, ToText a, HasClient sublayout)
53 => HasClient (QueryParam sym a :> sublayout) where
55 type Client (QueryParam sym a :> sublayout) =
56 Maybe a -> Client sublayout
58 -- if mparam = Nothing, we don't add it to the query string
59 clientWithRoute Proxy req mparam =
60 clientWithRoute (Proxy :: Proxy sublayout) $
61 appendToQueryString pname mparamText req
63 where pname = cs pname'
64 pname' = symbolVal (Proxy :: Proxy sym)
65 mparamText = fmap toText mparam
67instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
68 => HasDocs (QueryParam sym a :> sublayout) where
70 docsFor Proxy (endpoint, action) =
71 docsFor sublayoutP (endpoint, action')
73 where sublayoutP = Proxy :: Proxy sublayout
74 paramP = Proxy :: Proxy (QueryParam sym a)
75 action' = over params (|> toParam paramP) action
77-- | Retrieve a list from the query string.
78data QueryParams sym a
80instance (KnownSymbol sym, FromText a, HasServer sublayout)
81 => HasServer (QueryParams sym a :> sublayout) where
83 type Server (QueryParams sym a :> sublayout) =
84 [a] -> Server sublayout
86 route Proxy subserver request respond = do
87 let querytext = parseQueryText $ rawQueryString request
88 -- if sym is "foo", we look for query string parameters
89 -- named "foo" or "foo[]" and call fromText on the
90 -- corresponding values
91 parameters = filter looksLikeParam querytext
92 values = catMaybes $ map (convert . snd) parameters
94 route (Proxy :: Proxy sublayout) (subserver values) request respond
96 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
97 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
98 convert Nothing = Nothing
99 convert (Just v) = fromText v
101instance (KnownSymbol sym, ToText a, HasClient sublayout)
102 => HasClient (QueryParams sym a :> sublayout) where
104 type Client (QueryParams sym a :> sublayout) =
105 [a] -> Client sublayout
107 clientWithRoute Proxy req paramlist =
108 clientWithRoute (Proxy :: Proxy sublayout) $
109 foldl' (\ value req -> appendToQueryString pname req value) req paramlist'
111 where pname = cs pname'
112 pname' = symbolVal (Proxy :: Proxy sym)
113 paramlist' = map (Just . toText) paramlist
115instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
116 => HasDocs (QueryParams sym a :> sublayout) where
118 docsFor Proxy (endpoint, action) =
119 docsFor sublayoutP (endpoint, action')
121 where sublayoutP = Proxy :: Proxy sublayout
122 paramP = Proxy :: Proxy (QueryParams sym a)
123 action' = over params (|> toParam paramP) action
125-- | Retrieve a value-less boolean from the query string.
126data QueryFlag a
128instance (KnownSymbol sym, HasServer sublayout)
129 => HasServer (QueryFlag sym :> sublayout) where
131 type Server (QueryFlag sym :> sublayout) =
132 Bool -> Server sublayout
134 route Proxy subserver request respond = do
135 let querytext = parseQueryText $ rawQueryString request
136 param = case lookup paramname querytext of
137 Just Nothing -> True -- param is there, with no value
138 Just (Just v) -> examine v -- param with a value
139 Nothing -> False -- param not in the query string
141 route (Proxy :: Proxy sublayout) (subserver param) request respond
143 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
144 examine v | v == "true" || v == "1" || v == "" = True
145 | otherwise = False
147instance (KnownSymbol sym, HasClient sublayout)
148 => HasClient (QueryFlag sym :> sublayout) where
150 type Client (QueryFlag sym :> sublayout) =
151 Bool -> Client sublayout
153 clientWithRoute Proxy req flag =
154 clientWithRoute (Proxy :: Proxy sublayout) $
155 if flag
156 then appendToQueryString paramname Nothing req
157 else req
159 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
161instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
162 => HasDocs (QueryFlag sym :> sublayout) where
164 docsFor Proxy (endpoint, action) =
165 docsFor sublayoutP (endpoint, action')
167 where sublayoutP = Proxy :: Proxy sublayout
168 paramP = Proxy :: Proxy (QueryFlag sym)
169 action' = over params (|> toParam paramP) action