git.iko.soy/servant
on 0e9d075 help sign in
servant/src/Servant/API/QueryParam.hs
168 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.Docs
20import Servant.Server
21import Servant.Utils.Text
23-- * Single query string parameter lookup
25-- | You must implement:
26--
27-- - a @'FromText' a@ instance for serving
28-- - a @'ToText' a@ instance for (client-side) querying
29-- - a @'ToParam' ('QueryParam' sym a)@ instance for automatic documentation generation
30data QueryParam sym a
32instance (KnownSymbol sym, FromText a, HasServer sublayout)
33 => HasServer (QueryParam sym a :> sublayout) where
35 type Server (QueryParam sym a :> sublayout) =
36 Maybe a -> Server sublayout
38 route Proxy subserver request respond = do
39 let querytext = parseQueryText $ rawQueryString request
40 param =
41 case lookup paramname querytext of
42 Nothing -> Nothing -- param absent from the query string
43 Just Nothing -> Nothing -- param present with no value -> Nothing
44 Just (Just v) -> fromText v -- if present, we try to convert to
45 -- the right type
47 route (Proxy :: Proxy sublayout) (subserver param) request respond
49 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
51instance (KnownSymbol sym, ToText a, HasClient sublayout)
52 => HasClient (QueryParam sym a :> sublayout) where
54 type Client (QueryParam sym a :> sublayout) =
55 Maybe a -> Client sublayout
57 -- if mparam = Nothing, we don't add it to the query string
58 clientWithRoute Proxy req mparam =
59 clientWithRoute (Proxy :: Proxy sublayout) $
60 appendToQueryString pname mparamText req
62 where pname = cs pname'
63 pname' = symbolVal (Proxy :: Proxy sym)
64 mparamText = fmap toText mparam
66instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
67 => HasDocs (QueryParam sym a :> sublayout) where
69 docsFor Proxy (endpoint, action) =
70 docsFor sublayoutP (endpoint, action')
72 where sublayoutP = Proxy :: Proxy sublayout
73 paramP = Proxy :: Proxy (QueryParam sym a)
74 action' = over params (|> toParam paramP) action
76-- | Retrieve a list from the query string.
77data QueryParams sym a
79instance (KnownSymbol sym, FromText a, HasServer sublayout)
80 => HasServer (QueryParams sym a :> sublayout) where
82 type Server (QueryParams sym a :> sublayout) =
83 [a] -> Server sublayout
85 route Proxy subserver request respond = do
86 let querytext = parseQueryText $ rawQueryString request
87 -- if sym is "foo", we look for query string parameters
88 -- named "foo" or "foo[]" and call fromText on the
89 -- corresponding values
90 parameters = filter looksLikeParam querytext
91 values = catMaybes $ map (convert . snd) parameters
93 route (Proxy :: Proxy sublayout) (subserver values) request respond
95 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
96 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
97 convert Nothing = Nothing
98 convert (Just v) = fromText v
100instance (KnownSymbol sym, ToText a, HasClient sublayout)
101 => HasClient (QueryParams sym a :> sublayout) where
103 type Client (QueryParams sym a :> sublayout) =
104 [a] -> Client sublayout
106 clientWithRoute Proxy req paramlist =
107 clientWithRoute (Proxy :: Proxy sublayout) $
108 foldl' (\ value req -> appendToQueryString pname req value) req paramlist'
110 where pname = cs pname'
111 pname' = symbolVal (Proxy :: Proxy sym)
112 paramlist' = map (Just . toText) paramlist
114instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
115 => HasDocs (QueryParams sym a :> sublayout) where
117 docsFor Proxy (endpoint, action) =
118 docsFor sublayoutP (endpoint, action')
120 where sublayoutP = Proxy :: Proxy sublayout
121 paramP = Proxy :: Proxy (QueryParams sym a)
122 action' = over params (|> toParam paramP) action
124-- | Retrieve a value-less boolean from the query string.
125data QueryFlag a
127instance (KnownSymbol sym, HasServer sublayout)
128 => HasServer (QueryFlag sym :> sublayout) where
130 type Server (QueryFlag sym :> sublayout) =
131 Bool -> Server sublayout
133 route Proxy subserver request respond = do
134 let querytext = parseQueryText $ rawQueryString request
135 param = case lookup paramname querytext of
136 Just Nothing -> True -- param is there, with no value
137 Just (Just v) -> examine v -- param with a value
138 Nothing -> False -- param not in the query string
140 route (Proxy :: Proxy sublayout) (subserver param) request respond
142 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
143 examine v | v == "true" || v == "1" || v == "" = True
144 | otherwise = False
146instance (KnownSymbol sym, HasClient sublayout)
147 => HasClient (QueryFlag sym :> sublayout) where
149 type Client (QueryFlag sym :> sublayout) =
150 Bool -> Client sublayout
152 clientWithRoute Proxy req flag =
153 clientWithRoute (Proxy :: Proxy sublayout) $
154 if flag
155 then appendToQueryString paramname Nothing req
156 else req
158 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
160instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
161 => HasDocs (QueryFlag sym :> sublayout) where
163 docsFor Proxy (endpoint, action) =
164 docsFor sublayoutP (endpoint, action')
166 where sublayoutP = Proxy :: Proxy sublayout
167 paramP = Proxy :: Proxy (QueryFlag sym)
168 action' = over params (|> toParam paramP) action