module WebGear.Core.Trait.Header (
Header (..),
HeaderNotFound (..),
HeaderParseError (..),
RequiredHeader,
OptionalHeader,
header,
optionalHeader,
lenientHeader,
optionalLenientHeader,
setHeader,
setOptionalHeader,
) 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 (..), Linked, Set, Trait (..), TraitAbsence (..), plant, probe)
data =
deriving stock (ReadPrec [HeaderNotFound]
ReadPrec HeaderNotFound
Int -> ReadS HeaderNotFound
ReadS [HeaderNotFound]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderNotFound]
$creadListPrec :: ReadPrec [HeaderNotFound]
readPrec :: ReadPrec HeaderNotFound
$creadPrec :: ReadPrec HeaderNotFound
readList :: ReadS [HeaderNotFound]
$creadList :: ReadS [HeaderNotFound]
readsPrec :: Int -> ReadS HeaderNotFound
$creadsPrec :: Int -> ReadS HeaderNotFound
Read, Int -> HeaderNotFound -> ShowS
[HeaderNotFound] -> ShowS
HeaderNotFound -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderNotFound] -> ShowS
$cshowList :: [HeaderNotFound] -> ShowS
show :: HeaderNotFound -> String
$cshow :: HeaderNotFound -> String
showsPrec :: Int -> HeaderNotFound -> ShowS
$cshowsPrec :: Int -> HeaderNotFound -> ShowS
Show, HeaderNotFound -> HeaderNotFound -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderNotFound -> HeaderNotFound -> Bool
$c/= :: HeaderNotFound -> HeaderNotFound -> Bool
== :: HeaderNotFound -> HeaderNotFound -> Bool
$c== :: HeaderNotFound -> HeaderNotFound -> Bool
Eq)
newtype = Text
deriving stock (ReadPrec [HeaderParseError]
ReadPrec HeaderParseError
Int -> ReadS HeaderParseError
ReadS [HeaderParseError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderParseError]
$creadListPrec :: ReadPrec [HeaderParseError]
readPrec :: ReadPrec HeaderParseError
$creadPrec :: ReadPrec HeaderParseError
readList :: ReadS [HeaderParseError]
$creadList :: ReadS [HeaderParseError]
readsPrec :: Int -> ReadS HeaderParseError
$creadsPrec :: Int -> ReadS HeaderParseError
Read, Int -> HeaderParseError -> ShowS
[HeaderParseError] -> ShowS
HeaderParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderParseError] -> ShowS
$cshowList :: [HeaderParseError] -> ShowS
show :: HeaderParseError -> String
$cshow :: HeaderParseError -> String
showsPrec :: Int -> HeaderParseError -> ShowS
$cshowsPrec :: Int -> HeaderParseError -> ShowS
Show, HeaderParseError -> HeaderParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderParseError -> HeaderParseError -> Bool
$c/= :: HeaderParseError -> HeaderParseError -> Bool
== :: HeaderParseError -> HeaderParseError -> Bool
$c== :: HeaderParseError -> HeaderParseError -> Bool
Eq)
data (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) =
type = Header Required Strict
type = Header Optional Strict
instance Trait (Header Required Strict name val) Request where
type Attribute (Header Required Strict name val) Request = val
instance TraitAbsence (Header Required Strict name val) Request where
type Absence (Header Required Strict name val) Request = Either HeaderNotFound HeaderParseError
instance Trait (Header Optional Strict name val) Request where
type Attribute (Header Optional Strict name val) Request = Maybe val
instance TraitAbsence (Header Optional Strict name val) Request where
type Absence (Header Optional Strict name val) Request = HeaderParseError
instance Trait (Header Required Lenient name val) Request where
type Attribute (Header Required Lenient name val) Request = Either Text val
instance TraitAbsence (Header Required Lenient name val) Request where
type Absence (Header Required Lenient name val) Request = HeaderNotFound
instance Trait (Header Optional Lenient name val) Request where
type Attribute (Header Optional Lenient name val) Request = Maybe (Either Text val)
instance TraitAbsence (Header Optional Lenient name val) Request where
type Absence (Header Optional Lenient name val) Request = Void
headerHandler ::
forall name val e p h req.
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request) Response ->
Middleware h req (Header e p name val : req)
headerHandler :: forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (req :: [*]).
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request)
Response
-> Middleware h req (Header e p name val : req)
headerHandler h (Linked req Request, Absence (Header e p name val) Request)
Response
errorHandler RequestHandler h (Header e p name val : req)
nextHandler = proc Linked req Request
request -> do
Either
(Absence (Header e p name val) Request)
(Linked (Header e p name val : req) Request)
result <- forall t (ts :: [*]) (h :: * -> * -> *) a.
Get h t a =>
t -> h (Linked ts a) (Either (Absence t a) (Linked (t : ts) a))
probe forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
Header e p name val
Header -< Linked req Request
request
case Either
(Absence (Header e p name val) Request)
(Linked (Header e p name val : req) Request)
result of
Left Absence (Header e p name val) Request
err -> h (Linked req Request, Absence (Header e p name val) Request)
Response
errorHandler -< (Linked req Request
request, Absence (Header e p name val) Request
err)
Right Linked (Header e p name val : req) Request
val -> RequestHandler h (Header e p name val : req)
nextHandler -< Linked (Header e p name val : req) Request
val
header ::
forall name val h req.
(Get h (Header Required Strict name val) Request, ArrowChoice h) =>
h (Linked req Request, Either HeaderNotFound HeaderParseError) Response ->
Middleware h req (Header Required Strict name val : req)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (req :: [*]).
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request)
Response
-> Middleware h req (Header e p name val : req)
headerHandler
optionalHeader ::
forall name val h req.
(Get h (Header Optional Strict name val) Request, ArrowChoice h) =>
h (Linked req Request, HeaderParseError) Response ->
Middleware h req (Header Optional Strict name val : req)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (req :: [*]).
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request)
Response
-> Middleware h req (Header e p name val : req)
headerHandler
lenientHeader ::
forall name val h req.
(Get h (Header Required Lenient name val) Request, ArrowChoice h) =>
h (Linked req Request, HeaderNotFound) Response ->
Middleware h req (Header Required Lenient name val : req)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (req :: [*]).
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request)
Response
-> Middleware h req (Header e p name val : req)
headerHandler
optionalLenientHeader ::
forall name val h req.
(Get h (Header Optional Lenient name val) Request, ArrowChoice h) =>
Middleware h req (Header Optional Lenient name val : req)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (req :: [*]).
(Get h (Header e p name val) Request, ArrowChoice h) =>
h (Linked req Request, Absence (Header e p name val) Request)
Response
-> Middleware h req (Header e p name val : req)
headerHandler forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
instance Trait (Header Required Strict name val) Response where
type Attribute (Header Required Strict name val) Response = val
instance Trait (Header Optional Strict name val) Response where
type Attribute (Header Optional Strict name val) Response = Maybe val
setHeader ::
forall name val a h res.
Set h (Header Required Strict name val) Response =>
h a (Linked res Response) ->
h (val, a) (Linked (Header Required Strict name val : res) Response)
h a (Linked res Response)
prevHandler = proc (val
val, a
a) -> do
Linked res Response
r <- h a (Linked res Response)
prevHandler -< a
a
forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (Linked ts a, Attribute t a) (Linked (t : ts) a)
plant forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
Header e p name val
Header -< (Linked res Response
r, val
val)
setOptionalHeader ::
forall name val a h res.
Set h (Header Optional Strict name val) Response =>
h a (Linked res Response) ->
h (Maybe val, a) (Linked (Header Optional Strict name val : res) Response)
h a (Linked res Response)
prevHandler = proc (Maybe val
val, a
a) -> do
Linked res Response
r <- h a (Linked res Response)
prevHandler -< a
a
forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (Linked ts a, Attribute t a) (Linked (t : ts) a)
plant forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
Header e p name val
Header -< (Linked res Response
r, Maybe val
val)