{- | 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
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) 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
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) 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
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 `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 = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler 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 (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 = 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) = 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) = 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 = 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 = 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 = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ 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) = 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) = 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 = 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 = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ 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 = 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 = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler 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 (SwaggerHandler m) where
  {-# INLINE raise #-}
  raise :: forall b. SwaggerHandler m RouteMismatch b
raise = SwaggerHandler{swaggerDoc :: Tree DocNode
swaggerDoc = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler forall a b. (a -> b) -> a -> b
$ 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) =
    forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler 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 (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 = 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) = 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 = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler 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

  {-# INLINE setSummary #-}
  setSummary :: Summary -> SwaggerHandler m a a
  setSummary :: forall {k} (a :: k). Summary -> SwaggerHandler m a a
setSummary = forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
Tree DocNode -> SwaggerHandler m a b
SwaggerHandler 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 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 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).
SwaggerHandler m a b -> Tree DocNode
swaggerDoc
  where
    go :: Tree CompactDocNode -> Swagger
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 -> Swagger -> Swagger
mergeDoc CompactDocNode
parent Tree CompactDocNode
child 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 -> (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 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 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 -> 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 =
      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) 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 -> 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 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 forall a b. (a -> b) -> a -> b
$ Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
t1 Swagger
doc forall a. a -> a
id Swagger -> Swagger -> Swagger
`combineSwagger` Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
t2 Swagger
doc 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' forall a. a -> a
id Swagger -> Swagger -> Swagger
`combineSwagger` Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
t2 Swagger
doc' 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MimeList [MediaType]
xs) -> [MediaType] -> MimeList
MimeList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub [MediaType]
xs)
     in Operation -> WHOperation
WHOperation forall a b. (a -> b) -> a -> b
$ (Operation
op1 forall a. Semigroup a => a -> a -> a
<> Operation
op2)
          forall a b. a -> (a -> b) -> b
& forall s a. HasConsumes s a => Lens' s a
consumes forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe MimeList -> Maybe MimeList
nubMimeList ((Operation
op1 forall s a. s -> Getting a s a -> a
^. forall s a. HasConsumes s a => Lens' s a
consumes) forall a. Semigroup a => a -> a -> a
<> (Operation
op2 forall s a. s -> Getting a s a -> a
^. forall s a. HasConsumes s a => Lens' s a
consumes))
          forall a b. a -> (a -> b) -> b
& forall s a. HasProduces s a => Lens' s a
produces forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe MimeList -> Maybe MimeList
nubMimeList ((Operation
op1 forall s a. s -> Getting a s a -> a
^. forall s a. HasProduces s a => Lens' s a
produces) forall a. Semigroup a => a -> a -> a
<> (Operation
op2 forall s a. s -> Getting a s a -> a
^. forall s a. HasProduces s a => Lens' s a
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Operation -> WHOperation
WHOperation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Operation
op1) forall a. Semigroup a => a -> a -> a
<> (Operation -> WHOperation
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 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 forall a. Semigroup a => a -> a -> a
<> Swagger -> Info
_swaggerInfo Swagger
t
    , _swaggerHost :: Maybe Host
_swaggerHost = Swagger -> Maybe Host
_swaggerHost Swagger
s 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 forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe FilePath
_swaggerBasePath Swagger
t
    , _swaggerSchemes :: Maybe [Scheme]
_swaggerSchemes = Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
t
    , _swaggerConsumes :: MimeList
_swaggerConsumes = Swagger -> MimeList
_swaggerConsumes Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerConsumes Swagger
t
    , _swaggerProduces :: MimeList
_swaggerProduces = Swagger -> MimeList
_swaggerProduces Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerProduces Swagger
t
    , _swaggerDefinitions :: Definitions Schema
_swaggerDefinitions = Swagger -> Definitions Schema
_swaggerDefinitions Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Schema
_swaggerDefinitions Swagger
t
    , _swaggerParameters :: Definitions Param
_swaggerParameters = Swagger -> Definitions Param
_swaggerParameters Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Param
_swaggerParameters Swagger
t
    , _swaggerResponses :: Definitions Response
_swaggerResponses = Swagger -> Definitions Response
_swaggerResponses Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Response
_swaggerResponses Swagger
t
    , _swaggerSecurityDefinitions :: SecurityDefinitions
_swaggerSecurityDefinitions = Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
t
    , _swaggerPaths :: InsOrdHashMap FilePath PathItem
_swaggerPaths = 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 forall a. Semigroup a => a -> a -> a
<> Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
t
    , _swaggerTags :: InsOrdHashSet Tag
_swaggerTags = Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
t
    , _swaggerExternalDocs :: Maybe ExternalDocs
_swaggerExternalDocs = Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
s 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 forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
      Swagger
doc'
        forall a b. a -> (a -> b) -> b
& forall s a. HasSecurityDefinitions s a => Lens' s a
securityDefinitions forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Definitions SecurityScheme -> SecurityDefinitions
SecurityDefinitions Definitions SecurityScheme
secSchemes
        forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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 MimeList
mimeList Param
bodyParam) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc'
      forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
allOperations
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \Operation
op ->
              Operation
op
                forall a b. a -> (a -> b) -> b
& forall s a. HasParameters s a => Lens' s a
parameters forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. a -> Referenced a
Inline Param
bodyParam forall a. a -> [a] -> [a]
:)
                forall a b. a -> (a -> b) -> b
& forall s a. HasConsumes s a => Lens' s a
consumes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeList
mimeList (forall a. Semigroup a => a -> a -> a
<> MimeList
mimeList)
           )
      forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc' forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc 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 forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    FilePath -> Swagger -> Swagger
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
"}") Swagger
doc'
      forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc'
      -- keep any existing documentation
      forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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' Swagger 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    Swagger
doc' forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
preOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
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
     in Swagger
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 MimeList
mimeList Maybe (Referenced Schema)
responseSchema) Tree CompactDocNode
child Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
doc' ->
    let resp :: Response
resp = forall a. Monoid a => a
mempty @Response forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Referenced Schema)
responseSchema
     in Swagger
doc'
          forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
allOperations
            forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \Operation
op ->
                  Operation
op
                    forall a b. a -> (a -> b) -> b
& 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. HasProduces s a => Lens' s a
produces forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe MimeList
mimeList (forall m. SwaggerMonoid m => m -> m -> m
`swaggerMappend` MimeList
mimeList)
               )
          forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions 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 Swagger
doc =
  Tree CompactDocNode -> Swagger -> (Swagger -> Swagger) -> Swagger
postOrder Tree CompactDocNode
child Swagger
doc forall a b. (a -> b) -> a -> b
$ \Swagger
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, Header
header)]
     in Swagger
doc' forall a b. a -> (a -> b) -> b
& Traversal' Swagger 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{[Referenced Param]
Maybe Operation
_pathItemParameters :: [Referenced Param]
_pathItemPatch :: Maybe Operation
_pathItemHead :: Maybe Operation
_pathItemOptions :: Maybe Operation
_pathItemDelete :: Maybe Operation
_pathItemPost :: Maybe Operation
_pathItemPut :: Maybe Operation
_pathItemGet :: Maybe Operation
_pathItemParameters :: PathItem -> [Referenced Param]
_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, [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, [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, [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, [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, [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, [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, [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    -- Swagger does not support CONNECT and TRACE
    StdMethod
HTTP.CONNECT -> forall a. Monoid a => a
mempty{[Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}
    StdMethod
HTTP.TRACE -> forall a. Monoid a => a
mempty{[Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters :: [Referenced Param]
_pathItemParameters}