{-# LANGUAGE RankNTypes #-}
-- |
-- Module:      Data.Swagger.Operation
-- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
-- Stability:   experimental
--
-- Helper traversals and functions for Swagger operations manipulations.
-- These might be useful when you already have Swagger specification
-- generated by something else.
module Data.Swagger.Operation (
  -- * Operation traversals
  allOperations,
  operationsOf,

  -- * Manipulation
  -- ** Tags
  applyTags,
  applyTagsFor,

  -- ** Responses
  setResponse,
  setResponseWith,
  setResponseFor,
  setResponseForWith,

  -- ** Paths
  prependPath,

  -- * Miscellaneous
  declareResponse,
) where

import Prelude ()
import Prelude.Compat

import Control.Lens
import Data.Data.Lens
import Data.List.Compat
import Data.Maybe (mapMaybe)
import Data.Proxy
import qualified Data.Set as Set

import Data.Swagger.Declare
import Data.Swagger.Internal
import Data.Swagger.Lens
import Data.Swagger.Schema

import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import qualified Data.HashSet.InsOrd as InsOrdHS

-- $setup
-- >>> import Data.Aeson
-- >>> import Data.Proxy
-- >>> import Data.Time

-- | Prepend path piece to all operations of the spec.
-- Leading and trailing slashes are trimmed/added automatically.
--
-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
-- >>> encode $ prependPath "user/{user_id}" api ^. paths
-- "{\"/user/{user_id}/info\":{}}"
prependPath :: FilePath -> Swagger -> Swagger
prependPath :: FilePath -> Swagger -> Swagger
prependPath FilePath
path = (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashMap FilePath PathItem
    -> InsOrdHashMap FilePath PathItem)
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FilePath -> FilePath)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys (FilePath
path FilePath -> FilePath -> FilePath
</>)
  where
    FilePath
x </> :: FilePath -> FilePath -> FilePath
</> FilePath
y = case FilePath -> FilePath
trim FilePath
y of
      FilePath
"" -> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
trim FilePath
x
      FilePath
y' -> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
trim FilePath
x FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
y'

    trim :: FilePath -> FilePath
trim = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')

-- | All operations of a Swagger spec.
allOperations :: Traversal' Swagger Operation
allOperations :: (Operation -> f Operation) -> Swagger -> f Swagger
allOperations = (InsOrdHashMap FilePath PathItem
 -> f (InsOrdHashMap FilePath PathItem))
-> Swagger -> f Swagger
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> f (InsOrdHashMap FilePath PathItem))
 -> Swagger -> f Swagger)
-> ((Operation -> f Operation)
    -> InsOrdHashMap FilePath PathItem
    -> f (InsOrdHashMap FilePath PathItem))
-> (Operation -> f Operation)
-> Swagger
-> f Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathItem -> f PathItem)
-> InsOrdHashMap FilePath PathItem
-> f (InsOrdHashMap FilePath PathItem)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse((PathItem -> f PathItem)
 -> InsOrdHashMap FilePath PathItem
 -> f (InsOrdHashMap FilePath PathItem))
-> ((Operation -> f Operation) -> PathItem -> f PathItem)
-> (Operation -> f Operation)
-> InsOrdHashMap FilePath PathItem
-> f (InsOrdHashMap FilePath PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Operation -> f Operation) -> PathItem -> f PathItem
forall s a. (Data s, Typeable a) => Traversal' s a
template

-- | @'operationsOf' sub@ will traverse only those operations
-- that are present in @sub@. Note that @'Operation'@ is determined
-- by both path and method.
--
-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
-- >>> encode api
-- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
-- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"},\"404\":{\"description\":\"Not found\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
operationsOf :: Swagger -> Traversal' Swagger Operation
operationsOf :: Swagger -> Traversal' Swagger Operation
operationsOf Swagger
sub = (InsOrdHashMap FilePath PathItem
 -> f (InsOrdHashMap FilePath PathItem))
-> Swagger -> f Swagger
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> f (InsOrdHashMap FilePath PathItem))
 -> Swagger -> f Swagger)
-> ((Operation -> f Operation)
    -> InsOrdHashMap FilePath PathItem
    -> f (InsOrdHashMap FilePath PathItem))
