{-# LANGUAGE RankNTypes #-}
-- |
-- Module:      Data.OpenApi.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.OpenApi.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.Text (Text)
import Network.HTTP.Media (MediaType)

import Data.OpenApi.Declare
import Data.OpenApi.Internal
import Data.OpenApi.Lens
import Data.OpenApi.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
-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
-- >>> import qualified Data.HashMap.Strict.InsOrd as IOHM
-- >>> import Data.OpenApi.Internal.Utils

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

    trim :: [Char] -> [Char]
trim = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
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' OpenApi Operation
allOperations :: Traversal' OpenApi Operation
allOperations = (InsOrdHashMap [Char] PathItem
 -> f (InsOrdHashMap [Char] PathItem))
-> OpenApi -> f OpenApi
forall s a. HasPaths s a => Lens' s a
Lens' OpenApi (InsOrdHashMap [Char] PathItem)
paths((InsOrdHashMap [Char] PathItem
  -> f (InsOrdHashMap [Char] PathItem))
 -> OpenApi -> f OpenApi)
-> ((Operation -> f Operation)
    -> InsOrdHashMap [Char] PathItem
    -> f (InsOrdHashMap [Char] PathItem))
-> (Operation -> f Operation)
-> OpenApi
-> f OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathItem -> f PathItem)
-> InsOrdHashMap [Char] PathItem
-> f (InsOrdHashMap [Char] PathItem)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> InsOrdHashMap [Char] a -> f (InsOrdHashMap [Char] b)
traverse((PathItem -> f PathItem)
 -> InsOrdHashMap [Char] PathItem
 -> f (InsOrdHashMap [Char] PathItem))
-> ((Operation -> f Operation) -> PathItem -> f PathItem)
-> (Operation -> f Operation)
-> InsOrdHashMap [Char] PathItem
-> f (InsOrdHashMap [Char] 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
Traversal' PathItem Operation
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 :: OpenApi) & paths .~ IOHM.fromList [("/user", mempty & get ?~ ok & post ?~ ok)]
-- >>> let sub = (mempty :: OpenApi) & paths .~ IOHM.fromList [("/user", mempty & get ?~ mempty)]
-- >>> BSL.putStrLn $ encodePretty api
-- {
--     "components": {},
--     "info": {
--         "title": "",
--         "version": ""
--     },
--     "openapi": "3.0.0",
--     "paths": {
--         "/user": {
--             "get": {
--                 "responses": {
--                     "200": {
--                         "description": "OK"
--                     }
--                 }
--             },
--             "post": {
--                 "responses": {
--                     "200": {
--                         "description": "OK"
--                     }
--                 }
--             }
--         }
--     }
-- }
-- >>> BSL.putStrLn $ encodePretty $ api & operationsOf sub . at 404 ?~ "Not found"
-- {
--     "components": {},
--     "info": {
--         "title": "",
--         "version": ""
--     },
--     "openapi": "3.0.0",
--     "paths": {
--         "/user": {
--             "get": {
--                 "responses": {
--                     "200": {
--                         "description": "OK"
--                     },
--                     "404": {
--                         "description": "Not found"
--                     }
--                 }
--             },
--             "post": {
--                 "responses": {
--                     "200": {
--                         "description": "OK"
--                     }
--                 }
--             }
--         }
--     }
-- }
operationsOf :: OpenApi -> Traversal' OpenApi Operation
operationsOf :: OpenApi -> Traversal' OpenApi Operation
operationsOf OpenApi
sub = (InsOrdHashMap [Char] PathItem
 -> f (InsOrdHashMap [Char] PathItem))
-> OpenApi -> f OpenApi
forall s a. HasPaths s a => Lens' s a
Lens' OpenApi (InsOrdHashMap [Char] PathItem)
paths((InsOrdHashMap [Char] PathItem
  -> f (InsOrdHashMap [Char] PathItem))
 -> OpenApi -> f OpenApi)
-> ((Operation -> f Operation)
    -> InsOrdHashMap [Char] PathItem
    -> f (InsOrdHashMap [Char] PathItem))
