{-# 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 (..), Linked, unlink)
import WebGear.Core.Trait.QueryParam (
  ParamNotFound (..),
  ParamParseError (..),
  QueryParam (..),
 )
import WebGear.Server.Handler (ServerHandler)

extractQueryParam ::
  (Monad m, KnownSymbol name, FromHttpApiData val) =>
  Proxy name ->
  ServerHandler m (Linked ts Request) (Maybe (Either Text val))
extractQueryParam :: forall (m :: * -> *) (name :: Symbol) val (ts :: [*]).
(Monad m, KnownSymbol name, FromHttpApiData val) =>
Proxy name
-> ServerHandler m (Linked ts Request) (Maybe (Either Text val))
extractQueryParam Proxy name
proxy = proc Linked ts Request
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 (ts :: [*]) a. Linked ts a -> a
unlink Linked ts Request
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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Required Strict name val ->
    ServerHandler m (Linked ts Request) (Either (Either ParamNotFound ParamParseError) val)
  getTrait :: forall (ts :: [*]).
QueryParam 'Required 'Strict name val
-> ServerHandler
     m
     (Linked ts Request)
     (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 (Linked ts Request) (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Optional Strict name val ->
    ServerHandler m (Linked ts Request) (Either ParamParseError (Maybe val))
  getTrait :: forall (ts :: [*]).
QueryParam 'Optional 'Strict name val
-> ServerHandler
     m (Linked ts Request) (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 (Linked ts Request) (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Required Lenient name val ->
    ServerHandler m (Linked ts Request) (Either ParamNotFound (Either Text val))
  getTrait :: forall (ts :: [*]).
QueryParam 'Required 'Lenient name val
-> ServerHandler
     m (Linked ts Request) (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 (Linked ts Request) (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Optional Lenient name val ->
    ServerHandler m (Linked ts Request) (Either Void (Maybe (Either Text val)))
  getTrait :: forall (ts :: [*]).
QueryParam 'Optional 'Lenient name val
-> ServerHandler
     m (Linked ts Request) (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 (Linked ts Request) (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