{-# LANGUAGE CPP #-}

{- | An implementation of `Handler` to generate `OpenApi` documentation
 from WebGear API specifications.
-}
module WebGear.OpenApi.Handler (
  OpenApiHandler (..),
  Documentation (..),
  consumeDescription,
  consumeSummary,
  addRouteDocumentation,
  addRootPath,
  toOpenApi,
) where

import Control.Applicative ((<|>))
import Control.Arrow (Arrow (..), ArrowChoice (..), ArrowPlus (..), ArrowZero (..))
import Control.Arrow.Operations (ArrowError (..))
import qualified Control.Category as Cat
import Control.Lens (at, (%~), (&), (.~), (?~), (^.))
import Control.Monad ((<=<))
import Control.Monad.State.Strict (MonadState, State, evalState, state)
import Data.Coerce (coerce)
import qualified Data.HashMap.Strict.InsOrd as Map
import Data.OpenApi (
  OpenApi,
  Operation,
  PathItem,
  Referenced (..),
  Response,
  allOperations,
  delete,
  description,
  externalDocs,
  get,
  head_,
  options,
  parameters,
  patch,
  paths,
  post,
  put,
  servers,
  summary,
  trace,
 )
import WebGear.Core.Handler (
  Description (..),
  Handler (..),
  RouteMismatch,
  RoutePath (..),
  Summary (..),
 )

-- | A handler that captures `OpenApi` documentation of API specifications.
newtype OpenApiHandler m a b = OpenApiHandler (OpenApi -> State Documentation OpenApi)

data Documentation = Documentation !(Maybe Description) !(Maybe Summary)

consumeDescription :: (MonadState Documentation m) => m (Maybe Description)
consumeDescription :: forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription = (Documentation -> (Maybe Description, Documentation))
-> m (Maybe Description)
forall a. (Documentation -> (a, Documentation)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Documentation -> (Maybe Description, Documentation))
 -> m (Maybe Description))
-> (Documentation -> (Maybe Description, Documentation))
-> m (Maybe Description)
forall a b. (a -> b) -> a -> b
$ \(Documentation Maybe Description
d Maybe Summary
s) -> (Maybe Description
d, Maybe Description -> Maybe Summary -> Documentation
Documentation Maybe Description
forall a. Maybe a
Nothing Maybe Summary
s)

consumeSummary :: (MonadState Documentation m) => m (Maybe Summary)
consumeSummary :: forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Summary)
consumeSummary = (Documentation -> (Maybe Summary, Documentation))
-> m (Maybe Summary)
forall a. (Documentation -> (a, Documentation)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Documentation -> (Maybe Summary, Documentation))
 -> m (Maybe Summary))
-> (Documentation -> (Maybe Summary, Documentation))
-> m (Maybe Summary)
forall a b. (a -> b) -> a -> b
$ \(Documentation Maybe Description
d Maybe Summary
s) -> (Maybe Summary
s, Maybe Description -> Maybe Summary -> Documentation
Documentation Maybe Description
d Maybe Summary
forall a. Maybe a
Nothing)

addRouteDocumentation :: (MonadState Documentation m) => OpenApi -> m OpenApi
addRouteDocumentation :: forall (m :: * -> *).
MonadState Documentation m =>
OpenApi -> m OpenApi
addRouteDocumentation OpenApi
doc = do
  Maybe Description
desc <- m (Maybe Description)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Description)
consumeDescription
  Maybe Summary
summ <- m (Maybe Summary)
forall (m :: * -> *).
MonadState Documentation m =>
m (Maybe Summary)
consumeSummary
  OpenApi -> m OpenApi
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenApi -> m OpenApi) -> OpenApi -> m OpenApi
forall a b. (a -> b) -> a -> b
$
    OpenApi
doc
      -- keep any existing documentation
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation
forall s a. HasSummary s a => Lens' s a
Lens' Operation (Maybe Text)
summary ((Maybe Text -> Identity (Maybe Text))
 -> OpenApi -> Identity OpenApi)
-> (Maybe Text -> Maybe Text) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Summary -> Text) -> Maybe Summary -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Summary -> Text
getSummary Maybe Summary
summ)
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
allOperations ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> Operation -> Identity Operation
forall s a. HasDescription s a => Lens' s a
Lens' Operation (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> OpenApi -> Identity OpenApi)
-> (Maybe Text -> Maybe Text) -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Description -> Text) -> Maybe Description -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
desc)

