{-# OPTIONS_GHC -Wno-orphans #-}

-- | Server implementation of the `Status` trait.
module WebGear.Server.Trait.Status where

import Control.Arrow (returnA)
import qualified Network.HTTP.Types.Status as HTTP
import WebGear.Core.Response (Response (responseStatus))
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
response, Status
_) -> do
    let response' :: Response
response' = (forall a (ts :: [*]). With a ts -> a
unwitness With Response ts
response){responseStatus :: Status
responseStatus = Status
status}
    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< With Response ts
-> Response -> Status -> With Response (Status : ts)
f With Response ts
response Response
response' Status
status