module WebGear.Core.Trait.QueryParam (
QueryParam (..),
RequiredQueryParam,
OptionalQueryParam,
ParamNotFound (..),
ParamParseError (..),
queryParam,
optionalQueryParam,
lenientQueryParam,
optionalLenientQueryParam,
) where
import Control.Arrow (ArrowChoice, arr)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Void (Void, absurd)
import GHC.TypeLits (Symbol)
import WebGear.Core.Handler (Middleware)
import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Get, Prerequisite, Trait (..), TraitAbsence (..), With, probe)
data QueryParam (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) = QueryParam
type RequiredQueryParam = QueryParam Required Strict
type OptionalQueryParam = QueryParam Optional Strict
data ParamNotFound = ParamNotFound
deriving stock (ReadPrec [ParamNotFound]
ReadPrec ParamNotFound
Int -> ReadS ParamNotFound
ReadS [ParamNotFound]
(Int -> ReadS ParamNotFound)
-> ReadS [ParamNotFound]
-> ReadPrec ParamNotFound
-> ReadPrec [ParamNotFound]
-> Read ParamNotFound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamNotFound
readsPrec :: Int -> ReadS ParamNotFound
$creadList :: ReadS [ParamNotFound]
readList :: ReadS [ParamNotFound]
$creadPrec :: ReadPrec ParamNotFound
readPrec :: ReadPrec ParamNotFound
$creadListPrec :: ReadPrec [ParamNotFound]
readListPrec :: ReadPrec [ParamNotFound]
Read, Int -> ParamNotFound -> ShowS
[ParamNotFound] -> ShowS
ParamNotFound -> String
(Int -> ParamNotFound -> ShowS)
-> (ParamNotFound -> String)
-> ([ParamNotFound] -> ShowS)
-> Show ParamNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamNotFound -> ShowS
showsPrec :: Int -> ParamNotFound -> ShowS
$cshow :: ParamNotFound -> String
show :: ParamNotFound -> String
$cshowList :: [ParamNotFound] -> ShowS
showList :: [ParamNotFound] -> ShowS
Show, ParamNotFound -> ParamNotFound -> Bool
(ParamNotFound -> ParamNotFound -> Bool)
-> (ParamNotFound -> ParamNotFound -> Bool) -> Eq ParamNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamNotFound -> ParamNotFound -> Bool
== :: ParamNotFound -> ParamNotFound -> Bool
$c/= :: ParamNotFound -> ParamNotFound -> Bool
/= :: ParamNotFound -> ParamNotFound -> Bool
Eq)
newtype ParamParseError = ParamParseError Text
deriving stock (ReadPrec [ParamParseError]
ReadPrec ParamParseError
Int -> ReadS ParamParseError
ReadS [ParamParseError]
(Int -> ReadS ParamParseError)
-> ReadS [ParamParseError]
-> ReadPrec ParamParseError
-> ReadPrec [ParamParseError]
-> Read ParamParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamParseError
readsPrec :: Int -> ReadS ParamParseError
$creadList :: ReadS [ParamParseError]
readList :: ReadS [ParamParseError]
$creadPrec :: ReadPrec ParamParseError
readPrec :: ReadPrec ParamParseError
$creadListPrec :: ReadPrec [ParamParseError]
readListPrec :: ReadPrec [ParamParseError]
Read, Int -> ParamParseError -> ShowS
[ParamParseError] -> ShowS
ParamParseError -> String
(Int -> ParamParseError -> ShowS)
-> (ParamParseError -> String)
-> ([ParamParseError] -> ShowS)
-> Show ParamParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamParseError -> ShowS
showsPrec :: Int -> ParamParseError -> ShowS
$cshow :: ParamParseError -> String
show :: ParamParseError -> String
$cshowList :: [ParamParseError] -> ShowS
showList :: [ParamParseError] -> ShowS
Show, ParamParseError -> ParamParseError -> Bool
(ParamParseError -> ParamParseError -> Bool)
-> (ParamParseError -> ParamParseError -> Bool)
-> Eq ParamParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamParseError -> ParamParseError -> Bool
== :: ParamParseError -> ParamParseError -> Bool
$c/= :: ParamParseError -> ParamParseError -> Bool
/= :: ParamParseError -> ParamParseError -> Bool
Eq)
instance Trait (QueryParam Required Strict name val) Request where
type Attribute (QueryParam Required Strict name val) Request = val
instance TraitAbsence (QueryParam Required Strict name val) Request where
type Absence (QueryParam Required Strict name val) Request = Either ParamNotFound ParamParseError
instance Trait (QueryParam Optional Strict name val) Request where
type Attribute (QueryParam Optional Strict name val) Request = Maybe val
instance TraitAbsence (QueryParam Optional Strict name val) Request where
type Absence (QueryParam Optional Strict name val) Request = ParamParseError
instance Trait (QueryParam Required Lenient name val) Request where
type Attribute (QueryParam Required Lenient name val) Request = Either Text val
instance TraitAbsence (QueryParam Required Lenient name val) Request where
type Absence (QueryParam Required Lenient name val) Request = ParamNotFound
instance Trait (QueryParam Optional Lenient name val) Request where
type Attribute (QueryParam Optional Lenient name val) Request = Maybe (Either Text val)
instance TraitAbsence (QueryParam Optional Lenient name val) Request where
type Absence (QueryParam Optional Lenient name val) Request = Void
type instance Prerequisite (QueryParam e p name val) ts Request = ()
queryParamHandler ::
forall name val e p h ts.
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (Request `With` ts, Absence (QueryParam e p name val) Request) Response ->
Middleware h ts (QueryParam e p name val : ts)
queryParamHandler :: forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val) Request)
Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler h (With Request ts, Absence (QueryParam e p name val) Request)
Response
errorHandler RequestHandler h (QueryParam e p name val : ts)
nextHandler = proc With Request ts
request -> do
Either
(Absence (QueryParam e p name val) Request)
(With Request (QueryParam e p name val : ts))
result <- QueryParam e p name val
-> h (With Request ts)
(Either
(Absence (QueryParam e p name val) Request)
(With Request (QueryParam e p name val : ts)))
forall t (ts :: [*]) (h :: * -> * -> *) a.
(Get h t a, Prerequisite t ts a) =>
t -> h (With a ts) (Either (Absence t a) (With a (t : ts)))
probe QueryParam e p name val
forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
QueryParam e p name val
QueryParam -< With Request ts
request
case Either
(Absence (QueryParam e p name val) Request)
(With Request (QueryParam e p name val : ts))
result of
Left Absence (QueryParam e p name val) Request
err -> h (With Request ts, Absence (QueryParam e p name val) Request)
Response
errorHandler -< (With Request ts
request, Absence (QueryParam e p name val) Request
err)
Right With Request (QueryParam e p name val : ts)
val -> RequestHandler h (QueryParam e p name val : ts)
nextHandler -< With Request (QueryParam e p name val : ts)
val
{-# INLINE queryParamHandler #-}
queryParam ::
forall name val h ts.
(Get h (QueryParam Required Strict name val) Request, ArrowChoice h) =>
h (Request `With` ts, Either ParamNotFound ParamParseError) Response ->
Middleware h ts (QueryParam Required Strict name val : ts)
queryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Required 'Strict name val) Request,
ArrowChoice h) =>
h (With Request ts, Either ParamNotFound ParamParseError) Response
-> Middleware h ts (QueryParam 'Required 'Strict name val : ts)
queryParam = h (With Request ts, Either ParamNotFound ParamParseError) Response
-> h (With Request (QueryParam 'Required 'Strict name val : ts))
Response
-> h (With Request ts) Response
h (With Request ts,
Absence (QueryParam 'Required 'Strict name val) Request)
Response
-> h (With Request (QueryParam 'Required 'Strict name val : ts))
Response
-> h (With Request ts) Response
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val) Request)
Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE queryParam #-}
optionalQueryParam ::
forall name val h ts.
(Get h (QueryParam Optional Strict name val) Request, ArrowChoice h) =>
h (Request `With` ts, ParamParseError) Response ->
Middleware h ts (QueryParam Optional Strict name val : ts)
optionalQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Optional 'Strict name val) Request,
ArrowChoice h) =>
h (With Request ts, ParamParseError) Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
optionalQueryParam = h (With Request ts,
Absence (QueryParam 'Optional 'Strict name val) Request)
Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
h (With Request ts, ParamParseError) Response
-> Middleware h ts (QueryParam 'Optional 'Strict name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val) Request)
Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE optionalQueryParam #-}
lenientQueryParam ::
forall name val h ts.
(Get h (QueryParam Required Lenient name val) Request, ArrowChoice h) =>
h (Request `With` ts, ParamNotFound) Response ->
Middleware h ts (QueryParam Required Lenient name val : ts)
lenientQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Required 'Lenient name val) Request,
ArrowChoice h) =>
h (With Request ts, ParamNotFound) Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
lenientQueryParam = h (With Request ts,
Absence (QueryParam 'Required 'Lenient name val) Request)
Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
h (With Request ts, ParamNotFound) Response
-> Middleware h ts (QueryParam 'Required 'Lenient name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val) Request)
Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler
{-# INLINE lenientQueryParam #-}
optionalLenientQueryParam ::
forall name val h ts.
(Get h (QueryParam Optional Lenient name val) Request, ArrowChoice h) =>
Middleware h ts (QueryParam Optional Lenient name val : ts)
optionalLenientQueryParam :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam 'Optional 'Lenient name val) Request,
ArrowChoice h) =>
Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
optionalLenientQueryParam = h (With Request ts,
Absence (QueryParam 'Optional 'Lenient name val) Request)
Response
-> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (QueryParam e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (QueryParam e p name val) Request)
Response
-> Middleware h ts (QueryParam e p name val : ts)
queryParamHandler (h (With Request ts,
Absence (QueryParam 'Optional 'Lenient name val) Request)
Response
-> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts))
-> h (With Request ts,
Absence (QueryParam 'Optional 'Lenient name val) Request)
Response
-> Middleware h ts (QueryParam 'Optional 'Lenient name val : ts)
forall a b. (a -> b) -> a -> b
$ ((With Request ts, Void) -> Response)
-> h (With Request ts, Void) Response
forall b c. (b -> c) -> h b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Void -> Response
forall a. Void -> a
absurd (Void -> Response)
-> ((With Request ts, Void) -> Void)
-> (With Request ts, Void)
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (With Request ts, Void) -> Void
forall a b. (a, b) -> b
snd)
{-# INLINE optionalLenientQueryParam #-}