addRootPath :: OpenApi -> OpenApi
addRootPath :: OpenApi -> OpenApi
addRootPath OpenApi
doc = 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)
-> InsOrdHashMap FilePath PathItem -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(FilePath
"/", PathItem
rootPathItem)]
  where
    rootPathItem :: PathItem
    rootPathItem :: PathItem
rootPathItem =
      forall a. Monoid a => a
mempty @PathItem
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        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)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr

    opr :: Operation
    opr :: Operation
opr = 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
0 ((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
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline (forall a. Monoid a => a
mempty @Response)

instance Cat.Category (OpenApiHandler m) where
  {-# INLINE id #-}
  id :: OpenApiHandler m a a
  id :: forall {k} (a :: k). OpenApiHandler m a a
id = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE (.) #-}
  (.) :: OpenApiHandler m b c -> OpenApiHandler m a b -> OpenApiHandler m a c
  OpenApiHandler OpenApi -> State Documentation OpenApi
g . :: forall {k} {k} {k} (b :: k) (c :: k) (a :: k).
OpenApiHandler m b c
-> OpenApiHandler m a b -> OpenApiHandler m a c
. OpenApiHandler OpenApi -> State Documentation OpenApi
f = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a c
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a c)
-> (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a c
forall a b. (a -> b) -> a -> b
$ OpenApi -> State Documentation OpenApi
f (OpenApi -> State Documentation OpenApi)
-> (OpenApi -> State Documentation OpenApi)
-> OpenApi
-> State Documentation OpenApi
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< OpenApi -> State Documentation OpenApi
g

instance Arrow (OpenApiHandler m) where
  {-# INLINE arr #-}
  arr :: (a -> b) -> OpenApiHandler m a b
  arr :: forall b c. (b -> c) -> OpenApiHandler m b c
arr a -> b
_ = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE first #-}
  first :: OpenApiHandler m b c -> OpenApiHandler m (b, d) (c, d)
  first :: forall b c d.
OpenApiHandler m b c -> OpenApiHandler m (b, d) (c, d)
first = OpenApiHandler m b c -> OpenApiHandler m (b, d) (c, d)
forall a b. Coercible a b => a -> b
coerce

  {-# INLINE second #-}
  second :: OpenApiHandler m b c -> OpenApiHandler m (d, b) (d, c)
  second :: forall b c d.
OpenApiHandler m b c -> OpenApiHandler m (d, b) (d, c)
second = OpenApiHandler m b c -> OpenApiHandler m (d, b) (d, c)
forall a b. Coercible a b => a -> b
coerce

instance ArrowZero (OpenApiHandler m) where
  {-# INLINE zeroArrow #-}
  zeroArrow :: OpenApiHandler m b c
  zeroArrow :: forall {k} {k} (b :: k) (c :: k). OpenApiHandler m b c
zeroArrow = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m b c
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

newtype MergeOpenApi = MergeOpenApi (OpenApi -> State Documentation OpenApi)

instance Semigroup MergeOpenApi where
  MergeOpenApi OpenApi -> State Documentation OpenApi
f <> :: MergeOpenApi -> MergeOpenApi -> MergeOpenApi
<> MergeOpenApi OpenApi -> State Documentation OpenApi
g =
    (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi ((OpenApi -> State Documentation OpenApi) -> MergeOpenApi)
-> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
forall a b. (a -> b) -> a -> b
$ \OpenApi
doc -> do
      OpenApi
a <- OpenApi -> State Documentation OpenApi
f OpenApi
doc
      OpenApi
b <- OpenApi -> State Documentation OpenApi
g 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
a OpenApi -> OpenApi -> OpenApi
forall a. Semigroup a => a -> a -> a
<> OpenApi
b)
          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)
-> InsOrdHashMap FilePath PathItem -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem -> PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v)
-> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
Map.unionWith PathItem -> PathItem -> PathItem
mergePathItem (OpenApi
a 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) (OpenApi
b 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)
          OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Maybe ExternalDocs -> Identity (Maybe ExternalDocs))
-> OpenApi -> Identity OpenApi
forall s a. HasExternalDocs s a => Lens' s a
Lens' OpenApi (Maybe ExternalDocs)
externalDocs ((Maybe ExternalDocs -> Identity (Maybe ExternalDocs))
 -> OpenApi -> Identity OpenApi)
-> Maybe ExternalDocs -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (OpenApi
a OpenApi
-> Getting (Maybe ExternalDocs) OpenApi (Maybe ExternalDocs)
-> Maybe ExternalDocs
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ExternalDocs) OpenApi (Maybe ExternalDocs)
forall s a. HasExternalDocs s a => Lens' s a
Lens' OpenApi (Maybe ExternalDocs)
externalDocs Maybe ExternalDocs -> Maybe ExternalDocs -> Maybe ExternalDocs
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenApi
b OpenApi
-> Getting (Maybe ExternalDocs) OpenApi (Maybe ExternalDocs)
-> Maybe ExternalDocs
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ExternalDocs) OpenApi (Maybe ExternalDocs)
forall s a. HasExternalDocs s a => Lens' s a
Lens' OpenApi (Maybe ExternalDocs)
externalDocs)
    where
      mergePathItem :: PathItem -> PathItem -> PathItem
      mergePathItem :: PathItem -> PathItem -> PathItem
mergePathItem PathItem
x PathItem
y =
        forall a. Monoid a => a
mempty @PathItem
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_ Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put
          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 -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasTrace s a => Lens' s a
Lens' PathItem (Maybe Operation)
trace Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasTrace s a => Lens' s a
Lens' PathItem (Maybe Operation)
trace
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> PathItem -> Identity PathItem
forall s a. HasSummary s a => Lens' s a
Lens' PathItem (Maybe Text)
summary ((Maybe Text -> Identity (Maybe Text))
 -> PathItem -> Identity PathItem)
-> Maybe Text -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem
x PathItem
-> Getting (Maybe Text) PathItem (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PathItem (Maybe Text)
forall s a. HasSummary s a => Lens' s a
Lens' PathItem (Maybe Text)
summary Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem
y PathItem
-> Getting (Maybe Text) PathItem (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PathItem (Maybe Text)
forall s a. HasSummary s a => Lens' s a
Lens' PathItem (Maybe Text)
summary)
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> PathItem -> Identity PathItem
forall s a. HasDescription s a => Lens' s a
Lens' PathItem (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> PathItem -> Identity PathItem)
-> Maybe Text -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem
x PathItem
-> Getting (Maybe Text) PathItem (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PathItem (Maybe Text)
forall s a. HasDescription s a => Lens' s a
Lens' PathItem (Maybe Text)
description Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem
y PathItem
-> Getting (Maybe Text) PathItem (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PathItem (Maybe Text)
forall s a. HasDescription s a => Lens' s a
Lens' PathItem (Maybe Text)
description)
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& ([Referenced Param] -> Identity [Referenced Param])
-> PathItem -> Identity PathItem
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> PathItem -> Identity PathItem)
-> [Referenced Param] -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem
x PathItem
-> Getting [Referenced Param] PathItem [Referenced Param]
-> [Referenced Param]
forall s a. s -> Getting a s a -> a
^. Getting [Referenced Param] PathItem [Referenced Param]
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters [Referenced Param] -> [Referenced Param] -> [Referenced Param]
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting [Referenced Param] PathItem [Referenced Param]
-> [Referenced Param]
forall s a. s -> Getting a s a -> a
^. Getting [Referenced Param] PathItem [Referenced Param]
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters)
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& ([Server] -> Identity [Server]) -> PathItem -> Identity PathItem
forall s a. HasServers s a => Lens' s a
Lens' PathItem [Server]
servers (([Server] -> Identity [Server]) -> PathItem -> Identity PathItem)
-> [Server] -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem
x PathItem -> Getting [Server] PathItem [Server] -> [Server]
forall s a. s -> Getting a s a -> a
^. Getting [Server] PathItem [Server]
forall s a. HasServers s a => Lens' s a
Lens' PathItem [Server]
servers [Server] -> [Server] -> [Server]
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem -> Getting [Server] PathItem [Server] -> [Server]
forall s a. s -> Getting a s a -> a
^. Getting [Server] PathItem [Server]
forall s a. HasServers s a => Lens' s a
Lens' PathItem [Server]
servers)

