git.iko.soy/typeable/servant
on c98c7db help sign in
typeable/servant/src/Servant/API/GetParam.hs
66 lines 2.2 kB history raw
1{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7module Servant.API.GetParam 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.Text
21-- * GET params support (i.e query string arguments)
22data GetParam sym a
24instance (KnownSymbol sym, FromText a, HasServer sublayout)
25 => HasServer (GetParam sym a :> sublayout) where
27 type Server (GetParam sym a :> sublayout) =
28 Maybe a -> Server sublayout
30 route Proxy subserver request respond = do
31 let querytext = parseQueryText $ rawQueryString request
32 param =
33 case lookup paramname querytext of
34 Nothing -> Nothing -- param absent from the query string
35 Just Nothing -> Nothing -- param present with no value -> Nothing
36 Just (Just v) -> fromText v -- if present, we try to convert to
37 -- the right type
39 route (Proxy :: Proxy sublayout) (subserver param) request respond
41 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
43instance (KnownSymbol sym, ToText a, HasClient sublayout)
44 => HasClient (GetParam sym a :> sublayout) where
46 type Client (GetParam sym a :> sublayout) =
47 Maybe a -> Client sublayout
49 -- if mparam = Nothing, we don't add it to the query string
50 clientWithRoute Proxy req mparam =
51 clientWithRoute (Proxy :: Proxy sublayout) $
52 appendToQueryString pname mparamText req
54 where pname = pack pname'
55 pname' = symbolVal (Proxy :: Proxy sym)
56 mparamText = fmap toText mparam
58instance (KnownSymbol sym, ToParam (GetParam sym a), HasDocs sublayout)
59 => HasDocs (GetParam sym a :> sublayout) where
61 docsFor Proxy (endpoint, action) =
62 docsFor sublayoutP (endpoint, action')
64 where sublayoutP = Proxy :: Proxy sublayout
65 paramP = Proxy :: Proxy (GetParam sym a)
66 action' = over params (|> toParam paramP) action