-> (Operation -> f Operation)
-> Swagger
-> f Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Indexed FilePath PathItem (f PathItem)
-> InsOrdHashMap FilePath PathItem
-> f (InsOrdHashMap FilePath PathItem)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed(Indexed FilePath PathItem (f PathItem)
 -> InsOrdHashMap FilePath PathItem
 -> f (InsOrdHashMap FilePath PathItem))
-> ((Operation -> f Operation)
    -> Indexed FilePath PathItem (f PathItem))
-> (Operation -> f Operation)
-> InsOrdHashMap FilePath PathItem
-> f (InsOrdHashMap FilePath PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((FilePath, PathItem) -> f (FilePath, PathItem))
-> Indexed FilePath PathItem (f PathItem)
forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex(((FilePath, PathItem) -> f (FilePath, PathItem))
 -> Indexed FilePath PathItem (f PathItem))
-> ((Operation -> f Operation)
    -> (FilePath, PathItem) -> f (FilePath, PathItem))
-> (Operation -> f Operation)
-> Indexed FilePath PathItem (f PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Operation -> f Operation)
-> (FilePath, PathItem) -> f (FilePath, PathItem)
Traversal' (FilePath, PathItem) Operation
subops
  where
    -- | Traverse operations that correspond to paths and methods of the sub API.
    subops :: Traversal' (FilePath, PathItem) Operation
    subops :: (Operation -> f Operation)
-> (FilePath, PathItem) -> f (FilePath, PathItem)
subops Operation -> f Operation
f (FilePath
path, PathItem
item) = case FilePath -> InsOrdHashMap FilePath PathItem -> Maybe PathItem
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup FilePath
path (Swagger
sub 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
paths) of
      Just PathItem
subitem -> (,) FilePath
path (PathItem -> (FilePath, PathItem))
-> f PathItem -> f (FilePath, PathItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathItem -> (Operation -> f Operation) -> PathItem -> f PathItem
PathItem -> Traversal' PathItem Operation
methodsOf PathItem
subitem Operation -> f Operation
f PathItem
item
      Maybe PathItem
Nothing      -> (FilePath, PathItem) -> f (FilePath, PathItem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
path, PathItem
item)

    -- | Traverse operations that exist in a given @'PathItem'@
    -- This is used to traverse only the operations that exist in sub API.
    methodsOf :: PathItem -> Traversal' PathItem Operation
    methodsOf :: PathItem -> Traversal' PathItem Operation
methodsOf PathItem
pathItem = Traversing
  (->) f PathItem PathItem (Maybe Operation) (Maybe Operation)
-> LensLike f PathItem PathItem [Maybe Operation] [Maybe Operation]
forall (f :: * -> *) s t a.
Functor f =>
Traversing (->) f s t a a -> LensLike f s t [a] [a]
partsOf Traversing
  (->) f PathItem PathItem (Maybe Operation) (Maybe Operation)
forall s a. (Data s, Typeable a) => Traversal' s a
template LensLike f PathItem PathItem [Maybe Operation] [Maybe Operation]
-> ((Operation -> f Operation)
    -> [Maybe Operation] -> f [Maybe Operation])
-> (Operation -> f Operation)
-> PathItem
-> f PathItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed Int (Maybe Operation) (f (Maybe Operation))
-> [Maybe Operation] -> f [Maybe Operation]
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed (Indexed Int (Maybe Operation) (f (Maybe Operation))
 -> [Maybe Operation] -> f [Maybe Operation])
-> ((Operation -> f Operation)
    -> Indexed Int (Maybe Operation) (f (Maybe Operation)))
-> (Operation -> f Operation)
-> [Maybe Operation]
-> f [Maybe Operation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool)
-> Optical'
     (->) (Indexed Int) f (Maybe Operation) (Maybe Operation)
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Applicative f) =>
(i -> Bool) -> Optical' p (Indexed i) f a a
indices (Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
ns) Optical' (->) (Indexed Int) f (Maybe Operation) (Maybe Operation)
-> ((Operation -> f Operation)
    -> Maybe Operation -> f (Maybe Operation))
-> (Operation -> f Operation)
-> Indexed Int (Maybe Operation) (f (Maybe Operation))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Operation -> f Operation)
-> Maybe Operation -> f (Maybe Operation)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      where
        ops :: [Maybe Operation]
