{-# OPTIONS_GHC -Wno-orphans #-}

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

import Control.Applicative ((<|>))
import Control.Lens (at, mapped, (%~), (&), (.~), (?~), (^.))
import qualified Data.HashMap.Strict.InsOrd as Map
import Data.Maybe (fromMaybe)
import Data.OpenApi (
  Operation,
  PathItem,
  Referenced (..),
  Response,
  delete,
  description,
  get,
  head_,
  options,
  patch,
  paths,
  post,
  put,
  responses,
  trace,
 )
import qualified Network.HTTP.Types as HTTP
import WebGear.Core.Handler (Description (..))
import qualified WebGear.Core.Response as WG
import WebGear.Core.Trait (Set, With, setTrait)
import WebGear.Core.Trait.Status (Status (..))
import WebGear.OpenApi.Handler (OpenApiHandler (..), addRootPath, consumeDescription)

instance Set (OpenApiHandler m) Status where
  {-# INLINE setTrait #-}
  setTrait ::
    Status ->
    (WG.Response `With` ts -> WG.Response -> HTTP.Status -> WG.Response `With` (Status : ts)) ->
    OpenApiHandler m (WG.Response `With` ts, HTTP.Status) (WG.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 With Response ts
-> Response -> Status -> With Response (Status : ts)
_ = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m (With Response ts, Status) (With Response (Status : ts))
forall {k} {k1} {k2} (m :: k) (a :: k1) (b :: k2).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi)
 -> OpenApiHandler
      m (With Response ts, Status) (With Response (Status : ts)))
-> (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler
     m (With Response ts, Status) (With Response (Status : ts))
forall a b. (a -> b) -> a -> b
$ \OpenApi
doc -> do
    Maybe Description
desc <- StateT Documentation Identity (Maybe Description)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription
    let doc' :: OpenApi
doc' = if InsOrdHashMap FilePath PathItem -> Bool
forall k v. InsOrdHashMap k v -> Bool
Map.null (OpenApi
doc OpenApi
-> Getting
     (InsOrdHashMap FilePath PathItem)
     OpenApi
     (InsOrdHashMap FilePath PathItem)
-> InsOrdHashMap FilePath PathItem
forall s a. s -> Getting a s a -> a
^. Getting
  (InsOrdHashMap FilePath PathItem)
  OpenApi
  (InsOrdHashMap FilePath PathItem)
forall s a. HasPaths s a => Lens' s a
Lens' OpenApi (InsOrdHashMap FilePath PathItem)
paths) then OpenApi -> OpenApi
addRootPath OpenApi
doc else OpenApi
doc
    OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenApi -> State Documentation OpenApi)
-> OpenApi -> State Documentation OpenApi
forall a b. (a -> b) -> a -> b
$ OpenApi
doc' OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> OpenApi -> Identity OpenApi
forall s a. HasPaths s a => Lens' s a
Lens' OpenApi (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> OpenApi -> Identity OpenApi)
-> ((PathItem -> Identity PathItem)
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (PathItem -> Identity PathItem)
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathItem -> Identity PathItem)
-> InsOrdHashMap FilePath PathItem
-> Identity (InsOrdHashMap FilePath PathItem)
Setter
  (InsOrdHashMap FilePath PathItem)
  (InsOrdHashMap FilePath PathItem)
  PathItem
  PathItem
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((PathItem -> Identity PathItem) -> OpenApi -> Identity OpenApi)
-> (PathItem -> PathItem) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Description -> Status -> PathItem -> PathItem
setOperation Maybe Description
desc Status
status

setOperation :: Maybe Description -> Status -> PathItem -> PathItem
setOperation :: Maybe Description -> Status -> PathItem -> PathItem
setOperation Maybe Description
desc (Status Status
status) PathItem
item =
  PathItem
item
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_ ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
    PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasTrace s a => Lens' s a
Lens' PathItem (Maybe Operation)
trace ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> (Maybe Operation -> Maybe Operation) -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe Operation -> Maybe Operation
updateOperation
  where
    httpCode :: HttpStatusCode
httpCode = Status -> HttpStatusCode
HTTP.statusCode Status
status

    updateOperation :: Maybe Operation -> Maybe Operation
    updateOperation :: Maybe Operation -> Maybe Operation
updateOperation Maybe Operation
Nothing = Operation -> Maybe Operation
forall a. a -> Maybe a
Just (Operation -> Maybe Operation) -> Operation -> Maybe Operation
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty @Operation Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
httpCode ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Response -> Referenced Response
addDescription Referenced Response
emptyResp
    updateOperation (Just Operation
op) =
      let resp :: Referenced Response
resp = Referenced Response -> Referenced Response
addDescription (Referenced Response -> Referenced Response)
-> Referenced Response -> Referenced Response
forall a b. (a -> b) -> a -> b
$ Referenced Response
-> Maybe (Referenced Response) -> Referenced Response
forall a. a -> Maybe a -> a
fromMaybe Referenced Response
emptyResp (Maybe (Referenced Response) -> Referenced Response)
-> Maybe (Referenced Response) -> Referenced Response
forall a b. (a -> b) -> a -> b
$ (Operation
op Operation
-> Getting
     (Maybe (Referenced Response))
     Operation
     (Maybe (Referenced Response))
-> Maybe (Referenced Response)
forall s a. s -> Getting a s a -> a
^. Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
httpCode) Maybe (Referenced Response)
-> Maybe (Referenced Response) -> Maybe (Referenced Response)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Operation
op Operation
-> Getting
     (Maybe (Referenced Response))
     Operation
     (Maybe (Referenced Response))
-> Maybe (Referenced Response)
forall s a. s -> Getting a s a -> a
^. Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
0)
       in Operation -> Maybe Operation
forall a. a -> Maybe a
Just (Operation -> Maybe Operation) -> Operation -> Maybe Operation
forall a b. (a -> b) -> a -> b
$ Operation
op Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Responses -> Identity Responses)
-> Operation -> Identity Operation
forall s a. HasResponses s a => Lens' s a
Lens' Operation Responses
responses ((Responses -> Identity Responses)
 -> Operation -> Identity Operation)
-> ((InsOrdHashMap HttpStatusCode (Referenced Response)
     -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
    -> Responses -> Identity Responses)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap HttpStatusCode (Referenced Response)
 -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Responses -> Identity Responses
forall s a. HasResponses s a => Lens' s a
Lens'
  Responses (InsOrdHashMap HttpStatusCode (Referenced Response))
responses ((InsOrdHashMap HttpStatusCode (Referenced Response)
  -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
 -> Operation -> Identity Operation)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> Operation
-> Operation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ HttpStatusCode
-> Referenced Response
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
Map.insert HttpStatusCode
httpCode Referenced Response
resp (InsOrdHashMap HttpStatusCode (Referenced Response)
 -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpStatusCode
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
Map.delete HttpStatusCode
0

    emptyResp :: Referenced Response
    emptyResp :: Referenced Response
emptyResp = Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
forall a. Monoid a => a
mempty

    addDescription :: Referenced Response -> Referenced Response
    addDescription :: Referenced Response -> Referenced Response
addDescription (Ref Reference
r) = Reference -> Referenced Response
forall a. Reference -> Referenced a
Ref Reference
r
    addDescription (Inline Response
r) =
      case Maybe Description
desc of
        Maybe Description
Nothing -> Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
r
        Just (Description Text
d) -> Response -> Referenced Response
forall a. a -> Referenced a
Inline (Response
r Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
d)