{-# LANGUAGE CPP #-}
{- | An implementation of `Handler` to generate `OpenApi` documentation
 from WebGear API specifications.
-}
module WebGear.OpenApi.Handler (
  OpenApiHandler (..),
  DocNode (..),
  Tree,
  singletonNode,
  nullNode,
  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 qualified Data.HashMap.Strict.InsOrd as Map
import Data.OpenApi
import Data.OpenApi.Internal.Utils (swaggerMappend)
import Data.Text (Text)
import qualified Data.Text as Text
import Network.HTTP.Media.MediaType (MediaType)
import qualified Network.HTTP.Types as HTTP
import WebGear.Core.Handler (Description (..), Handler (..), RouteMismatch, RoutePath (..), Summary (..))

-- | A tree where internal nodes have one or two children.
data Tree a
  = NullNode
  | SingleNode a (Tree a)
  | BinaryNode (Tree a) (Tree a)
  deriving stock (HttpStatusCode -> Tree a -> ShowS
forall a. Show a => HttpStatusCode -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> FilePath
forall a.
(HttpStatusCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> FilePath
$cshow :: forall a. Show a => Tree a -> FilePath
showsPrec :: HttpStatusCode -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => HttpStatusCode -> Tree a -> ShowS
Show)

-- | Different types of documentation elements captured by the handler
data DocNode
  = DocSecurityScheme Text SecurityScheme
  | DocRequestBody (Definitions Schema) RequestBody
  | DocResponseBody (Definitions Schema) MediaType MediaTypeObject
  | DocRequestHeader Param
  | DocResponseHeader HeaderName Header
  | DocMethod HTTP.StdMethod
  | DocPathElem Text
  | DocPathVar Param
  | DocQueryParam Param
  | DocStatus HTTP.Status
  | DocSummary Summary
  | DocDescription Description
  deriving stock (HttpStatusCode -> DocNode -> ShowS
[DocNode] -> ShowS
DocNode -> FilePath
forall a.
(HttpStatusCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DocNode] -> ShowS
$cshowList :: [DocNode] -> ShowS
show :: DocNode -> FilePath
$cshow :: DocNode -> FilePath
showsPrec :: HttpStatusCode -> DocNode -> ShowS
$cshowsPrec :: HttpStatusCode -> DocNode -> ShowS
Show)

-- | Documentation elements after compaction
data CompactDocNode
  = CDocSecurityScheme Text SecurityScheme
  | CDocRequestBody (Definitions Schema) RequestBody
  | CDocResponseBody (Definitions Schema) MediaType MediaTypeObject
  | CDocRequestHeader Param
  | CDocResponseHeader HeaderName Header
  | CDocMethod HTTP.StdMethod
  | CDocPathElem Text
  | CDocPathVar Param
  | CDocRouteDoc (Maybe Summary) (Maybe Description)
  | CDocQueryParam Param
  | CDocStatus HTTP.Status (Maybe Description)
  deriving stock (HttpStatusCode -> CompactDocNode -> ShowS
[CompactDocNode] -> ShowS
CompactDocNode -> FilePath
forall a.
(HttpStatusCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompactDocNode] -> ShowS
$cshowList :: [CompactDocNode] -> ShowS
show :: CompactDocNode -> FilePath
$cshow :: CompactDocNode -> FilePath
showsPrec :: HttpStatusCode -> CompactDocNode -> ShowS
$cshowsPrec :: HttpStatusCode -> CompactDocNode -> ShowS
Show)

-- | Generate a tree with a single node
singletonNode :: a -> Tree a
singletonNode :: forall a. a -> Tree a
singletonNode a
a = forall a. a -> Tree a -> Tree a
SingleNode a
a forall a. Tree a
NullNode

-- | Generate an empty tree
nullNode :: Tree a
nullNode :: forall a. Tree a
nullNode = forall a. Tree a
NullNode

{- | A handler that captured `OpenApi` documentation of API
 specifications.
-}
newtype OpenApiHandler m a b = OpenApiHandler
  {forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
OpenApiHandler m a b -> Tree DocNode
openApiDoc :: Tree DocNode}

instance Cat.Category (OpenApiHandler m) where
  id :: OpenApiHandler m a a
  id :: forall {k} (a :: k). OpenApiHandler m a a
id = OpenApiHandler{openApiDoc :: Tree DocNode
openApiDoc = forall a. Tree a
NullNode}

  (.) :: OpenApiHandler m b c -> OpenApiHandler m a b -> OpenApiHandler m a c
  OpenApiHandler Tree DocNode
doc2 . :: forall {k} {k} {k} (b :: k) (c :: k) (a :: k).
OpenApiHandler m b c
-> OpenApiHandler m a b -> OpenApiHandler m a c
. OpenApiHandler Tree DocNode
doc1 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ Tree DocNode -> Tree DocNode -> Tree DocNode
insertAsLeaf Tree DocNode
doc1 Tree DocNode
doc2
    where
      insertAsLeaf :: Tree DocNode -> Tree DocNode -> Tree DocNode
      insertAsLeaf :: Tree DocNode -> Tree DocNode -> Tree DocNode
insertAsLeaf Tree DocNode
parent Tree DocNode
child = case Tree DocNode
parent of
        Tree DocNode
NullNode -> Tree DocNode
child
        SingleNode DocNode
doc Tree DocNode
next -> forall a. a -> Tree a -> Tree a
SingleNode DocNode
doc (Tree DocNode -> Tree DocNode -> Tree DocNode
insertAsLeaf Tree DocNode
next Tree DocNode
child)
        BinaryNode Tree DocNode
b1 Tree DocNode
b2 -> forall a. Tree a -> Tree a -> Tree a
BinaryNode (Tree DocNode -> Tree DocNode -> Tree DocNode
insertAsLeaf Tree DocNode
b1 Tree DocNode
child) (Tree DocNode -> Tree DocNode -> Tree DocNode
insertAsLeaf Tree DocNode
b2 Tree DocNode
child)

instance Arrow (OpenApiHandler m) where
  arr :: (a -> b) -> OpenApiHandler m a b
  arr :: forall b c. (b -> c) -> OpenApiHandler m b c
arr a -> b
_ = OpenApiHandler{openApiDoc :: Tree DocNode
openApiDoc = forall a. Tree a
NullNode}

  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 Tree DocNode
doc) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc

  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 Tree DocNode
doc) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc

instance ArrowZero (OpenApiHandler m) where
  zeroArrow :: OpenApiHandler m b c
  zeroArrow :: forall {k} {k} (b :: k) (c :: k). OpenApiHandler m b c
zeroArrow = OpenApiHandler{openApiDoc :: Tree DocNode
openApiDoc = forall a. Tree a
NullNode}

instance ArrowPlus (OpenApiHandler m) where
  (<+>) :: OpenApiHandler m b c -> OpenApiHandler m b c -> OpenApiHandler m b c
  OpenApiHandler Tree DocNode
NullNode <+> :: forall {k} {k} (b :: k) (c :: k).
OpenApiHandler m b c
-> OpenApiHandler m b c -> OpenApiHandler m b c
<+> OpenApiHandler Tree DocNode
doc = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
doc <+> OpenApiHandler Tree DocNode
NullNode = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
doc1 <+> OpenApiHandler Tree DocNode
doc2 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2

instance ArrowChoice (OpenApiHandler m) where
  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 Tree DocNode
doc) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc

  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 Tree DocNode
