{- | An implementation of `Handler` to generate `Swagger` documentation
 from WebGear API specifications.
-}
module WebGear.Swagger.Handler (
  SwaggerHandler (..),
  DocNode (..),
  Tree,
  singletonNode,
  nullNode,
  toSwagger,
) 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.List (nub)
import Data.Swagger
import Data.Swagger.Internal.Utils (swaggerMappend)
import Data.Text (Text)
import qualified Data.Text as Text
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
[Tree a] -> ShowS
Tree a -> FilePath
(HttpStatusCode -> Tree a -> ShowS)
-> (Tree a -> FilePath) -> ([Tree a] -> ShowS) -> Show (Tree a)
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
$cshowsPrec :: forall a. Show a => HttpStatusCode -> Tree a -> ShowS
showsPrec :: HttpStatusCode -> Tree a -> ShowS
$cshow :: forall a. Show a => Tree a -> FilePath
show :: Tree a -> FilePath
$cshowList :: forall a. Show a => [Tree a] -> ShowS
showList :: [Tree a] -> ShowS
Show)

-- | Different types of documentation elements captured by the handler
data DocNode
  = DocSecurityScheme Text SecurityScheme
  | DocRequestBody (Definitions Schema) MimeList Param
  | DocResponseBody (Definitions Schema) MimeList (Maybe (Referenced Schema))
  | 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
(HttpStatusCode -> DocNode -> ShowS)
-> (DocNode -> FilePath) -> ([DocNode] -> ShowS) -> Show DocNode
forall a.
(HttpStatusCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: HttpStatusCode -> DocNode -> ShowS
showsPrec :: HttpStatusCode -> DocNode -> ShowS
$cshow :: DocNode -> FilePath
show :: DocNode -> FilePath
$cshowList :: [DocNode] -> ShowS
showList :: [DocNode] -> ShowS
Show)

-- | Documentation elements after compaction
data CompactDocNode
  = CDocSecurityScheme Text SecurityScheme
  | CDocRequestBody (Definitions Schema) MimeList Param
  | CDocResponseBody (Definitions Schema) MimeList (Maybe (Referenced Schema))
  | 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
(HttpStatusCode -> CompactDocNode -> ShowS)
-> (CompactDocNode -> FilePath)
-> ([CompactDocNode] -> ShowS)
-> Show CompactDocNode
forall a.
(HttpStatusCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: HttpStatusCode -> CompactDocNode -> ShowS
showsPrec :: HttpStatusCode -> CompactDocNode -> ShowS
$cshow :: CompactDocNode -> FilePath
show :: CompactDocNode -> FilePath
$cshowList :: [CompactDocNode] -> ShowS
showList :: [CompactDocNode] -> ShowS
Show)

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

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

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

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

  (.) :: SwaggerHandler m b c -> SwaggerHandler m a b -> SwaggerHandler m a c
  SwaggerHandler Tree DocNode
doc2 . :: forall {k} {k} {k} (b :: k) (c :: k) (a :: k).
SwaggerHandler m b c
-> SwaggerHandler m a b -> SwaggerHandler m a c
. SwaggerHandler Tree DocNode
doc1 = Tree DocNode -> SwaggerHandler m a c
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode -> SwaggerHandler m a c)
-> Tree DocNode -> SwaggerHandler m a c
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 -> DocNode -> Tree DocNode -> Tree DocNode
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 -> Tree DocNode -> Tree DocNode -> Tree DocNode
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 (SwaggerHandler m) where
  arr :: (a -> b) -> SwaggerHandler m a b
  arr :: forall b c. (b -> c) -> SwaggerHandler m b c
arr a -> b
_ = SwaggerHandler{swaggerDoc :: Tree DocNode
swaggerDoc = Tree DocNode
forall a. Tree a
NullNode}

  first :: SwaggerHandler m b c -> SwaggerHandler m (b, d) (c, d)
  first :: forall b c d.