-> (Operation -> f Operation)
-> OpenApi
-> f OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Indexed [Char] PathItem (f PathItem)
-> InsOrdHashMap [Char] PathItem
-> f (InsOrdHashMap [Char] PathItem)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
IndexedTraversal
  [Char]
  (InsOrdHashMap [Char] PathItem)
  (InsOrdHashMap [Char] PathItem)
  PathItem
  PathItem
itraversed(Indexed [Char] PathItem (f PathItem)
 -> InsOrdHashMap [Char] PathItem
 -> f (InsOrdHashMap [Char] PathItem))
-> ((Operation -> f Operation)
    -> Indexed [Char] PathItem (f PathItem))
-> (Operation -> f Operation)
-> InsOrdHashMap [Char] PathItem
-> f (InsOrdHashMap [Char] PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(([Char], PathItem) -> f ([Char], PathItem))
-> Indexed [Char] 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((([Char], PathItem) -> f ([Char], PathItem))
 -> Indexed [Char] PathItem (f PathItem))
-> ((Operation -> f Operation)
    -> ([Char], PathItem) -> f ([Char], PathItem))
-> (Operation -> f Operation)
-> Indexed [Char] PathItem (f PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Operation -> f Operation)
-> ([Char], PathItem) -> f ([Char], PathItem)
Traversal' ([Char], PathItem) Operation
subops
  where
    -- | Traverse operations that correspond to paths and methods of the sub API.
    subops :: Traversal' (FilePath, PathItem) Operation
    subops :: Traversal' ([Char], PathItem) Operation
subops Operation -> f Operation
f ([Char]
path, PathItem
item) = case [Char] -> InsOrdHashMap [Char] PathItem -> Maybe PathItem
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup [Char]
path (OpenApi
sub OpenApi
-> Getting
     (InsOrdHashMap [Char] PathItem)
     OpenApi
     (InsOrdHashMap [Char] PathItem)
-> InsOrdHashMap [Char] PathItem
forall s a. s -> Getting a s a -> a
^. Getting
  (InsOrdHashMap [Char] PathItem)
  OpenApi
  (InsOrdHashMap [Char] PathItem)
forall s a. HasPaths s a => Lens' s a
Lens' OpenApi (InsOrdHashMap [Char] PathItem)
paths) of
      Just PathItem
subitem -> (,) [Char]
path (PathItem -> ([Char], PathItem))
-> f PathItem -> f ([Char], PathItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathItem -> Traversal' PathItem Operation
methodsOf PathItem
subitem Operation -> f Operation
f PathItem
item
      Maybe PathItem
Nothing      -> ([Char], PathItem) -> f ([Char], PathItem)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
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
Traversal' PathItem (Maybe Operation)
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
IndexedTraversal
  Int
  [Maybe Operation]
  [Maybe Operation]
  (Maybe Operation)
  (Maybe Operation)
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 a. Eq a => a -> [a] -> 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 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe 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
Traversal' PathItem (Maybe Operation)
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 a b. (a -> b) -> Maybe a -> Maybe b
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)
forall (f :: * -> *) a. Applicative f => (Int, f a) -> f (Int, 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] -> OpenApi -> OpenApi
applyTags :: [Tag] -> OpenApi -> OpenApi
applyTags = Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
applyTagsFor (Operation -> f Operation) -> OpenApi -> f OpenApi
Traversal' OpenApi Operation
allOperations

-- | Apply tags to a part of Swagger spec and update the global
-- list of tags.
applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
applyTagsFor Traversal' OpenApi Operation
ops [Tag]
ts OpenApi
swag = OpenApi
swag
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
ops ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
    -> Operation -> Identity Operation)
-> (InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
-> OpenApi
-> Identity OpenApi
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
Lens' Operation (InsOrdHashSet TagName)
tags ((InsOrdHashSet TagName -> Identity (InsOrdHashSet TagName))
 -> OpenApi -> Identity OpenApi)
-> (InsOrdHashSet TagName -> InsOrdHashSet TagName)
-> OpenApi
-> OpenApi
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))
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (InsOrdHashSet Tag -> Identity (InsOrdHashSet Tag))
-> OpenApi -> Identity OpenApi
forall s a. HasTags s a => Lens' s a
Lens' OpenApi (InsOrdHashSet Tag)
tags ((InsOrdHashSet Tag -> Identity (InsOrdHashSet Tag))
 -> OpenApi -> Identity OpenApi)
