{-# LANGUAGE CPP #-}

{- | An implementation of `Handler` to generate `Swagger` documentation
 from WebGear API specifications.
-}
module WebGear.Swagger.Handler (
  SwaggerHandler (..),
  Documentation (..),
  consumeDescription,
  consumeSummary,
  addRouteDocumentation,
  addRootPath,
  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 Control.Monad ((<=<))
import Control.Monad.State.Strict (MonadState, State, evalState, state)
import Data.Coerce (coerce)
import qualified Data.HashMap.Strict.InsOrd as Map
import Data.Swagger (
  Operation,
  PathItem,
  Referenced (..),
  Response,
  Swagger,
  allOperations,
  delete,
  description,
  externalDocs,
  get,
  head_,
  options,
  parameters,
  patch,
  paths,
  post,
  put,
  summary,
 )
import WebGear.Core.Handler (
  Description (..),
  Handler (..),
  RouteMismatch,
  RoutePath (..),
  Summary (..),
 )

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

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

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

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

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

addRootPath :: Swagger -> Swagger
addRootPath :: Swagger -> Swagger
addRootPath Swagger
doc = Swagger
doc Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> InsOrdHashMap FilePath PathItem -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(FilePath
"/", PathItem
rootPathItem)]
  where
    rootPathItem :: PathItem
    rootPathItem :: PathItem
rootPathItem =
      forall a. Monoid a => a
mempty @PathItem
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_ ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr
        PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Operation
opr

    opr :: Operation
    opr :: Operation
opr = forall a. Monoid a => a
mempty @Operation Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
0 ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline (forall a. Monoid a => a
mempty @Response)

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

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

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

  {-# INLINE first #-}
  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 m b c -> SwaggerHandler m (b, d) (c, d)
forall a b. Coercible a b => a -> b
coerce

  {-# INLINE second #-}
  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 m b c -> SwaggerHandler m (d, b) (d, c)
forall a b. Coercible a b => a -> b
coerce

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

newtype MergeSwagger = MergeSwagger (Swagger -> State Documentation Swagger)

instance Semigroup MergeSwagger where
  MergeSwagger Swagger -> State Documentation Swagger
f <> :: MergeSwagger -> MergeSwagger -> MergeSwagger
<> MergeSwagger Swagger -> State Documentation Swagger
g =
    (Swagger -> State Documentation Swagger) -> MergeSwagger
MergeSwagger ((Swagger -> State Documentation Swagger) -> MergeSwagger)
-> (Swagger -> State Documentation Swagger) -> MergeSwagger
forall a b. (a -> b) -> a -> b
$ \Swagger
doc -> do
      Swagger
a <- Swagger -> State Documentation Swagger
f Swagger
doc
      Swagger
b <- Swagger -> State Documentation Swagger
g Swagger
doc
      Swagger -> State Documentation Swagger
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Swagger -> State Documentation Swagger)
-> Swagger -> State Documentation Swagger
forall a b. (a -> b) -> a -> b
$
        (Swagger
a Swagger -> Swagger -> Swagger
forall a. Semigroup a => a -> a -> a
<> Swagger
b)
          Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> InsOrdHashMap FilePath PathItem -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem -> PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v)
-> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
Map.unionWith PathItem -> PathItem -> PathItem
mergePathItem (Swagger
a Swagger
-> Getting
     (InsOrdHashMap FilePath PathItem)
     Swagger
     (InsOrdHashMap FilePath PathItem)
-> InsOrdHashMap FilePath PathItem
forall s a. s -> Getting a s a -> a
^. Getting
  (InsOrdHashMap FilePath PathItem)
  Swagger
  (InsOrdHashMap FilePath PathItem)
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths) (Swagger
b Swagger
-> Getting
     (InsOrdHashMap FilePath PathItem)
     Swagger
     (InsOrdHashMap FilePath PathItem)
-> InsOrdHashMap FilePath PathItem
forall s a. s -> Getting a s a -> a
^. Getting
  (InsOrdHashMap FilePath PathItem)
  Swagger
  (InsOrdHashMap FilePath PathItem)
forall s a. HasPaths s a => Lens' s a
Lens' Swagger (InsOrdHashMap FilePath PathItem)
paths)
          Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Maybe ExternalDocs -> Identity (Maybe ExternalDocs))
-> Swagger -> Identity Swagger
forall s a. HasExternalDocs s a => Lens' s a
Lens' Swagger (Maybe ExternalDocs)
externalDocs ((Maybe ExternalDocs -> Identity (Maybe ExternalDocs))
 -> Swagger -> Identity Swagger)
