{-# OPTIONS_GHC -Wno-orphans #-}

-- | Server implementation of the `QueryParam` trait.
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))
extractQueryParam :: forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (With Request ts) (Maybe (Either Text val))
extractQueryParam Proxy name
proxy = proc With Request ts
req -> do
  let name :: Text
name = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
proxy
      params :: QueryText
params = Query -> QueryText
queryToQueryText forall a b. (a -> b) -> a -> b
$ Request -> Query
queryString forall a b. (a -> b) -> a -> b
$ forall a (ts :: [*]). With a ts -> a
unwitness With Request ts
req
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) QueryText
params forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = 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
Proxy @name) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ParamNotFound
ParamNotFound
        Just (Left Text
e) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e
        Just (Right b
x) -> 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 = 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
Proxy @name) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
        Just (Left Text
e) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e
        Just (Right a
x) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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 = 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
Proxy @name) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 -> forall a b. a -> Either a b
Left ParamNotFound
ParamNotFound
        Just (Left a
e) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
e
        Just (Right b
x) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> 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 = 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
Proxy @name) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr 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 -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
        Just (Left a
e) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
e
        Just (Right b
x) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
x