instance ArrowPlus (OpenApiHandler m) where
  {-# INLINE (<+>) #-}
  (<+>) :: OpenApiHandler m b c -> OpenApiHandler m b c -> OpenApiHandler m b c
  OpenApiHandler OpenApi -> State Documentation OpenApi
f <+> :: forall {k} {k} (b :: k) (c :: k).
OpenApiHandler m b c
-> OpenApiHandler m b c -> OpenApiHandler m b c
<+> OpenApiHandler OpenApi -> State Documentation OpenApi
g = MergeOpenApi -> OpenApiHandler m b c
forall a b. Coercible a b => a -> b
coerce (MergeOpenApi -> OpenApiHandler m b c)
-> MergeOpenApi -> OpenApiHandler m b c
forall a b. (a -> b) -> a -> b
$ (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
f MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
g

instance ArrowChoice (OpenApiHandler m) where
  {-# INLINE left #-}
  left :: OpenApiHandler m b c -> OpenApiHandler m (Either b d) (Either c d)
  left :: forall b c d.
OpenApiHandler m b c -> OpenApiHandler m (Either b d) (Either c d)
left (OpenApiHandler OpenApi -> State Documentation OpenApi
doc) = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler m (Either b d) (Either c d)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
doc

  {-# INLINE right #-}
  right :: OpenApiHandler m b c -> OpenApiHandler m (Either d b) (Either d c)
  right :: forall b c d.
OpenApiHandler m b c -> OpenApiHandler m (Either d b) (Either d c)
right (OpenApiHandler OpenApi -> State Documentation OpenApi
doc) = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler m (Either d b) (Either d c)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
doc

  {-# INLINE (+++) #-}
  (+++) :: OpenApiHandler m b c -> OpenApiHandler m b' c' -> OpenApiHandler m (Either b b') (Either c c')
  OpenApiHandler OpenApi -> State Documentation OpenApi
f +++ :: forall b c b' c'.
OpenApiHandler m b c
-> OpenApiHandler m b' c'
-> OpenApiHandler m (Either b b') (Either c c')
+++ OpenApiHandler OpenApi -> State Documentation OpenApi
g = MergeOpenApi -> OpenApiHandler m (Either b b') (Either c c')
forall a b. Coercible a b => a -> b
coerce (MergeOpenApi -> OpenApiHandler m (Either b b') (Either c c'))
-> MergeOpenApi -> OpenApiHandler m (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
f MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
g

  {-# INLINE (|||) #-}
  (|||) :: OpenApiHandler m b d -> OpenApiHandler m c d -> OpenApiHandler m (Either b c) d
  OpenApiHandler OpenApi -> State Documentation OpenApi
f ||| :: forall {k} b (d :: k) c.
OpenApiHandler m b d
-> OpenApiHandler m c d -> OpenApiHandler m (Either b c) d
||| OpenApiHandler OpenApi -> State Documentation OpenApi
g = MergeOpenApi -> OpenApiHandler m (Either b c) d
forall a b. Coercible a b => a -> b
coerce (MergeOpenApi -> OpenApiHandler m (Either b c) d)
-> MergeOpenApi -> OpenApiHandler m (Either b c) d
forall a b. (a -> b) -> a -> b
$ (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
f MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
g

instance ArrowError RouteMismatch (OpenApiHandler m) where
  {-# INLINE raise #-}
  raise :: forall b. OpenApiHandler m RouteMismatch b
raise = (OpenApi -> State Documentation OpenApi)
-> OpenApiHandler m RouteMismatch b
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE handle #-}
  OpenApiHandler OpenApi -> State Documentation OpenApi
f handle :: forall e b.
OpenApiHandler m e b
-> OpenApiHandler m (e, RouteMismatch) b -> OpenApiHandler m e b
`handle` OpenApiHandler OpenApi -> State Documentation OpenApi
g = MergeOpenApi -> OpenApiHandler m e b
forall a b. Coercible a b => a -> b
coerce (MergeOpenApi -> OpenApiHandler m e b)
-> MergeOpenApi -> OpenApiHandler m e b
forall a b. (a -> b) -> a -> b
$ (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
f MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
g

  {-# INLINE tryInUnless #-}
  tryInUnless :: forall e b c.
OpenApiHandler m e b
-> OpenApiHandler m (e, b) c
-> OpenApiHandler m (e, RouteMismatch) c
-> OpenApiHandler m e c
tryInUnless (OpenApiHandler OpenApi -> State Documentation OpenApi
f) (OpenApiHandler OpenApi -> State Documentation OpenApi
g) (OpenApiHandler OpenApi -> State Documentation OpenApi
h) =
    MergeOpenApi -> OpenApiHandler m e c
forall a b. Coercible a b => a -> b
coerce (MergeOpenApi -> OpenApiHandler m e c)
-> MergeOpenApi -> OpenApiHandler m e c
forall a b. (a -> b) -> a -> b
$ (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
f MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
g MergeOpenApi -> MergeOpenApi -> MergeOpenApi
forall a. Semigroup a => a -> a -> a
<> (OpenApi -> State Documentation OpenApi) -> MergeOpenApi
MergeOpenApi OpenApi -> State Documentation OpenApi
h

instance (Monad m) => Handler (OpenApiHandler m) m where
  {-# INLINE arrM #-}
  arrM :: (a -> m b) -> OpenApiHandler m a b
  arrM :: forall a b. (a -> m b) -> OpenApiHandler m a b
arrM a -> m b
_ = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  {-# INLINE consumeRoute #-}
  consumeRoute :: OpenApiHandler m RoutePath a -> OpenApiHandler m () a
  consumeRoute :: forall {k} (a :: k).
OpenApiHandler m RoutePath a -> OpenApiHandler m () a
consumeRoute (OpenApiHandler OpenApi -> State Documentation OpenApi
f) = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m () a
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler OpenApi -> State Documentation OpenApi
f

  {-# INLINE setDescription #-}
  setDescription :: Description -> OpenApiHandler m a a
  setDescription :: forall {k} (a :: k). Description -> OpenApiHandler m a a
setDescription Description
d = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a)
-> (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a
forall a b. (a -> b) -> a -> b
$ \OpenApi
doc ->
    (Documentation -> (OpenApi, Documentation))
-> State Documentation OpenApi
forall a.
(Documentation -> (a, Documentation))
-> StateT Documentation Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Documentation -> (OpenApi, Documentation))
 -> State Documentation OpenApi)
-> (Documentation -> (OpenApi, Documentation))
-> State Documentation OpenApi
forall a b. (a -> b) -> a -> b
$ \(Documentation Maybe Description
_ Maybe Summary
s) -> (OpenApi
doc, Maybe Description -> Maybe Summary -> Documentation
Documentation (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
d) Maybe Summary
s)

  {-# INLINE setSummary #-}
  setSummary :: Summary -> OpenApiHandler m a a
  setSummary :: forall {k} (a :: k). Summary -> OpenApiHandler m a a
setSummary Summary
s = (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a b
OpenApiHandler ((OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a)
-> (OpenApi -> State Documentation OpenApi) -> OpenApiHandler m a a
forall a b. (a -> b) -> a -> b
$ \OpenApi
doc ->
    (Documentation -> (OpenApi, Documentation))
-> State Documentation OpenApi
forall a.
(Documentation -> (a, Documentation))
-> StateT Documentation Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((Documentation -> (OpenApi, Documentation))
 -> State Documentation OpenApi)
-> (Documentation -> (OpenApi, Documentation))
-> State Documentation OpenApi
forall a b. (a -> b) -> a -> b
$ \(Documentation Maybe Description
d Maybe Summary
_) -> (OpenApi
doc, Maybe Description -> Maybe Summary -> Documentation
Documentation Maybe Description
d (Summary -> Maybe Summary
forall a. a -> Maybe a
Just Summary
s))

-- | Generate OpenApi documentation from a handler
toOpenApi :: OpenApiHandler m a b -> OpenApi
toOpenApi :: forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
OpenApiHandler m a b -> OpenApi
toOpenApi (OpenApiHandler OpenApi -> State Documentation OpenApi
f) = State Documentation OpenApi -> Documentation -> OpenApi
forall s a. State s a -> s -> a
evalState (OpenApi -> State Documentation OpenApi
f OpenApi
forall a. Monoid a => a
mempty) (Maybe Description -> Maybe Summary -> Documentation
Documentation Maybe Description
forall a. Maybe a
Nothing Maybe Summary
forall a. Maybe a
Nothing)