-> (InsOrdHashSet Tag -> InsOrdHashSet Tag) -> OpenApi -> OpenApi
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.
--
-- FIXME doc
--
-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
-- [
--     {
--         "Day": {
--             "example": "2016-07-22",
--             "format": "date",
--             "type": "string"
--         }
--     },
--     {
--         "content": {
--             "application/json": {
--                 "schema": {
--                     "$ref": "#/components/schemas/Day"
--                 }
--             }
--         },
--         "description": ""
--     }
-- ]
declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
declareResponse :: forall a.
ToSchema a =>
MediaType -> Proxy a -> Declare (Definitions Schema) Response
declareResponse MediaType
cType 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 a. a -> DeclareT (Definitions Schema) Identity a
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
& (InsOrdHashMap MediaType MediaTypeObject
 -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response
forall s a. HasContent s a => Lens' s a
Lens' Response (InsOrdHashMap MediaType MediaTypeObject)
content((InsOrdHashMap MediaType MediaTypeObject
  -> Identity (InsOrdHashMap MediaType MediaTypeObject))
 -> Response -> Identity Response)
-> ((Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))
     -> Identity
          (Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))))
    -> InsOrdHashMap MediaType MediaTypeObject
    -> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> (Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))
    -> Identity
         (Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))))
-> Response
-> Identity Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (InsOrdHashMap MediaType MediaTypeObject)
-> Lens'
     (InsOrdHashMap MediaType MediaTypeObject)
     (Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at MediaType
Index (InsOrdHashMap MediaType MediaTypeObject)
cType ((Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))
  -> Identity
       (Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject))))
 -> Response -> Identity Response)
-> IxValue (InsOrdHashMap MediaType MediaTypeObject)
-> Response
-> Response
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (IxValue (InsOrdHashMap MediaType MediaTypeObject)
forall a. Monoid a => a
mempty IxValue (InsOrdHashMap MediaType MediaTypeObject)
-> (IxValue (InsOrdHashMap MediaType MediaTypeObject)
    -> IxValue (InsOrdHashMap MediaType MediaTypeObject))
-> IxValue (InsOrdHashMap MediaType MediaTypeObject)
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> IxValue (InsOrdHashMap MediaType MediaTypeObject)
-> Identity (IxValue (InsOrdHashMap MediaType MediaTypeObject))
forall s a. HasSchema s a => Lens' s a
Lens'
  (IxValue (InsOrdHashMap MediaType MediaTypeObject))
  (Maybe (Referenced Schema))
schema ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> IxValue (InsOrdHashMap MediaType MediaTypeObject)
 -> Identity (IxValue (InsOrdHashMap MediaType MediaTypeObject)))
-> Referenced Schema
-> IxValue (InsOrdHashMap MediaType MediaTypeObject)
-> IxValue (InsOrdHashMap MediaType MediaTypeObject)
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 :: OpenApi) & paths .~ IOHM.fromList [("/user", mempty & get ?~ mempty)]
-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
-- {
--     "components": {
--         "schemas": {
--             "Day": {
--                 "example": "2016-07-22",
--                 "format": "date",
--                 "type": "string"
--             }
--         }
--     },
--     "info": {
--         "title": "",
--         "version": ""
--     },
--     "openapi": "3.0.0",
--     "paths": {
--         "/user": {
--             "get": {
--                 "responses": {
--                     "200": {
--                         "content": {
--                             "application/json": {
--                                 "schema": {
--                                     "$ref": "#/components/schemas/Day"
--                                 }
--                             }
--                         },
--                         "description": ""
--                     }
--                 }
--             }
--         }
--     }
-- }
--
-- See also @'setResponseWith'@.
setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
setResponse :: Int -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
setResponse = Traversal' OpenApi Operation
-> Int
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseFor (Operation -> f Operation) -> OpenApi -> f OpenApi
Traversal' OpenApi 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 -> OpenApi -> OpenApi
setResponseWith :: (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith = Traversal' OpenApi Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseForWith (Operation -> f Operation) -> OpenApi -> f OpenApi
Traversal' OpenApi 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' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
setResponseFor :: Traversal' OpenApi Operation
-> Int
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseFor Traversal' OpenApi Operation
ops Int
code Declare (Definitions Schema) Response
dres OpenApi
swag = OpenApi
swag
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
Lens' OpenApi Components
components((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((Definitions Schema -> Identity (Definitions Schema))
    -> Components -> Identity Components)
-> (Definitions Schema -> Identity (Definitions Schema))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Schema -> Identity (Definitions Schema))
-> Components -> Identity Components
forall s a. HasSchemas s a => Lens' s a
Lens' Components (Definitions Schema)
schemas ((Definitions Schema -> Identity (Definitions Schema))
 -> OpenApi -> Identity OpenApi)
-> (Definitions Schema -> Definitions Schema) -> OpenApi -> OpenApi
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)
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
ops ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe (Referenced Response)
     -> Identity (Maybe (Referenced Response)))
    -> Operation -> Identity Operation)
