{-# OPTIONS_GHC -Wno-orphans #-}
module WebGear.Server.Trait.QueryParam () where
import Control.Arrow (arr, returnA, (>>>))
import Data.List (find)
import Data.Proxy (Proxy (Proxy))
import Data.String (fromString)
import Data.Text (Text)
import Data.Void (Void)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types (queryToQueryText)
import Web.HttpApiData (FromHttpApiData (..))
import WebGear.Core.Modifiers
import WebGear.Core.Request (Request, queryString)
import WebGear.Core.Trait (Get (..), With, unwitness)
import WebGear.Core.Trait.QueryParam (
ParamNotFound (..),
ParamParseError (..),
QueryParam (..),
)
import WebGear.Server.Handler (ServerHandler)
extractQueryParam ::
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name ->
ServerHandler m (Request `With` ts) (Maybe (Either Text val))
Proxy name
proxy = proc With Request ts
req -> do
let name :: Text
name = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
proxy
params :: QueryText
params = Query -> QueryText
queryToQueryText (Query -> QueryText) -> Query -> QueryText
forall a b. (a -> b) -> a -> b
$ Request -> Query
queryString (Request -> Query) -> Request -> Query
forall a b. (a -> b) -> a -> b
$ With Request ts -> Request
forall a (ts :: [*]). With a ts -> a
unwitness With Request ts
req
ServerHandler m (Maybe (Either Text val)) (Maybe (Either Text val))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Text -> Either Text val
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam (Text -> Either Text val) -> Maybe Text -> Maybe (Either Text val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Text, Maybe Text) -> Bool)
-> QueryText -> Maybe (Text, Maybe Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Text -> Bool)
-> ((Text, Maybe Text) -> Text) -> (Text, Maybe Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Maybe Text) -> Text
forall a b. (a, b) -> a
fst) QueryText
params Maybe (Text, Maybe Text)
-> ((Text, Maybe Text) -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd)
instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Strict name val) Request where
{-# INLINE getTrait #-}
getTrait ::
QueryParam Required Strict name val ->
ServerHandler m (Request `With` ts) (Either (Either ParamNotFound ParamParseError) val)
getTrait :: forall (ts :: [*]).
QueryParam 'Required 'Strict name val
-> ServerHandler
m
(With Request ts)
(Either (Either ParamNotFound ParamParseError) val)
getTrait QueryParam 'Required 'Strict name val
QueryParam = Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
extractQueryParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) ServerHandler m (With Request ts) (Maybe (Either Text val))
-> ServerHandler
m
(Maybe (Either Text val))
(Either (Either ParamNotFound ParamParseError) val)
-> ServerHandler
m
(With Request ts)
(Either (Either ParamNotFound ParamParseError) val)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Maybe (Either Text val)
-> Either (Either ParamNotFound ParamParseError) val)
-> ServerHandler
m
(Maybe (Either Text val))
(Either (Either ParamNotFound ParamParseError) val)
forall b c. (b -> c) -> ServerHandler m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Maybe (Either Text val)
-> Either (Either ParamNotFound ParamParseError) val
forall {b}.
Maybe (Either Text b)
-> Either (Either ParamNotFound ParamParseError) b
f
where
f :: Maybe (Either Text b)
-> Either (Either ParamNotFound ParamParseError) b
f = \case
Maybe (Either Text b)
Nothing -> Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b
forall a b. a -> Either a b
Left (Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b)
-> Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b
forall a b. (a -> b) -> a -> b
$ ParamNotFound -> Either ParamNotFound ParamParseError
forall a b. a -> Either a b
Left ParamNotFound
ParamNotFound
Just (Left Text
e) -> Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b
forall a b. a -> Either a b
Left (Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b)
-> Either ParamNotFound ParamParseError
-> Either (Either ParamNotFound ParamParseError) b
forall a b. (a -> b) -> a -> b
$ ParamParseError -> Either ParamNotFound ParamParseError
forall a b. b -> Either a b
Right (ParamParseError -> Either ParamNotFound ParamParseError)
-> ParamParseError -> Either ParamNotFound ParamParseError
forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e
Just (Right b
x) -> b -> Either (Either ParamNotFound ParamParseError) b
forall a b. b -> Either a b
Right b
x
instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Strict name val) Request where
{-# INLINE getTrait #-}
getTrait ::
QueryParam Optional Strict name val ->
ServerHandler m (Request `With` ts) (Either ParamParseError (Maybe val))
getTrait :: forall (ts :: [*]).
QueryParam 'Optional 'Strict name val
-> ServerHandler
m (With Request ts) (Either ParamParseError (Maybe val))
getTrait QueryParam 'Optional 'Strict name val
QueryParam = Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
extractQueryParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) ServerHandler m (With Request ts) (Maybe (Either Text val))
-> ServerHandler
m (Maybe (Either Text val)) (Either ParamParseError (Maybe val))
-> ServerHandler
m (With Request ts) (Either ParamParseError (Maybe val))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Maybe (Either Text val) -> Either ParamParseError (Maybe val))
-> ServerHandler
m (Maybe (Either Text val)) (Either ParamParseError (Maybe val))
forall b c. (b -> c) -> ServerHandler m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Maybe (Either Text val) -> Either ParamParseError (Maybe val)
forall {a}.
Maybe (Either Text a) -> Either ParamParseError (Maybe a)
f
where
f :: Maybe (Either Text a) -> Either ParamParseError (Maybe a)
f = \case
Maybe (Either Text a)
Nothing -> Maybe a -> Either ParamParseError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
Just (Left Text
e) -> ParamParseError -> Either ParamParseError (Maybe a)
forall a b. a -> Either a b
Left (ParamParseError -> Either ParamParseError (Maybe a))
-> ParamParseError -> Either ParamParseError (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e
Just (Right a
x) -> Maybe a -> Either ParamParseError (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either ParamParseError (Maybe a))
-> Maybe a -> Either ParamParseError (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Required Lenient name val) Request where
{-# INLINE getTrait #-}
getTrait ::
QueryParam Required Lenient name val ->
ServerHandler m (Request `With` ts) (Either ParamNotFound (Either Text val))
getTrait :: forall (ts :: [*]).
QueryParam 'Required 'Lenient name val
-> ServerHandler
m (With Request ts) (Either ParamNotFound (Either Text val))
getTrait QueryParam 'Required 'Lenient name val
QueryParam = Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
extractQueryParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) ServerHandler m (With Request ts) (Maybe (Either Text val))
-> ServerHandler
m
(Maybe (Either Text val))
(Either ParamNotFound (Either Text val))
-> ServerHandler
m (With Request ts) (Either ParamNotFound (Either Text val))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Maybe (Either Text val) -> Either ParamNotFound (Either Text val))
-> ServerHandler
m
(Maybe (Either Text val))
(Either ParamNotFound (Either Text val))
forall b c. (b -> c) -> ServerHandler m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Maybe (Either Text val) -> Either ParamNotFound (Either Text val)
forall {a} {b}.
Maybe (Either a b) -> Either ParamNotFound (Either a b)
f
where
f :: Maybe (Either a b) -> Either ParamNotFound (Either a b)
f = \case
Maybe (Either a b)
Nothing -> ParamNotFound -> Either ParamNotFound (Either a b)
forall a b. a -> Either a b
Left ParamNotFound
ParamNotFound
Just (Left a
e) -> Either a b -> Either ParamNotFound (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either ParamNotFound (Either a b))
-> Either a b -> Either ParamNotFound (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
e
Just (Right b
x) -> Either a b -> Either ParamNotFound (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either ParamNotFound (Either a b))
-> Either a b -> Either ParamNotFound (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
x
instance (Monad m, KnownSymbol name, FromHttpApiData val) => Get (ServerHandler m) (QueryParam Optional Lenient name val) Request where
{-# INLINE getTrait #-}
getTrait ::
QueryParam Optional Lenient name val ->
ServerHandler m (Request `With` ts) (Either Void (Maybe (Either Text val)))
getTrait :: forall (ts :: [*]).
QueryParam 'Optional 'Lenient name val
-> ServerHandler
m (With Request ts) (Either Void (Maybe (Either Text val)))
getTrait QueryParam 'Optional 'Lenient name val
QueryParam = Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
extractQueryParam (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name) ServerHandler m (With Request ts) (Maybe (Either Text val))
-> ServerHandler
m (Maybe (Either Text val)) (Either Void (Maybe (Either Text val)))
-> ServerHandler
m (With Request ts) (Either Void (Maybe (Either Text val)))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Maybe (Either Text val) -> Either Void (Maybe (Either Text val)))
-> ServerHandler
m (Maybe (Either Text val)) (Either Void (Maybe (Either Text val)))
forall b c. (b -> c) -> ServerHandler m b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Maybe (Either Text val) -> Either Void (Maybe (Either Text val))
forall {a} {b} {a}.
Maybe (Either a b) -> Either a (Maybe (Either a b))
f
where
f :: Maybe (Either a b) -> Either a (Maybe (Either a b))
f = \case
Maybe (Either a b)
Nothing -> Maybe (Either a b) -> Either a (Maybe (Either a b))
forall a b. b -> Either a b
Right Maybe (Either a b)
forall a. Maybe a
Nothing
Just (Left a
e) -> Maybe (Either a b) -> Either a (Maybe (Either a b))
forall a b. b -> Either a b
Right (Maybe (Either a b) -> Either a (Maybe (Either a b)))
-> Maybe (Either a b) -> Either a (Maybe (Either a b))
forall a b. (a -> b) -> a -> b
$ Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
e
Just (Right b
x) -> Maybe (Either a b) -> Either a (Maybe (Either a b))
forall a b. b -> Either a b
Right (Maybe (Either a b) -> Either a (Maybe (Either a b)))
-> Maybe (Either a b) -> Either a (Maybe (Either a b))
forall a b. (a -> b) -> a -> b
$ Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
x