SwaggerHandler m b c -> SwaggerHandler m (b, d) (c, d)
first (SwaggerHandler Tree DocNode
doc) = Tree DocNode -> SwaggerHandler m (b, d) (c, d)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler Tree DocNode
doc

  second :: SwaggerHandler m b c -> SwaggerHandler m (d, b) (d, c)
  second :: forall b c d.
SwaggerHandler m b c -> SwaggerHandler m (d, b) (d, c)
second (SwaggerHandler Tree DocNode
doc) = Tree DocNode -> SwaggerHandler m (d, b) (d, c)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler Tree DocNode
doc

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

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

instance ArrowChoice (SwaggerHandler m) where
  left :: SwaggerHandler m b c -> SwaggerHandler m (Either b d) (Either c d)
  left :: forall b c d.
SwaggerHandler m b c -> SwaggerHandler m (Either b d) (Either c d)
left (SwaggerHandler Tree DocNode
doc) = Tree DocNode -> SwaggerHandler m (Either b d) (Either c d)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler Tree DocNode
doc

  right :: SwaggerHandler m b c -> SwaggerHandler m (Either d b) (Either d c)
  right :: forall b c d.
SwaggerHandler m b c -> SwaggerHandler m (Either d b) (Either d c)
right (SwaggerHandler Tree DocNode
doc) = Tree DocNode -> SwaggerHandler m (Either d b) (Either d c)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler Tree DocNode
doc

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

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

