{-# 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 (Linked, Set, setTrait)
import WebGear.Core.Trait.Status (Status (..))
import WebGear.OpenApi.Handler (DocNode (DocStatus), OpenApiHandler (..), singletonNode)

instance Set (OpenApiHandler m) Status Response where
  {-# INLINEABLE setTrait #-}
  setTrait ::
    Status ->
    (Linked ts Response -> Response -> HTTP.Status -> Linked (Status : ts) Response) ->
    OpenApiHandler m (Linked ts Response, HTTP.Status) (Linked (Status : ts) Response)
  setTrait :: Status
-> (Linked ts Response
    -> Response -> Status -> Linked (Status : ts) Response)
-> OpenApiHandler
     m (Linked ts Response, Status) (Linked (Status : ts) Response)
setTrait (Status Status
status) Linked ts Response
-> Response -> Status -> Linked (Status : ts) Response
_ = Tree DocNode
-> OpenApiHandler
     m (Linked ts Response, Status) (Linked (Status : ts) Response)
forall k k k (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler (Tree DocNode
 -> OpenApiHandler
      m (Linked ts Response, Status) (Linked (Status : ts) Response))
-> Tree DocNode
-> OpenApiHandler
     m (Linked ts Response, Status) (Linked (Status : ts) Response)
forall a b. (a -> b) -> a -> b
$ DocNode -> Tree DocNode
forall a. a -> Tree a
singletonNode (Status -> DocNode
DocStatus Status
status)