{-# 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 :: 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 = 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
$ Linked ts Request -> Request
forall (ts :: [*]) a. Linked ts a -> a
unlink Linked ts Request
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 (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Required Strict name val ->
    ServerHandler m (Linked ts Request) (Either (Either ParamNotFound ParamParseError) val)
  getTrait :: QueryParam 'Required 'Strict name val
-> ServerHandler
     m
     (Linked ts Request)
     (Either (Either ParamNotFound ParamParseError) val)
getTrait QueryParam 'Required 'Strict name val
QueryParam = Proxy name
-> ServerHandler m (Linked ts Request) (Maybe (Either Text val))
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
forall k (t :: k). Proxy t
Proxy @name) ServerHandler m (Linked ts Request) (Maybe (Either Text val))
-> ServerHandler
     m
     (Maybe (Either Text val))
     (Either (Either ParamNotFound ParamParseError) val)
-> ServerHandler
     m
     (Linked ts Request)
     (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 (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Optional Strict name val ->
    ServerHandler m (Linked ts Request) (Either ParamParseError (Maybe val))
  getTrait :: QueryParam 'Optional 'Strict name val
-> ServerHandler
     m (Linked ts Request) (Either ParamParseError (Maybe val))
getTrait QueryParam 'Optional 'Strict name val
QueryParam = Proxy name
-> ServerHandler m (Linked ts Request) (Maybe (Either Text val))
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
forall k (t :: k). Proxy t
Proxy @name) ServerHandler m (Linked ts Request) (Maybe (Either Text val))
-> ServerHandler
     m (Maybe (Either Text val)) (Either ParamParseError (Maybe val))
-> ServerHandler
     m (Linked ts Request) (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 (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Required Lenient name val ->
    ServerHandler m (Linked ts Request) (Either ParamNotFound (Either Text val))
  getTrait :: QueryParam 'Required 'Lenient name val
-> ServerHandler
     m (Linked ts Request) (Either ParamNotFound (Either Text val))
getTrait QueryParam 'Required 'Lenient name val
QueryParam = Proxy name
-> ServerHandler m (Linked ts Request) (Maybe (Either Text val))
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
forall k (t :: k). Proxy t
Proxy @name) ServerHandler m (Linked ts Request) (Maybe (Either Text val))
-> ServerHandler
     m
     (Maybe (Either Text val))
     (Either ParamNotFound (Either Text val))
-> ServerHandler
     m (Linked ts Request) (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 (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
  {-# INLINEABLE getTrait #-}
  getTrait ::
    QueryParam Optional Lenient name val ->
    ServerHandler m (Linked ts Request) (Either Void (Maybe (Either Text val)))
  getTrait :: QueryParam 'Optional 'Lenient name val
-> ServerHandler
     m (Linked ts Request) (Either Void (Maybe (Either Text val)))
getTrait QueryParam 'Optional 'Lenient name val
QueryParam = Proxy name
-> ServerHandler m (Linked ts Request) (Maybe (Either Text val))
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
forall k (t :: k). Proxy t
Proxy @name) ServerHandler m (Linked ts Request) (Maybe (Either Text val))
-> ServerHandler
     m (Maybe (Either Text val)) (Either Void (Maybe (Either Text val)))
-> ServerHandler
     m (Linked ts Request) (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 (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