-> Maybe ExternalDocs -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Swagger
a Swagger
-> Getting (Maybe ExternalDocs) Swagger (Maybe ExternalDocs)
-> Maybe ExternalDocs
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ExternalDocs) Swagger (Maybe ExternalDocs)
forall s a. HasExternalDocs s a => Lens' s a
Lens' Swagger (Maybe ExternalDocs)
externalDocs Maybe ExternalDocs -> Maybe ExternalDocs -> Maybe ExternalDocs
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Swagger
b Swagger
-> Getting (Maybe ExternalDocs) Swagger (Maybe ExternalDocs)
-> Maybe ExternalDocs
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ExternalDocs) Swagger (Maybe ExternalDocs)
forall s a. HasExternalDocs s a => Lens' s a
Lens' Swagger (Maybe ExternalDocs)
externalDocs)
    where
      mergePathItem :: PathItem -> PathItem -> PathItem
      mergePathItem :: PathItem -> PathItem -> PathItem
mergePathItem PathItem
x PathItem
y =
        forall a. Monoid a => a
mempty @PathItem
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasDelete s a => Lens' s a
Lens' PathItem (Maybe Operation)
delete
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasGet s a => Lens' s a
Lens' PathItem (Maybe Operation)
get
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_ ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_ Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasHead s a => Lens' s a
Lens' PathItem (Maybe Operation)
head_
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasOptions s a => Lens' s a
Lens' PathItem (Maybe Operation)
options
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPatch s a => Lens' s a
Lens' PathItem (Maybe Operation)
patch
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPost s a => Lens' s a
Lens' PathItem (Maybe Operation)
post
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Maybe Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathItem
x PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting (Maybe Operation) PathItem (Maybe Operation)
-> Maybe Operation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Operation) PathItem (Maybe Operation)
forall s a. HasPut s a => Lens' s a
Lens' PathItem (Maybe Operation)
put
          PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& ([Referenced Param] -> Identity [Referenced Param])
-> PathItem -> Identity PathItem
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> PathItem -> Identity PathItem)
-> [Referenced Param] -> PathItem -> PathItem
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathItem
x PathItem
-> Getting [Referenced Param] PathItem [Referenced Param]
-> [Referenced Param]
forall s a. s -> Getting a s a -> a
^. Getting [Referenced Param] PathItem [Referenced Param]
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters [Referenced Param] -> [Referenced Param] -> [Referenced Param]
forall a. Semigroup a => a -> a -> a
<> PathItem
y PathItem
-> Getting [Referenced Param] PathItem [Referenced Param]
-> [Referenced Param]
forall s a. s -> Getting a s a -> a
^. Getting [Referenced Param] PathItem [Referenced Param]
forall s a. HasParameters s a => Lens' s a
Lens' PathItem [Referenced Param]
parameters)

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

instance ArrowChoice (SwaggerHandler m) where
  {-# INLINE left #-}
  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 Swagger -> State Documentation Swagger
doc) = (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (Either b d) (Either c d)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler Swagger -> State Documentation Swagger
doc

  {-# INLINE right #-}
  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 Swagger -> State Documentation Swagger
doc) = (Swagger -> State Documentation Swagger)
-> SwaggerHandler m (Either d b) (Either d c)
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler Swagger -> State Documentation Swagger
doc

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

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

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

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

  {-# 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 Swagger -> State Documentation Swagger
f) (SwaggerHandler Swagger -> State Documentation Swagger
g) (SwaggerHandler Swagger -> State Documentation Swagger
h) =
    MergeSwagger -> SwaggerHandler m e c
forall a b. Coercible a b => a -> b
coerce (MergeSwagger -> SwaggerHandler m e c)
-> MergeSwagger -> SwaggerHandler m e c
forall a b. (a -> b) -> a -> b
$ (Swagger -> State Documentation Swagger) -> MergeSwagger
MergeSwagger Swagger -> State Documentation Swagger
f MergeSwagger -> MergeSwagger -> MergeSwagger
forall a. Semigroup a => a -> a -> a
<> (Swagger -> State Documentation Swagger) -> MergeSwagger
MergeSwagger Swagger -> State Documentation Swagger
g MergeSwagger -> MergeSwagger -> MergeSwagger
forall a. Semigroup a => a -> a -> a
<> (Swagger -> State Documentation Swagger) -> MergeSwagger
MergeSwagger Swagger -> State Documentation Swagger
h

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
_ = (Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
forall {k} {k} {k} (m :: k) (a :: k) (b :: k).
(Swagger -> State Documentation Swagger) -> SwaggerHandler m a b
SwaggerHandler Swagger -> State Documentation Swagger
forall a. a -> StateT Documentation Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

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

-- | 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 (SwaggerHandler Swagger -> State Documentation Swagger
f) = State Documentation Swagger -> Documentation -> Swagger
forall s a. State s a -> s -> a
evalState (Swagger -> State Documentation Swagger
f Swagger
forall a. Monoid a => a
mempty) (Maybe Description -> Maybe Summary -> Documentation
Documentation Maybe Description
forall a. Maybe a
Nothing Maybe Summary
forall a. Maybe a
Nothing)