instance ArrowError RouteMismatch (SwaggerHandler m) where
  {-# INLINE raise #-}
  raise :: forall b. SwaggerHandler m RouteMismatch b
raise = SwaggerHandler{swaggerDoc :: Tree DocNode
swaggerDoc = Tree DocNode
forall a. Tree a
NullNode}

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

  {-# INLINE tryInUnless #-}
  tryInUnless :: forall e b c.
SwaggerHandler m e b
-> SwaggerHandler m (e, b) c
-> SwaggerHandler m (e, RouteMismatch) c
-> SwaggerHandler m e c
tryInUnless (SwaggerHandler Tree DocNode
doc1) (SwaggerHandler Tree DocNode
doc2) (SwaggerHandler Tree DocNode
doc3) =
    Tree DocNode -> SwaggerHandler m e c
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler (Tree DocNode -> SwaggerHandler m e c)
-> Tree DocNode -> SwaggerHandler m e c
forall a b. (a -> b) -> a -> b
$ Tree DocNode -> Tree DocNode -> Tree DocNode
forall a. Tree a -> Tree a -> Tree a
BinaryNode (Tree DocNode -> Tree DocNode -> Tree DocNode
forall a. Tree a -> Tree a -> Tree a
BinaryNode Tree DocNode
doc1 Tree DocNode
doc2) Tree DocNode
doc3

instance (Monad m) => Handler (SwaggerHandler m) m where
  {-# INLINE arrM #-}
  arrM :: (a -> m b) -> SwaggerHandler m a b
  arrM :: forall a b. (a -> m b) -> SwaggerHandler m a b
arrM a -> m b
_ = SwaggerHandler{swaggerDoc :: Tree DocNode
swaggerDoc = Tree DocNode
forall a. Tree a
NullNode}

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

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

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

-- | Generate Swagger documentation from a handler
toSwagger :: SwaggerHandler m a b -> Swagger
toSwagger :: forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
SwaggerHandler m a b -> Swagger
toSwagger = Tree CompactDocNode -> Swagger
go (Tree CompactDocNode -> Swagger)
-> (SwaggerHandler m a b -> Tree CompactDocNode)
-> SwaggerHandler m a b
-> Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree DocNode -> Tree CompactDocNode
compact (Tree DocNode -> Tree CompactDocNode)
-> (SwaggerHandler m a b -> Tree DocNode)
-> SwaggerHandler m a b
-> Tree CompactDocNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwaggerHandler m a b -> Tree DocNode
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
SwaggerHandler m a b -> Tree DocNode
swaggerDoc
  where
    go :: Tree CompactDocNode -> Swagger
go Tree CompactDocNode
t = case Tree CompactDocNode
t of
      Tree CompactDocNode
NullNode -> Swagger
forall a. Monoid a => a
mempty
      SingleNode CompactDocNode
parent Tree CompactDocNode
child -> CompactDocNode -> Tree CompactDocNode -> Swagger -> Swagger
mergeDoc CompactDocNode
parent Tree CompactDocNode
child Swagger
forall a. Monoid a => a
mempty
      BinaryNode Tree CompactDocNode
t1 Tree CompactDocNode
t2 -> Tree CompactDocNode -> Swagger
go Tree CompactDocNode
t1 Swagger -> Swagger -> Swagger
`combineSwagger` Tree CompactDocNode -> Swagger
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 -> (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
forall a. Maybe a
Nothing, Tree CompactDocNode
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 Maybe Description -> Maybe Description -> Maybe Description
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Description
descr2, Maybe Summary
summ1 Maybe Summary -> Maybe Summary -> Maybe Summary
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Summary
summ2, Tree CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
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 SecurityScheme
-> (SecurityScheme -> SecurityScheme) -> SecurityScheme
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> SecurityScheme -> Identity SecurityScheme
forall s a. HasDescription s a => Lens' s a
Lens' SecurityScheme (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SecurityScheme -> Identity SecurityScheme)
-> Maybe Text -> SecurityScheme -> SecurityScheme
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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
descr
       in (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode (Text -> SecurityScheme -> CompactDocNode
CDocSecurityScheme Text
schemeName SecurityScheme
scheme') Tree CompactDocNode
child')
    compactDoc (DocRequestBody Definitions Schema
defs MimeList
mimeList Param
bodyParam) 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
          bodyParam' :: Param
bodyParam' = Param
bodyParam Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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
descr
       in (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode (Definitions Schema -> MimeList -> Param -> CompactDocNode
CDocRequestBody Definitions Schema
defs MimeList
mimeList Param
bodyParam') Tree CompactDocNode
child')
    compactDoc (DocResponseBody Definitions Schema
defs MimeList
mimeList Maybe (Referenced Schema)
responseSchema) Tree DocNode
child =
      CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode (Definitions Schema
-> MimeList -> Maybe (Referenced Schema) -> CompactDocNode
CDocResponseBody Definitions Schema
defs MimeList
mimeList Maybe (Referenced Schema)
responseSchema) (Tree CompactDocNode -> Tree CompactDocNode)
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
-> (Maybe Description, Maybe Summary, Tree CompactDocNode)
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 Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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
descr
       in (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
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 Header -> (Header -> Header) -> Header
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Header -> Identity Header
forall s a. HasDescription s a => Lens' s a
Lens' Header (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> Header -> Identity Header)
-> Maybe Text -> Header -> Header
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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
descr
       in (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
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 =
      (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
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 =
      (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
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 =
      (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
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 Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
Lens' Param (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Param -> Identity Param)
-> Maybe Text -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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
descr
       in (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
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 (Maybe Description
forall a. Maybe a
Nothing, Maybe Summary
summ, CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
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, Summary -> Maybe Summary
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 (Description -> Maybe Description
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') -> CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode CompactDocNode
node Tree CompactDocNode
child'
      (Maybe Description
descr, Maybe Summary
summ, Tree CompactDocNode
child') -> CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode (Maybe Summary -> Maybe Description -> CompactDocNode
CDocRouteDoc Maybe Summary
summ Maybe Description
descr) (CompactDocNode -> Tree CompactDocNode -> Tree CompactDocNode
forall a. a -> Tree a -> Tree a
SingleNode CompactDocNode
node Tree CompactDocNode
child')

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

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

newtype WHOperation = WHOperation {WHOperation -> Operation
getOperation :: Operation}

instance Semigroup WHOperation where
  WHOperation Operation
op1 <> :: WHOperation -> WHOperation -> WHOperation
<> WHOperation Operation
op2 =
    let nubMimeList :: Maybe MimeList -> Maybe MimeList
nubMimeList = (MimeList -> MimeList) -> Maybe MimeList -> Maybe MimeList
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MimeList [MediaType]
xs) -> [MediaType] -> MimeList
MimeList ([MediaType] -> MimeList) -> [MediaType] -> MimeList
forall a b. (a -> b) -> a -> b
$ [MediaType] -> [MediaType]
forall a. Eq a => [a] -> [a]
nub [MediaType]
xs)
     in Operation -> WHOperation
WHOperation (Operation -> WHOperation) -> Operation -> WHOperation
forall a b. (a -> b) -> a -> b
$ (Operation
op1 Operation -> Operation -> Operation
forall a. Semigroup a => a -> a -> a
<> Operation
op2)
          Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasConsumes s a => Lens' s a
Lens' Operation (Maybe MimeList)
consumes ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Operation -> Identity Operation)
-> Maybe MimeList -> Operation -> Operation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe MimeList -> Maybe MimeList
nubMimeList ((Operation
op1 Operation
-> Getting (Maybe MimeList) Operation (Maybe MimeList)
-> Maybe MimeList
forall s a. s -> Getting a s a -> a
^. Getting (Maybe MimeList) Operation (Maybe MimeList)
forall s a. HasConsumes s a => Lens' s a
Lens' Operation (Maybe MimeList)
consumes) Maybe MimeList -> Maybe MimeList -> Maybe MimeList
forall a. Semigroup a => a -> a -> a
<> (Operation
op2 Operation
-> Getting (Maybe MimeList) Operation (Maybe MimeList)
-> Maybe MimeList
forall s a. s -> Getting a s a -> a
^. Getting (Maybe MimeList) Operation (Maybe MimeList)
forall s a. HasConsumes s a => Lens' s a
Lens' Operation (Maybe MimeList)
consumes))
          Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasProduces s a => Lens' s a
Lens' Operation (Maybe MimeList)
produces ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Operation -> Identity Operation)
-> Maybe MimeList -> Operation -> Operation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe MimeList -> Maybe MimeList
nubMimeList ((Operation
op1 Operation
-> Getting (Maybe MimeList) Operation (Maybe MimeList)
-> Maybe MimeList
forall s a. s -> Getting a s a -> a
^. Getting (Maybe MimeList) Operation (Maybe MimeList)
forall s a. HasProduces s a => Lens' s a
Lens' Operation (Maybe MimeList)
produces) Maybe MimeList -> Maybe MimeList -> Maybe MimeList
forall a. Semigroup a => a -> a -> a
<> (Operation
op2 Operation
-> Getting (Maybe MimeList) Operation (Maybe MimeList)
-> Maybe MimeList
forall s a. s -> Getting a s a -> a
^. Getting (Maybe MimeList) Operation (Maybe MimeList)
forall s a. HasProduces s a => Lens' s a
Lens' Operation (Maybe MimeList)
produces))

combineOperation :: Maybe Operation -> Maybe Operation -> Maybe Operation
combineOperation :: Maybe Operation -> Maybe Operation -> Maybe Operation
combineOperation Maybe Operation
op1 Maybe Operation
op2 = WHOperation -> Operation
getOperation (WHOperation -> Operation) -> Maybe WHOperation -> Maybe Operation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Operation -> WHOperation
WHOperation (Operation -> WHOperation) -> Maybe Operation -> Maybe WHOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Operation
op1) Maybe WHOperation -> Maybe WHOperation -> Maybe WHOperation
forall a. Semigroup a => a -> a -> a
<> (Operation -> WHOperation
WHOperation (Operation -> WHOperation) -> Maybe Operation -> Maybe WHOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Operation
op2)

combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem PathItem
s PathItem
t =
  PathItem
    { _pathItemGet :: Maybe Operation
_pathItemGet = PathItem -> Maybe Operation
_pathItemGet PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemGet PathItem
t
    , _pathItemPut :: Maybe Operation
_pathItemPut = PathItem -> Maybe Operation
_pathItemPut PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemPut PathItem
t
    , _pathItemPost :: Maybe Operation
_pathItemPost = PathItem -> Maybe Operation
_pathItemPost PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemPost PathItem
t
    , _pathItemDelete :: Maybe Operation
_pathItemDelete = PathItem -> Maybe Operation
_pathItemDelete PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemDelete PathItem
t
    , _pathItemOptions :: Maybe Operation
_pathItemOptions = PathItem -> Maybe Operation
_pathItemOptions PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemOptions PathItem
t
    , _pathItemHead :: Maybe Operation
_pathItemHead = PathItem -> Maybe Operation
_pathItemHead PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemHead PathItem
t
    , _pathItemPatch :: Maybe Operation
_pathItemPatch = PathItem -> Maybe Operation
_pathItemPatch PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
`combineOperation` PathItem -> Maybe Operation
_pathItemPatch PathItem
t
    , _pathItemParameters :: [Referenced Param]
_pathItemParameters = PathItem -> [Referenced Param]
_pathItemParameters PathItem
s [Referenced Param] -> [Referenced Param] -> [Referenced Param]
forall a. Semigroup a => a -> a -> a
<> PathItem -> [Referenced Param]
_pathItemParameters PathItem
t
    }

combineSwagger :: Swagger -> Swagger -> Swagger
combineSwagger :: Swagger -> Swagger -> Swagger
combineSwagger Swagger
s Swagger
t =
  Swagger
    { _swaggerInfo :: Info
_swaggerInfo = Swagger -> Info
_swaggerInfo Swagger
s Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> Swagger -> Info
_swaggerInfo Swagger
t
    , _swaggerHost :: Maybe Host
_swaggerHost = Swagger -> Maybe Host
_swaggerHost Swagger
s Maybe Host -> Maybe Host -> Maybe Host
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Swagger -> Maybe Host
_swaggerHost Swagger
t
    , _swaggerBasePath :: Maybe FilePath
_swaggerBasePath = Swagger -> Maybe FilePath
_swaggerBasePath Swagger
s Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe FilePath
_swaggerBasePath Swagger
t
    , _swaggerSchemes :: Maybe [Scheme]
_swaggerSchemes = Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
s Maybe [Scheme] -> Maybe [Scheme] -> Maybe [Scheme]
forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
t
    , _swaggerConsumes :: MimeList
_swaggerConsumes = Swagger -> MimeList
_swaggerConsumes Swagger
s MimeList -> MimeList -> MimeList
forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerConsumes Swagger
t
    , _swaggerProduces :: MimeList
_swaggerProduces = Swagger -> MimeList
_swaggerProduces Swagger
s MimeList -> MimeList -> MimeList
forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerProduces Swagger
t
    , _swaggerDefinitions :: Definitions Schema
_swaggerDefinitions = Swagger -> Definitions Schema
_swaggerDefinitions Swagger
s Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Schema
_swaggerDefinitions Swagger
t
    , _swaggerParameters :: Definitions Param
_swaggerParameters = Swagger -> Definitions Param
_swaggerParameters Swagger
s Definitions Param -> Definitions Param -> Definitions Param
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Param
_swaggerParameters Swagger
t
    , _swaggerResponses :: Definitions Response
_swaggerResponses = Swagger -> Definitions Response
_swaggerResponses Swagger
s Definitions Response
-> Definitions Response -> Definitions Response
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Response
_swaggerResponses Swagger
t
    , _swaggerSecurityDefinitions :: SecurityDefinitions
_swaggerSecurityDefinitions = Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
s SecurityDefinitions -> SecurityDefinitions -> SecurityDefinitions
forall a. Semigroup a => a -> a -> a
<> Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
t
    , _swaggerPaths :: InsOrdHashMap FilePath PathItem
_swaggerPaths = (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
combinePathItem (Swagger -> InsOrdHashMap FilePath PathItem
_swaggerPaths Swagger
s) (Swagger -> InsOrdHashMap FilePath PathItem
_swaggerPaths Swagger
t)
    , _swaggerSecurity :: [SecurityRequirement]
_swaggerSecurity = Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
s [SecurityRequirement]
-> [SecurityRequirement] -> [SecurityRequirement]
forall a. Semigroup a => a -> a -> a
<> Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
t
    , _swaggerTags :: InsOrdHashSet Tag
_swaggerTags = Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
s InsOrdHashSet Tag -> InsOrdHashSet Tag -> InsOrdHashSet Tag
forall a. Semigroup a => a -> a -> a
<> Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
t
    , _swaggerExternalDocs :: Maybe ExternalDocs
_swaggerExternalDocs = Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
s 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
<|> Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
t
    }

mergeDoc :: CompactDocNode -> Tree CompactDocNode -> Swagger -> Swagger
mergeDoc :: CompactDocNode -> Tree CompactDocNode -> Swagger -> Swagger
mergeDoc (CDocSecurityScheme Text
schemeName SecurityScheme
scheme) Tree CompactDocNode
child Swagger
doc =
  let
    secSchemes :: Definitions SecurityScheme
secSchemes = [(Text
schemeName, SecurityScheme
scheme)] :: Definitions SecurityScheme
    secReqs :: [SecurityRequirement]
secReqs = [InsOrdHashMap Text [Text] -> SecurityRequirement
SecurityRequirement [(Text
schemeName, [])]] :: [SecurityRequirement]
   in
    Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
      Swagger
doc'
        Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (SecurityDefinitions -> Identity SecurityDefinitions)
-> Swagger -> Identity Swagger
forall s a. HasSecurityDefinitions s a => Lens' s a
Lens' Swagger SecurityDefinitions
securityDefinitions ((SecurityDefinitions -> Identity SecurityDefinitions)
 -> Swagger -> Identity Swagger)
-> SecurityDefinitions -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Definitions SecurityScheme -> SecurityDefinitions
SecurityDefinitions Definitions SecurityScheme
secSchemes
        Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([SecurityRequirement] -> Identity [SecurityRequirement])
    -> Operation -> Identity Operation)
-> ([SecurityRequirement] -> Identity [SecurityRequirement])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SecurityRequirement] -> Identity [SecurityRequirement])
-> Operation -> Identity Operation
forall s a. HasSecurity s a => Lens' s a
Lens' Operation [SecurityRequirement]
security (([SecurityRequirement] -> Identity [SecurityRequirement])
 -> Swagger -> Identity Swagger)
-> [SecurityRequirement] -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SecurityRequirement]
secReqs
mergeDoc (CDocRequestBody Definitions Schema
defs MimeList
mimeList Param
bodyParam) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc'
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations
        ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (Operation -> Operation) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \Operation
op ->
              Operation
op
                Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& ([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
Lens' Operation [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> Operation -> Identity Operation)
-> ([Referenced Param] -> [Referenced Param])
-> Operation
-> Operation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
bodyParam Referenced Param -> [Referenced Param] -> [Referenced Param]
forall a. a -> [a] -> [a]
:)
                Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasConsumes s a => Lens' s a
Lens' Operation (Maybe MimeList)
consumes ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Operation -> Identity Operation)
-> (Maybe MimeList -> Maybe MimeList) -> Operation -> Operation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MimeList -> Maybe MimeList
forall a. a -> Maybe a
Just (MimeList -> Maybe MimeList)
-> (Maybe MimeList -> MimeList) -> Maybe MimeList -> Maybe MimeList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MimeList -> (MimeList -> MimeList) -> Maybe MimeList -> MimeList
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeList
mimeList (MimeList -> MimeList -> MimeList
forall a. Semigroup a => a -> a -> a
<> MimeList
mimeList)
           )
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
Lens' Swagger (Definitions Schema)
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
mergeDoc (CDocRequestHeader Param
param) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc' Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
Lens' Operation [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> Swagger -> Identity Swagger)
-> [Referenced Param] -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocMethod StdMethod
m) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc' Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashMap FilePath PathItem
    -> InsOrdHashMap FilePath PathItem)
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ FilePath -> Swagger -> Swagger
prependPath (Text -> FilePath
Text.unpack Text
path)
mergeDoc (CDocPathVar Param
param) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    FilePath -> Swagger -> Swagger
prependPath (FilePath
"{" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack (Param -> Text
_paramName Param
param) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"}") Swagger
doc'
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
Lens' Operation [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> Swagger -> Identity Swagger)
-> [Referenced Param] -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocRouteDoc Maybe Summary
summ Maybe Description
descr) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc'
      -- keep any existing documentation
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> Swagger
-> Identity Swagger
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))
 -> Swagger -> Identity Swagger)
-> (Maybe Text -> Maybe Text) -> Swagger -> Swagger
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)
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Operation -> Identity Operation)
-> (Maybe Text -> Identity (Maybe Text))
-> Swagger
-> Identity Swagger
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))
 -> Swagger -> Identity Swagger)
