66 lines
2.2 KiB
Haskell
66 lines
2.2 KiB
Haskell
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
module Servant.API.GetParam where
|
|
|
|
import Data.Proxy
|
|
import Data.String.Conversions
|
|
import Data.Text
|
|
import GHC.TypeLits
|
|
import Network.HTTP.Types
|
|
import Network.Wai
|
|
import Servant.API.Sub
|
|
import Servant.Client
|
|
import Servant.Docs
|
|
import Servant.Server
|
|
import Servant.Utils.Text
|
|
|
|
-- * GET params support (i.e query string arguments)
|
|
data GetParam sym a
|
|
|
|
instance (KnownSymbol sym, FromText a, HasServer sublayout)
|
|
=> HasServer (GetParam sym a :> sublayout) where
|
|
|
|
type Server (GetParam sym a :> sublayout) =
|
|
Maybe a -> Server sublayout
|
|
|
|
route Proxy subserver request respond = do
|
|
let querytext = parseQueryText $ rawQueryString request
|
|
param =
|
|
case lookup paramname querytext of
|
|
Nothing -> Nothing -- param absent from the query string
|
|
Just Nothing -> Nothing -- param present with no value -> Nothing
|
|
Just (Just v) -> fromText v -- if present, we try to convert to
|
|
-- the right type
|
|
|
|
route (Proxy :: Proxy sublayout) (subserver param) request respond
|
|
|
|
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
|
|
|
instance (KnownSymbol sym, ToText a, HasClient sublayout)
|
|
=> HasClient (GetParam sym a :> sublayout) where
|
|
|
|
type Client (GetParam sym a :> sublayout) =
|
|
Maybe a -> Client sublayout
|
|
|
|
-- if mparam = Nothing, we don't add it to the query string
|
|
clientWithRoute Proxy req mparam =
|
|
clientWithRoute (Proxy :: Proxy sublayout) $
|
|
appendToQueryString pname mparamText req
|
|
|
|
where pname = pack pname'
|
|
pname' = symbolVal (Proxy :: Proxy sym)
|
|
mparamText = fmap toText mparam
|
|
|
|
instance (KnownSymbol sym, ToParam (GetParam sym a), HasDocs sublayout)
|
|
=> HasDocs (GetParam sym a :> sublayout) where
|
|
|
|
docsFor Proxy (endpoint, action) =
|
|
docsFor sublayoutP (endpoint, action')
|
|
|
|
where sublayoutP = Proxy :: Proxy sublayout
|
|
paramP = Proxy :: Proxy (GetParam sym a)
|
|
action' = over params (|> toParam paramP) action
|