git.iko.soy/servant
on fc67c3b help sign in
servant/src/Servant/API/QueryParam.hs
72 lines 2.4 kB history raw
1{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7module Servant.API.QueryParam where
9import Data.Proxy
10import Data.String.Conversions
11import Data.Text
12import GHC.TypeLits
13import Network.HTTP.Types
14import Network.Wai
15import Servant.API.Sub
16import Servant.Client
17import Servant.Docs
18import Servant.Server
19import Servant.Utils.Text
21-- * Query String parameter lookup
23-- | Your must implement:
24--
25-- - a @'FromText' a@ instance for serving
26-- - a @'ToText' a@ instance for (client-side) querying
27-- - a @'ToParam' ('QueryParam' sym a)@ instance for automatic documentation generation
28data QueryParam sym a
30instance (KnownSymbol sym, FromText a, HasServer sublayout)
31 => HasServer (QueryParam sym a :> sublayout) where
33 type Server (QueryParam sym a :> sublayout) =
34 Maybe a -> Server sublayout
36 route Proxy subserver request respond = do
37 let querytext = parseQueryText $ rawQueryString request
38 param =
39 case lookup paramname querytext of
40 Nothing -> Nothing -- param absent from the query string
41 Just Nothing -> Nothing -- param present with no value -> Nothing
42 Just (Just v) -> fromText v -- if present, we try to convert to
43 -- the right type
45 route (Proxy :: Proxy sublayout) (subserver param) request respond
47 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
49instance (KnownSymbol sym, ToText a, HasClient sublayout)
50 => HasClient (QueryParam sym a :> sublayout) where
52 type Client (QueryParam sym a :> sublayout) =
53 Maybe a -> Client sublayout
55 -- if mparam = Nothing, we don't add it to the query string
56 clientWithRoute Proxy req mparam =
57 clientWithRoute (Proxy :: Proxy sublayout) $
58 appendToQueryString pname mparamText req
60 where pname = pack pname'
61 pname' = symbolVal (Proxy :: Proxy sym)
62 mparamText = fmap toText mparam
64instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
65 => HasDocs (QueryParam sym a :> sublayout) where
67 docsFor Proxy (endpoint, action) =
68 docsFor sublayoutP (endpoint, action')
70 where sublayoutP = Proxy :: Proxy sublayout
71 paramP = Proxy :: Proxy (QueryParam sym a)
72 action' = over params (|> toParam paramP) action