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 (..))
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)
data DocNode
= DocSecurityScheme Text SecurityScheme
| DocRequestBody (Definitions Schema) MimeList Param
| DocResponseBody (Definitions Schema) MimeList (Maybe (Referenced Schema))
| Param
| 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)
data CompactDocNode
= CDocSecurityScheme Text SecurityScheme
| CDocRequestBody (Definitions Schema) MimeList Param
| CDocResponseBody (Definitions Schema) MimeList (Maybe (Referenced Schema))
| Param
| 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)
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
nullNode :: Tree a
nullNode :: forall a. Tree a
nullNode = forall a. Tree a
NullNode
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
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'
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}
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}