ops = PathItem
pathItem PathItem
-> Getting (Endo [Maybe Operation]) PathItem (Maybe Operation)
-> [Maybe Operation]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Maybe Operation]) PathItem (Maybe Operation)
forall s a. (Data s, Typeable a) => Traversal' s a
template :: [Maybe Operation]
        ns :: [Int]
ns = ((Int, Maybe Operation) -> Maybe Int)
-> [(Int, Maybe Operation)] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((Int, Operation) -> Int) -> Maybe (Int, Operation) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Operation) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, Operation) -> Maybe Int)
-> ((Int, Maybe Operation) -> Maybe (Int, Operation))
-> (Int, Maybe Operation)
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Operation) -> Maybe (Int, Operation)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA) ([(Int, Maybe Operation)] -> [Int])
-> [(Int, Maybe Operation)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Maybe Operation] -> [(Int, Maybe Operation)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Maybe Operation]
ops

-- | Apply tags to all operations and update the global list of tags.
--
-- @
-- 'applyTags' = 'applyTagsFor' 'allOperations'
-- @
applyTags :: [Tag] -> Swagger -> Swagger
applyTags :: [Tag] -> Swagger -> Swagger
applyTags = Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor Traversal' Swagger Operation
allOperations

-- | Apply tags to a part of Swagger spec and update the global
-- list of tags.
applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor Traversal' Swagger Operation
ops [Tag]
ts Swagger
swag = Swagger
swag
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
ops ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
    -> Operation -> Identity Operation)
-> (InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
-> Operation -> Identity Operation
forall s a. HasTags s a => Lens' s a
tags ((InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashSet TagName -> InsOrdHashSet TagName)
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (InsOrdHashSet TagName
-> InsOrdHashSet TagName -> InsOrdHashSet TagName
forall a. Semigroup a => a -> a -> a
<> [TagName] -> InsOrdHashSet TagName
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
InsOrdHS.fromList ((Tag -> TagName) -> [Tag] -> [TagName]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> TagName
_tagName [Tag]
ts))
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashSet Tag -> Identity (InsOrdHashSet Tag))
-> Swagger -> Identity Swagger
forall s a. HasTags s a => Lens' s a
tags ((InsOrdHashSet Tag -> Identity (InsOrdHashSet Tag))
 -> Swagger -> Identity Swagger)
-> (InsOrdHashSet Tag -> InsOrdHashSet Tag) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (InsOrdHashSet Tag -> InsOrdHashSet Tag -> InsOrdHashSet Tag
forall a. Semigroup a => a -> a -> a
<> [Tag] -> InsOrdHashSet Tag
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
InsOrdHS.fromList [Tag]
ts)

-- | Construct a response with @'Schema'@ while declaring all
-- necessary schema definitions.
--
-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
declareResponse :: Proxy a -> Declare (Definitions Schema) Response
declareResponse Proxy a
proxy = do
  Referenced Schema
s <- Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef Proxy a
proxy
  Response -> Declare (Definitions Schema) Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response
forall a. Monoid a => a
mempty Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Response -> Identity Response
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Response -> Identity Response)
-> Referenced Schema -> Response -> Response
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
s)

-- | Set response for all operations.
-- This will also update global schema definitions.
--
-- If the response already exists it will be overwritten.
--
-- @
-- 'setResponse' = 'setResponseFor' 'allOperations'
-- @
--
-- Example:
--
-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
-- >>> let res = declareResponse (Proxy :: Proxy Day)
-- >>> encode $ api & setResponse 200 res
-- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}}}}},\"definitions\":{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}}}"
--
-- See also @'setResponseWith'@.
setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponse :: Int -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponse = Traversal' Swagger Operation
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseFor Traversal' Swagger Operation
allOperations

