{-# OPTIONS_GHC -Wno-orphans #-}
module WebGear.Server.Trait.Status where
import Control.Arrow (returnA)
import qualified Network.HTTP.Types.Status as HTTP
import WebGear.Core.Response (Response (..))
import WebGear.Core.Trait (Set, With, setTrait, unwitness)
import WebGear.Core.Trait.Status (Status (..))
import WebGear.Server.Handler (ServerHandler)
instance (Monad m) => Set (ServerHandler m) Status Response where
{-# INLINE setTrait #-}
setTrait ::
Status ->
(Response `With` ts -> Response -> HTTP.Status -> Response `With` (Status : ts)) ->
ServerHandler m (Response `With` ts, HTTP.Status) (Response `With` (Status : ts))
setTrait :: forall (ts :: [*]).
Status
-> (With Response ts
-> Response -> Status -> With Response (Status : ts))
-> ServerHandler
m (With Response ts, Status) (With Response (Status : ts))
setTrait (Status Status
status) With Response ts
-> Response -> Status -> With Response (Status : ts)
f = proc (With Response ts
wResponse, Status
_) -> do
let response' :: Response
response' =
case With Response ts -> Response
forall a (ts :: [*]). With a ts -> a
unwitness With Response ts
wResponse of
Response Status
_ ResponseHeaders
hdrs ResponseBody
body -> Status -> ResponseHeaders -> ResponseBody -> Response
Response Status
status ResponseHeaders
hdrs ResponseBody
body
Response
response -> Response
response
ServerHandler
m (With Response (Status : ts)) (With Response (Status : ts))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< With Response ts
-> Response -> Status -> With Response (Status : ts)
f With Response ts
wResponse Response
response' Status
status