-> (Maybe (Referenced Response)
    -> Identity (Maybe (Referenced Response)))
-> OpenApi
-> Identity OpenApi
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)))
 -> OpenApi -> Identity OpenApi)
-> Referenced Response -> OpenApi -> OpenApi
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' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
setResponseForWith :: Traversal' OpenApi Operation
-> (Response -> Response -> Response)
-> Int
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseForWith Traversal' OpenApi Operation
ops Response -> Response -> Response
f Int
code Declare (Definitions Schema) Response
dres OpenApi
swag = OpenApi
swag
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Components -> Identity Components) -> OpenApi -> Identity OpenApi
forall s a. HasComponents s a => Lens' s a
Lens' OpenApi Components
components((Components -> Identity Components)
 -> OpenApi -> Identity OpenApi)
-> ((Definitions Schema -> Identity (Definitions Schema))
    -> Components -> Identity Components)
-> (Definitions Schema -> Identity (Definitions Schema))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Schema -> Identity (Definitions Schema))
-> Components -> Identity Components
forall s a. HasSchemas s a => Lens' s a
Lens' Components (Definitions Schema)
schemas ((Definitions Schema -> Identity (Definitions Schema))
 -> OpenApi -> Identity OpenApi)
-> (Definitions Schema -> Definitions Schema) -> OpenApi -> OpenApi
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)
  OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
ops ((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe (Referenced Response)
     -> Identity (Maybe (Referenced Response)))
    -> Operation -> Identity Operation)
-> (Maybe (Referenced Response)
    -> Identity (Maybe (Referenced Response)))
-> OpenApi
-> Identity OpenApi
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)))
 -> OpenApi -> Identity OpenApi)
-> (Maybe (Referenced Response) -> Maybe (Referenced Response))
-> OpenApi
-> OpenApi
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 OpenApi
swag OpenApi
-> Getting (Maybe Response) OpenApi (Maybe Response)
-> Maybe Response
forall s a. s -> Getting a s a -> a
^. (Components -> Const (Maybe Response) Components)
-> OpenApi -> Const (Maybe Response) OpenApi
forall s a. HasComponents s a => Lens' s a
Lens' OpenApi Components
components((Components -> Const (Maybe Response) Components)
 -> OpenApi -> Const (Maybe Response) OpenApi)
-> ((Maybe Response -> Const (Maybe Response) (Maybe Response))
    -> Components -> Const (Maybe Response) Components)
-> Getting (Maybe Response) OpenApi (Maybe Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Definitions Response
 -> Const (Maybe Response) (Definitions Response))
-> Components -> Const (Maybe Response) Components
forall s a. HasResponses s a => Lens' s a
Lens' Components (Definitions Response)
responses((Definitions Response
  -> Const (Maybe Response) (Definitions Response))
 -> Components -> Const (Maybe Response) Components)
-> ((Maybe Response -> Const (Maybe Response) (Maybe Response))
    -> Definitions Response
    -> Const (Maybe Response) (Definitions Response))
-> (Maybe Response -> Const (Maybe Response) (Maybe Response))
-> Components
-> Const (Maybe Response) Components
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