-- | Set or update response for all operations.
-- This will also update global schema definitions.
--
-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
-- then just the new response is used.
--
-- @
-- 'setResponseWith' = 'setResponseForWith' 'allOperations'
-- @
--
-- See also @'setResponse'@.
setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseWith :: (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseWith = Traversal' Swagger Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseForWith Traversal' Swagger Operation
allOperations

-- | Set response for specified operations.
-- This will also update global schema definitions.
--
-- If the response already exists it will be overwritten.
--
-- See also @'setResponseForWith'@.
setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseFor :: Traversal' Swagger Operation
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseFor Traversal' Swagger Operation
ops Int
code Declare (Definitions Schema) Response
dres Swagger
swag = Swagger
swag
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
ops ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe (Referenced Response)
     -> Identity (Maybe (Referenced Response)))
    -> Operation -> Identity Operation)
-> (Maybe (Referenced Response)
    -> Identity (Maybe (Referenced Response)))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Swagger -> Identity Swagger)
-> Referenced Response -> Swagger -> Swagger
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
res
  where
    (Definitions Schema
defs, Response
res) = Declare (Definitions Schema) Response
-> Definitions Schema -> (Definitions Schema, Response)
forall d a. Declare d a -> d -> (d, a)
runDeclare Declare (Definitions Schema) Response
dres Definitions Schema
forall a. Monoid a => a
mempty

-- | Set or update response for specified operations.
-- This will also update global schema definitions.
--
-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
-- then just the new response is used.
--
-- See also @'setResponseFor'@.
setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
setResponseForWith :: Traversal' Swagger Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseForWith Traversal' Swagger Operation
ops Response -> Response -> Response
f Int
code Declare (Definitions Schema) Response
dres Swagger
swag = Swagger
swag
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
ops ((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe (Referenced Response)
     -> Identity (Maybe (Referenced Response)))
    -> Operation -> Identity Operation)
-> (Maybe (Referenced Response)
    -> Identity (Maybe (Referenced Response)))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Swagger -> Identity Swagger)
-> (Maybe (Referenced Response) -> Maybe (Referenced Response))
-> Swagger
-> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Referenced Response -> Maybe (Referenced Response)
forall a. a -> Maybe a
Just (Referenced Response -> Maybe (Referenced Response))
-> (Maybe (Referenced Response) -> Referenced Response)
-> Maybe (Referenced Response)
-> Maybe (Referenced Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Referenced Response
forall a. a -> Referenced a
Inline (Response -> Referenced Response)
-> (Maybe (Referenced Response) -> Response)
-> Maybe (Referenced Response)
-> Referenced Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Referenced Response) -> Response
combine
  where
    (Definitions Schema
defs, Response
new) = Declare (Definitions Schema) Response
-> Definitions Schema -> (Definitions Schema, Response)
forall d a. Declare d a -> d -> (d, a)
runDeclare Declare (Definitions Schema) Response
dres Definitions Schema
forall a. Monoid a => a
mempty

    combine :: Maybe (Referenced Response) -> Response
combine (Just (Ref (Reference TagName
n))) = case Swagger
swag Swagger
-> Getting (Maybe Response) Swagger (Maybe Response)
-> Maybe Response
forall s a. s -> Getting a s a -> a
^. (Definitions Response
 -> Const (Maybe Response) (Definitions Response))
-> Swagger -> Const (Maybe Response) Swagger
forall s a. HasResponses s a => Lens' s a
responses((Definitions Response
  -> Const (Maybe Response) (Definitions Response))
 -> Swagger -> Const (Maybe Response) Swagger)
-> ((Maybe Response -> Const (Maybe Response) (Maybe Response))
    -> Definitions Response
    -> Const (Maybe Response) (Definitions Response))
-> Getting (Maybe Response) Swagger (Maybe Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (Definitions Response)
-> Lens'
     (Definitions Response) (Maybe (IxValue (Definitions Response)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TagName
Index (Definitions Response)
n of
      Just Response
old -> Response -> Response -> Response
f Response
old Response
new
      Maybe Response
Nothing  -> Response
new -- response name can't be dereferenced, replacing with new response
    combine (Just (Inline Response
old)) = Response -> Response -> Response
f Response
old Response
new
    combine Maybe (Referenced Response)
Nothing = Response
new