doc) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc

  (+++) :: OpenApiHandler m b c -> OpenApiHandler m b' c' -> OpenApiHandler m (Either b b') (Either c c')
  OpenApiHandler Tree DocNode
doc +++ :: forall b c b' c'.
OpenApiHandler m b c
-> OpenApiHandler m b' c'
-> OpenApiHandler m (Either b b') (Either c c')
+++ OpenApiHandler Tree DocNode
NullNode = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
NullNode +++ OpenApiHandler Tree DocNode
doc = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
doc1 +++ OpenApiHandler Tree DocNode
doc2 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2

  (|||) :: OpenApiHandler m b d -> OpenApiHandler m c d -> OpenApiHandler m (Either b c) d
  OpenApiHandler Tree DocNode
doc ||| :: forall {k} b (d :: k) c.
OpenApiHandler m b d
-> OpenApiHandler m c d -> OpenApiHandler m (Either b c) d
||| OpenApiHandler Tree DocNode
NullNode = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
NullNode ||| OpenApiHandler Tree DocNode
doc = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc
  OpenApiHandler Tree DocNode
doc1 ||| OpenApiHandler Tree DocNode
doc2 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2

instance ArrowError RouteMismatch (OpenApiHandler m) where
  {-# INLINEABLE raise #-}
  raise :: forall b. OpenApiHandler m RouteMismatch b
raise = OpenApiHandler{openApiDoc :: Tree DocNode
openApiDoc = forall a. Tree a
NullNode}

  {-# INLINEABLE handle #-}
  OpenApiHandler Tree DocNode
doc1 handle :: forall e b.
OpenApiHandler m e b
-> OpenApiHandler m (e, RouteMismatch) b -> OpenApiHandler m e b
`handle` OpenApiHandler Tree DocNode
doc2 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2

  {-# INLINEABLE 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 Tree DocNode
doc1) (OpenApiHandler Tree DocNode
doc2) (OpenApiHandler Tree DocNode
doc3) =
    forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> Tree a -> Tree a
BinaryNode (forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2) Tree DocNode
doc3

instance Monad m => Handler (OpenApiHandler m) m where
  {-# INLINEABLE arrM #-}
  arrM :: (a -> m b) -> OpenApiHandler m a b
  arrM :: forall a b. (a -> m b) -> OpenApiHandler m a b
arrM a -> m b
_ = OpenApiHandler{openApiDoc :: Tree DocNode
openApiDoc = forall a. Tree a
NullNode}

  {-# INLINEABLE consumeRoute #-}
  consumeRoute :: OpenApiHandler m RoutePath a -> OpenApiHandler m () a
  consumeRoute :: forall {k} (a :: k).
OpenApiHandler m RoutePath a -> OpenApiHandler m () a
consumeRoute (OpenApiHandler Tree DocNode
doc) = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler Tree DocNode
doc

  {-# INLINEABLE setDescription #-}
  setDescription :: Description -> OpenApiHandler m a a
  setDescription :: forall {k} (a :: k). Description -> OpenApiHandler m a a
setDescription = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Tree a
singletonNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description -> DocNode
DocDescription

  {-# INLINEABLE setSummary #-}
  setSummary :: Summary -> OpenApiHandler m a a
  setSummary :: forall {k} (a :: k). Summary -> OpenApiHandler m a a
setSummary = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> OpenApiHandler m a b
OpenApiHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Tree a
singletonNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Summary -> DocNode
DocSummary

-- | 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 = Tree CompactDocNode -> OpenApi
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree DocNode -> Tree CompactDocNode
compact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
OpenApiHandler m a b -> Tree DocNode
openApiDoc
  where
    go :: Tree CompactDocNode -> OpenApi
go Tree CompactDocNode
t = case Tree CompactDocNode
t of
      Tree CompactDocNode
NullNode -> forall a. Monoid a => a
mempty
      SingleNode CompactDocNode
parent Tree CompactDocNode
child -> CompactDocNode -> Tree CompactDocNode -> OpenApi -> OpenApi
mergeDoc CompactDocNode
parent Tree CompactDocNode
child forall a. Monoid a => a
mempty
      BinaryNode Tree CompactDocNode
t1 Tree CompactDocNode
t2 -> Tree CompactDocNode -> OpenApi
go Tree CompactDocNode
t1 OpenApi -> OpenApi -> OpenApi
`combineOpenApi` Tree CompactDocNode -> OpenApi
go Tree CompactDocNode
t2

compact :: Tree DocNode -> Tree CompactDocNode
compact :: Tree DocNode -> Tree CompactDocNode
compact Tree DocNode
t = let (Maybe Description
_, Maybe Summary
_, Tree CompactDocNode
t') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
t in Tree CompactDocNode
t'
  where
    go :: Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go = \case
      Tree DocNode
NullNode -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Tree a
NullNode)
      BinaryNode Tree DocNode
t1 Tree DocNode
t2 ->
        let (Maybe Description
descr1, Maybe Summary
summ1, Tree CompactDocNode
t1') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
t1
            (Maybe Description
descr2, Maybe Summary
summ2, Tree CompactDocNode
t2') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
t2
         in (Maybe Description
descr1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Description
descr2, Maybe Summary
summ1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Summary
summ2, forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree CompactDocNode
t1' Tree CompactDocNode
t2')
      SingleNode DocNode
node Tree DocNode
child -> DocNode
-> Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
compactDoc DocNode
node Tree DocNode
child

    compactDoc :: DocNode -> Tree DocNode -> (Maybe Description, Maybe Summary, Tree CompactDocNode)
    compactDoc :: DocNode
-> Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
compactDoc (DocSecurityScheme Text
schemeName SecurityScheme
scheme) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
          scheme' :: SecurityScheme
scheme' = SecurityScheme
scheme forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Text -> SecurityScheme -> CompactDocNode
CDocSecurityScheme Text
schemeName SecurityScheme
scheme') Tree CompactDocNode
child')
    compactDoc (DocRequestBody Definitions Schema
defs RequestBody
body) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
          body' :: RequestBody
body' = RequestBody
body forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Definitions Schema -> RequestBody -> CompactDocNode
CDocRequestBody Definitions Schema
defs RequestBody
body') Tree CompactDocNode
child')
    compactDoc (DocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
mediaTypeObject) Tree DocNode
child =
      forall a. a -> Tree a -> Tree a
SingleNode (Definitions Schema
-> MediaType -> MediaTypeObject -> CompactDocNode
CDocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
mediaTypeObject) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
    compactDoc (DocRequestHeader Param
param) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
          param' :: Param
param' = Param
param forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Param -> CompactDocNode
CDocRequestHeader Param
param') Tree CompactDocNode
child')
    compactDoc (DocResponseHeader Text
headerName Header
header) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
          header' :: Header
header' = Header
header forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Text -> Header -> CompactDocNode
CDocResponseHeader Text
headerName Header
header') Tree CompactDocNode
child')
    compactDoc (DocMethod StdMethod
m) Tree DocNode
child =
      (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, CompactDocNode -> Tree DocNode -> Tree CompactDocNode
addRouteDoc (StdMethod -> CompactDocNode
CDocMethod StdMethod
m) Tree DocNode
child)
    compactDoc (DocPathElem Text
path) Tree DocNode
child =
      (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, CompactDocNode -> Tree DocNode -> Tree CompactDocNode
addRouteDoc (Text -> CompactDocNode
CDocPathElem Text
path) Tree DocNode
child)
    compactDoc (DocPathVar Param
param) Tree DocNode
child =
      (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, CompactDocNode -> Tree DocNode -> Tree CompactDocNode
addRouteDoc (Param -> CompactDocNode
CDocPathVar Param
param) Tree DocNode
child)
    compactDoc (DocQueryParam Param
param) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
          param' :: Param
param' = Param
param forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Param -> CompactDocNode
CDocQueryParam Param
param') Tree CompactDocNode
child')
    compactDoc (DocStatus Status
status) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
       in (forall a. Maybe a
Nothing, Maybe Summary
summ, forall a. a -> Tree a -> Tree a
SingleNode (Status -> Maybe Description -> CompactDocNode
CDocStatus Status
status Maybe Description
descr) Tree CompactDocNode
child')
    compactDoc (DocSummary Summary
summ) Tree DocNode
child =
      let (Maybe Description
descr, Maybe Summary
_, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
       in (Maybe Description
descr, forall a. a -> Maybe a
Just Summary
summ, Tree CompactDocNode
child')
    compactDoc (DocDescription Description
descr) Tree DocNode
child =
      let (Maybe Description
_, Maybe Summary
summ, Tree CompactDocNode
child') = Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child
       in (forall a. a -> Maybe a
Just Description
descr, Maybe Summary
summ, Tree CompactDocNode
child')

    addRouteDoc :: CompactDocNode -> Tree DocNode -> Tree CompactDocNode
    addRouteDoc :: CompactDocNode -> Tree DocNode -> Tree CompactDocNode
addRouteDoc CompactDocNode
node Tree DocNode
child = case Tree DocNode
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
go Tree DocNode
child of
      (Maybe Description
Nothing, Maybe Summary
Nothing, Tree CompactDocNode
child') -> forall a. a -> Tree a -> Tree a
SingleNode CompactDocNode
node Tree CompactDocNode
child'
      (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') -> forall a. a -> Tree a -> Tree a
SingleNode (Maybe Summary -> Maybe Description -> CompactDocNode
CDocRouteDoc Maybe Summary
summ Maybe Description
descr) (forall a. a -> Tree a -> Tree a
SingleNode CompactDocNode
node Tree CompactDocNode
child')

postOrder :: Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder :: Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
NullNode OpenApi
doc OpenApi -> OpenApi
f = OpenApi -> OpenApi
f OpenApi
doc
postOrder (SingleNode CompactDocNode
node Tree CompactDocNode
child) OpenApi
doc OpenApi -> OpenApi
f = OpenApi -> OpenApi
f forall a b. (a -> b) -> a -> b
$ CompactDocNode -> Tree CompactDocNode -> OpenApi -> OpenApi
mergeDoc CompactDocNode
node Tree CompactDocNode
child OpenApi
doc
postOrder (BinaryNode Tree CompactDocNode
t1 Tree CompactDocNode
t2) OpenApi
doc OpenApi -> OpenApi
f =
  OpenApi -> OpenApi
f forall a b. (a -> b) -> a -> b
$ Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
t1 OpenApi
doc forall a. a -> a
id OpenApi -> OpenApi -> OpenApi
`combineOpenApi` Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
t2 OpenApi
doc forall a. a -> a
id

preOrder :: Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
preOrder :: Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
preOrder Tree CompactDocNode
NullNode OpenApi
doc OpenApi -> OpenApi
f = OpenApi -> OpenApi
f OpenApi
doc
preOrder (SingleNode CompactDocNode
node Tree CompactDocNode
child) OpenApi
doc OpenApi -> OpenApi
f = CompactDocNode -> Tree CompactDocNode -> OpenApi -> OpenApi
mergeDoc CompactDocNode
node Tree CompactDocNode
child (OpenApi -> OpenApi
f OpenApi
doc)
preOrder (BinaryNode Tree CompactDocNode
t1 Tree CompactDocNode
t2) OpenApi
doc OpenApi -> OpenApi
f =
  let doc' :: OpenApi
doc' = OpenApi -> OpenApi
f OpenApi
doc
   in Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
t1 OpenApi
doc' forall a. a -> a
id OpenApi -> OpenApi -> OpenApi
`combineOpenApi` Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
t2 OpenApi
doc' forall a. a -> a
id

combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem PathItem
s PathItem
t =
  PathItem
    { _pathItemGet :: Maybe Operation
_pathItemGet = PathItem -> Maybe Operation
_pathItemGet PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemGet PathItem
t
    , _pathItemPut :: Maybe Operation
_pathItemPut = PathItem -> Maybe Operation
_pathItemPut PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPut PathItem
t
    , _pathItemPost :: Maybe Operation
_pathItemPost = PathItem -> Maybe Operation
_pathItemPost PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPost PathItem
t
    , _pathItemDelete :: Maybe Operation
_pathItemDelete = PathItem -> Maybe Operation
_pathItemDelete PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemDelete PathItem
t
    , _pathItemOptions :: Maybe Operation
_pathItemOptions = PathItem -> Maybe Operation
_pathItemOptions PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemOptions PathItem
t
    , _pathItemHead :: Maybe Operation
_pathItemHead = PathItem -> Maybe Operation
_pathItemHead PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemHead PathItem
t
    , _pathItemPatch :: Maybe Operation
_pathItemPatch = PathItem -> Maybe Operation
_pathItemPatch PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPatch PathItem
t
    , _pathItemTrace :: Maybe Operation
_pathItemTrace = PathItem -> Maybe Operation
_pathItemTrace PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemTrace PathItem
t
    , _pathItemParameters :: [Referenced Param]
_pathItemParameters = PathItem -> [Referenced Param]
_pathItemParameters PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> [Referenced Param]
_pathItemParameters PathItem
t
    , _pathItemSummary :: Maybe Text
_pathItemSummary = PathItem -> Maybe Text
_pathItemSummary PathItem
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_pathItemSummary PathItem
t
    , _pathItemDescription :: Maybe Text
_pathItemDescription = PathItem -> Maybe Text
_pathItemDescription PathItem
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_pathItemDescription PathItem
t
    , _pathItemServers :: [Server]
_pathItemServers = PathItem -> [Server]
_pathItemServers PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> [Server]
_pathItemServers PathItem
t
    }

combineOpenApi :: OpenApi -> OpenApi -> OpenApi
combineOpenApi :: OpenApi -> OpenApi -> OpenApi
combineOpenApi OpenApi
s OpenApi
t =
  OpenApi
    { _openApiInfo :: Info
_openApiInfo = OpenApi -> Info
_openApiInfo OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> Info
_openApiInfo OpenApi
t
    , _openApiServers :: [Server]
_openApiServers = OpenApi -> [Server]
_openApiServers OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> [Server]
_openApiServers OpenApi
t
    , _openApiPaths :: InsOrdHashMap FilePath PathItem
_openApiPaths = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v)
-> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
Map.unionWith PathItem -> PathItem -> PathItem
combinePathItem (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
s) (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
t)
    , _openApiComponents :: Components
_openApiComponents = OpenApi -> Components
_openApiComponents OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> Components
_openApiComponents OpenApi
t
    , _openApiSecurity :: [SecurityRequirement]
_openApiSecurity = OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
t
    , _openApiTags :: InsOrdHashSet Tag
_openApiTags = OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
t
    , _openApiExternalDocs :: Maybe ExternalDocs
_openApiExternalDocs = OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
t
    }

mergeDoc :: CompactDocNode -> Tree CompactDocNode -> OpenApi -> OpenApi
mergeDoc :: CompactDocNode -> Tree CompactDocNode -> OpenApi -> OpenApi
mergeDoc (CDocSecurityScheme Text
schemeName SecurityScheme
scheme) Tree CompactDocNode
child OpenApi
doc =
  let
#if MIN_VERSION_openapi3(3, 2, 0)
    secSchemes :: SecurityDefinitions
secSchemes = Definitions SecurityScheme -> SecurityDefinitions
SecurityDefinitions [(Text
schemeName, SecurityScheme
scheme)]
#else
    secSchemes = [(schemeName, scheme)] :: Definitions SecurityScheme
#endif
    secReqs :: [SecurityRequirement]
secReqs = [InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement [(Text
schemeName, [])]] :: [SecurityRequirement]
   in Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
        OpenApi
doc'
          forall a b. a -> (a -> b) -> b
& forall s a. HasComponents s a => Lens' s a
components forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSecuritySchemes s a => Lens' s a
securitySchemes forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ SecurityDefinitions
secSchemes
          forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSecurity s a => Lens' s a
security forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SecurityRequirement]
secReqs
mergeDoc (CDocRequestBody Definitions Schema
defs RequestBody
body) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    OpenApi
doc'
      forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRequestBody s a => Lens' s a
requestBody forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline RequestBody
body
      forall a b. a -> (a -> b) -> b
& forall s a. HasComponents s a => Lens' s a
components forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSchemas s a => Lens' s a
schemas forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
mergeDoc (CDocRequestHeader Param
param) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    OpenApi
doc' forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasParameters s a => Lens' s a
parameters forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocMethod StdMethod
m) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    OpenApi
doc' forall a b. a -> (a -> b) -> b
& forall s a. HasPaths s a => Lens' s a
paths forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (StdMethod -> PathItem -> PathItem
removeOtherMethods StdMethod
m)
mergeDoc (CDocPathElem Text
path) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ FilePath -> OpenApi -> OpenApi
prependPath (Text -> FilePath
Text.unpack Text
path)
mergeDoc (CDocPathVar Param
param) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    FilePath -> OpenApi -> OpenApi
prependPath (FilePath
"{" forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack (Param -> Text
_paramName Param
param) forall a. Semigroup a => a -> a -> a
<> FilePath
"}") OpenApi
doc'
      forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasParameters s a => Lens' s a
parameters forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocRouteDoc Maybe Summary
summ Maybe Description
descr) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    OpenApi
doc'
      -- keep any existing documentation
      forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSummary s a => Lens' s a
summary forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Summary -> Text
getSummary Maybe Summary
summ)
      forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Description -> Text
getDescription Maybe Description
descr)
mergeDoc (CDocQueryParam Param
param) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    OpenApi
doc' forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasParameters s a => Lens' s a
parameters forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocStatus Status
status Maybe Description
descr) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
preOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    let resp :: Response
resp =
          forall a. Monoid a => a
mempty @Response
            forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Description -> Text
getDescription Maybe Description
descr
        opr :: Operation
opr =
          forall a. Monoid a => a
mempty @Operation
            forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Status -> HttpStatusCode
HTTP.statusCode Status
status) forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline Response
resp
        pathItem :: PathItem
pathItem =
          forall a. Monoid a => a
mempty @PathItem
            forall a b. a -> (a -> b) -> b
& forall s a. HasGet s a => Lens' s a
get forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasPut s a => Lens' s a
put forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasPost s a => Lens' s a
post forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasDelete s a => Lens' s a
delete forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasOptions s a => Lens' s a
options forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasHead s a => Lens' s a
head_ forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasPatch s a => Lens' s a
patch forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
            forall a b. a -> (a -> b) -> b
& forall s a. HasTrace s a => Lens' s a
trace forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
     in OpenApi
doc' forall a b. a -> (a -> b) -> b
& forall s a. HasPaths s a => Lens' s a
paths forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(FilePath
"/", PathItem
pathItem)]
mergeDoc (CDocResponseBody Definitions Schema
defs MediaType
mediaType MediaTypeObject
mediaTypeObject) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    let resp :: Response
resp = forall a. Monoid a => a
mempty @Response forall a b. a -> (a -> b) -> b
& forall s a. HasContent s a => Lens' s a
content forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(MediaType
mediaType, MediaTypeObject
mediaTypeObject)]
     in OpenApi
doc'
          forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasResponses s a => Lens' s a
responses forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasResponses s a => Lens' s a
responses forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` forall a. a -> Referenced a
Inline Response
resp)
          forall a b. a -> (a -> b) -> b
& forall s a. HasComponents s a => Lens' s a
components forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSchemas s a => Lens' s a
schemas forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
mergeDoc (CDocResponseHeader Text
headerName Header
header) Tree CompactDocNode
child OpenApi
doc =
  Tree CompactDocNode -> OpenApi -> (OpenApi -> OpenApi) -> OpenApi
postOrder Tree CompactDocNode
child OpenApi
doc forall a b. (a -> b) -> a -> b
$ \OpenApi
doc' ->
    let resp :: Response
resp = forall a. Monoid a => a
mempty @Response forall a b. a -> (a -> b) -> b
& forall s a. HasHeaders s a => Lens' s a
headers forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(Text
headerName, forall a. a -> Referenced a
Inline Header
header)]
     in OpenApi
doc' forall a b. a -> (a -> b) -> b
& Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasResponses s a => Lens' s a
responses forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasResponses s a => Lens' s a
responses forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` forall a. a -> Referenced a
Inline Response
resp)

removeOtherMethods :: HTTP.StdMethod -> PathItem -> PathItem
removeOtherMethods :: StdMethod -> PathItem -> PathItem
removeOtherMethods StdMethod
method PathItem{[Server]
[Referenced Param]
Maybe Text
Maybe Operation
_pathItemParameters :: [Referenced Param]
_pathItemServers :: [Server]
_pathItemTrace :: Maybe Operation
_pathItemPatch :: Maybe Operation
_pathItemHead :: Maybe Operation
_pathItemOptions :: Maybe Operation
_pathItemDelete :: Maybe Operation
_pathItemPost :: Maybe Operation
_pathItemPut :: Maybe Operation
_pathItemGet :: Maybe Operation
_pathItemDescription :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemServers :: PathItem -> [Server]
_pathItemDescription :: PathItem -> Maybe Text
_pathItemSummary :: PathItem -> Maybe Text
_pathItemParameters :: PathItem -> [Referenced Param]
_pathItemTrace :: PathItem -> Maybe Operation
_pathItemPatch :: PathItem -> Maybe Operation
_pathItemHead :: PathItem -> Maybe Operation
_pathItemOptions :: PathItem -> Maybe Operation
_pathItemDelete :: PathItem -> Maybe Operation
_pathItemPost :: PathItem -> Maybe Operation
_pathItemPut :: PathItem -> Maybe Operation
_pathItemGet :: PathItem -> Maybe Operation
..} =
  case StdMethod
method of
    StdMethod
HTTP.GET -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemGet :: Maybe Operation
_pathItemGet :: Maybe Operation
_pathItemGet, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.PUT -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemPut :: Maybe Operation
_pathItemPut :: Maybe Operation
_pathItemPut, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.POST -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemPost :: Maybe Operation
_pathItemPost :: Maybe Operation
_pathItemPost, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.DELETE -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemDelete :: Maybe Operation
_pathItemDelete :: Maybe Operation
_pathItemDelete, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.HEAD -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemHead :: Maybe Operation
_pathItemHead :: Maybe Operation
_pathItemHead, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.TRACE -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemTrace :: Maybe Operation
_pathItemTrace :: Maybe Operation
_pathItemTrace, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.OPTIONS -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemOptions :: Maybe Operation
_pathItemOptions :: Maybe Operation
_pathItemOptions, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.PATCH -> forall a. Monoid a => a
mempty{Maybe Operation
_pathItemPatch :: Maybe Operation
_pathItemPatch :: Maybe Operation
_pathItemPatch, Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    -- OpenApi does not support CONNECT
    StdMethod
HTTP.CONNECT -> forall a. Monoid a => a
mempty{Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary :: Maybe Text
_pathItemSummary, Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription :: Maybe Text
_pathItemDescription, [Server]
_pathItemServers :: [Server]
_pathItemServers :: [Server]
_pathItemServers, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}