-> (Maybe Text -> Maybe Text) -> Swagger -> Swagger
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
descr)
mergeDoc (CDocQueryParam Param
param) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc' Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
Lens' Operation [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> Swagger -> Identity Swagger)
-> [Referenced Param] -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param]
mergeDoc (CDocStatus Status
status Maybe Description
descr) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
preOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    let resp :: Response
resp =
          forall a. Monoid a => a
mempty @Response
            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 -> (Description -> Text) -> Maybe Description -> Text
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
            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 (Status -> HttpStatusCode
HTTP.statusCode Status
status) ((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 Response
resp
        pathItem :: PathItem
pathItem =
          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. 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. 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. 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. 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. 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. 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. 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
     in Swagger
doc' Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> InsOrdHashMap FilePath PathItem -> Swagger -> Swagger
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(FilePath
"/", PathItem
pathItem)]
mergeDoc (CDocResponseBody Definitions Schema
defs MimeList
mimeList Maybe (Referenced Schema)
responseSchema) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    let resp :: Response
resp = forall a. Monoid a => a
mempty @Response Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Response -> Identity Response
forall s a. HasSchema s a => Lens' s a
Lens' Response (Maybe (Referenced Schema))
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Response -> Identity Response)
-> Maybe (Referenced Schema) -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Referenced Schema)
responseSchema
     in Swagger
