{-# OPTIONS_GHC -Wno-orphans #-}

-- | OpenApi implementation of 'Status' trait.
module WebGear.OpenApi.Trait.Status where

import qualified Network.HTTP.Types as HTTP
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Set, With, setTrait)
import WebGear.Core.Trait.Status (Status (..))
import WebGear.OpenApi.Handler (DocNode (DocStatus), OpenApiHandler (..), singletonNode)

instance Set (OpenApiHandler m) Status Response where
  {-# INLINE setTrait #-}
  setTrait ::
    Status ->
    (Response `With` ts -> Response -> HTTP.Status -> Response `With` (Status : ts)) ->
    OpenApiHandler m (Response `With` ts, HTTP.Status) (Response `With` (Status : ts))
  setTrait :: forall (ts :: [*]).
Status
-> (With Response ts
    -> Response -> Status -> With Response (Status : ts))
-> OpenApiHandler
     m (With Response ts, Status) (With Response (Status : ts))
setTrait (Status Status
status) With Response ts
-> Response -> Status -> With Response (Status : ts)
_ = Tree DocNode
-> OpenApiHandler
     m (With Response ts, Status) (With Response (Status : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m (With Response ts, Status) (With Response (Status : ts)))
-> Tree DocNode
-> OpenApiHandler
     m (With Response ts, Status) (With Response (Status : ts))
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Status -> DocNode
DocStatus Status
status)