git.iko.soy/servant
on a9eeff1 help sign in
servant/src/Servant/API/QueryParam.hs
164 lines 5.7 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.Maybe
11import Data.Proxy
12import Data.String.Conversions
13import GHC.TypeLits
14import Network.HTTP.Types
15import Network.Wai
16import Servant.API.Sub
17import Servant.Client
18import Servant.Docs
19import Servant.Server
20import Servant.Utils.Text
22-- * Single query string parameter lookup
24-- | You must implement:
25--
26-- - a @'FromText' a@ instance for serving
27-- - a @'ToText' a@ instance for (client-side) querying
28-- - a @'ToParam' ('QueryParam' sym a)@ instance for automatic documentation generation
29data QueryParam sym a
31instance (KnownSymbol sym, FromText a, HasServer sublayout)
32 => HasServer (QueryParam sym a :> sublayout) where
34 type Server (QueryParam sym a :> sublayout) =
35 Maybe a -> Server sublayout
37 route Proxy subserver request respond = do
38 let querytext = parseQueryText $ rawQueryString request
39 param =
40 case lookup paramname querytext of
41 Nothing -> Nothing -- param absent from the query string
42 Just Nothing -> Nothing -- param present with no value -> Nothing
43 Just (Just v) -> fromText v -- if present, we try to convert to
44 -- the right type
46 route (Proxy :: Proxy sublayout) (subserver param) request respond
48 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
50instance (KnownSymbol sym, ToText a, HasClient sublayout)
51 => HasClient (QueryParam sym a :> sublayout) where
53 type Client (QueryParam sym a :> sublayout) =
54 Maybe a -> Client sublayout
56 -- if mparam = Nothing, we don't add it to the query string
57 clientWithRoute Proxy req mparam =
58 clientWithRoute (Proxy :: Proxy sublayout) $
59 appendToQueryString pname mparamText req
61 where pname = cs pname'
62 pname' = symbolVal (Proxy :: Proxy sym)
63 mparamText = fmap toText mparam
65instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
66 => HasDocs (QueryParam sym a :> sublayout) where
68 docsFor Proxy (endpoint, action) =
69 docsFor sublayoutP (endpoint, action')
71 where sublayoutP = Proxy :: Proxy sublayout
72 paramP = Proxy :: Proxy (QueryParam sym a)
73 action' = over params (|> toParam paramP) action
75-- | Retrieve a list from the query string.
76data QueryParams sym a
78instance (KnownSymbol sym, FromText a, HasServer sublayout)
79 => HasServer (QueryParams sym a :> sublayout) where
81 type Server (QueryParams sym a :> sublayout) =
82 [a] -> Server sublayout
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
92 route (Proxy :: Proxy sublayout) (subserver values) request respond
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
99instance (KnownSymbol sym, ToText a, HasClient sublayout)
100 => HasClient (QueryParams sym a :> sublayout) where
102 type Client (QueryParams sym a :> sublayout) =
103 [a] -> Client sublayout
105 clientWithRoute Proxy req paramlist =
106 clientWithRoute (Proxy :: Proxy sublayout) $
107 foldr (appendToQueryString pname) req paramlist'
109 where pname = cs pname'
110 pname' = symbolVal (Proxy :: Proxy sym)
111 paramlist' = map (Just . toText) paramlist
113instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
114 => HasDocs (QueryParams sym a :> sublayout) where
116 docsFor Proxy (endpoint, action) =
117 docsFor sublayoutP (endpoint, action')
119 where sublayoutP = Proxy :: Proxy sublayout
120 paramP = Proxy :: Proxy (QueryParams sym a)
121 action' = over params (|> toParam paramP) action
123-- | Retrieve a value-less boolean from the query string.
124data QueryFlag a
126instance (KnownSymbol sym, HasServer sublayout)
127 => HasServer (QueryFlag sym :> sublayout) where
129 type Server (QueryFlag sym :> sublayout) =
130 Bool -> Server sublayout
132 route Proxy subserver request respond = do
133 let querytext = parseQueryText $ rawQueryString request
134 param = case lookup paramname querytext of
135 Just Nothing -> True -- param is there, with no value
136 _ -> False -- param not in the query string or with a value
138 route (Proxy :: Proxy sublayout) (subserver param) request respond
140 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
142instance (KnownSymbol sym, HasClient sublayout)
143 => HasClient (QueryFlag sym :> sublayout) where
145 type Client (QueryFlag sym :> sublayout) =
146 Bool -> Client sublayout
148 clientWithRoute Proxy req flag =
149 clientWithRoute (Proxy :: Proxy sublayout) $
150 if flag
151 then appendToQueryString paramname Nothing req
152 else req
154 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
156instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
157 => HasDocs (QueryFlag sym :> sublayout) where
159 docsFor Proxy (endpoint, action) =
160 docsFor sublayoutP (endpoint, action')
162 where sublayoutP = Proxy :: Proxy sublayout
163 paramP = Proxy :: Proxy (QueryFlag sym)
164 action' = over params (|> toParam paramP) action