doc'
          Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations
            ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (Operation -> Operation) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \Operation
op ->
                  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
%~ (Referenced Response -> Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (Referenced Response -> Referenced Response -> Referenced Response
forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
resp)
                    Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasProduces s a => Lens' s a
Lens' Operation (Maybe MimeList)
produces ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Operation -> Identity Operation)
-> (Maybe MimeList -> Maybe MimeList) -> Operation -> Operation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MimeList -> Maybe MimeList
forall a. a -> Maybe a
Just (MimeList -> Maybe MimeList)
-> (Maybe MimeList -> MimeList) -> Maybe MimeList -> Maybe MimeList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MimeList -> (MimeList -> MimeList) -> Maybe MimeList -> MimeList
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeList
mimeList (MimeList -> MimeList -> MimeList
forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` MimeList
mimeList)
               )
          Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
Lens' Swagger (Definitions Schema)
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
mergeDoc (CDocResponseHeader Text
headerName Header
header) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc ((Swagger -> Swagger) -> Swagger)
-> (Swagger -> Swagger) -> Swagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    let resp :: Response
resp = forall a. Monoid a => a
mempty @Response Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text Header -> Identity (InsOrdHashMap Text Header))
-> Response -> Identity Response
forall s a. HasHeaders s a => Lens' s a
Lens' Response (InsOrdHashMap Text Header)
headers ((InsOrdHashMap Text Header
  -> Identity (InsOrdHashMap Text Header))
 -> Response -> Identity Response)
-> InsOrdHashMap Text Header -> Response -> Response
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [(Text
headerName, Header
header)]
     in Swagger
doc' Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((InsOrdHashMap HttpStatusCode (Referenced Response)
     -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
    -> Operation -> Identity Operation)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashMap HttpStatusCode (Referenced Response)
    -> InsOrdHashMap HttpStatusCode (Referenced Response))
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Referenced Response -> Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> InsOrdHashMap HttpStatusCode (Referenced Response)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
Map.map (Referenced Response -> Referenced Response -> Referenced Response
forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
resp)

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