@@ -16,6 +16,11 @@ import Data.Swagger.Internal
16import Data.Swagger.Lens
16import Data.Swagger.Lens
17import Data.Swagger.Schema
17import Data.Swagger.Schema
20+-- >>> import Data.Aeson
21+-- >>> import Data.Proxy
22+-- >>> import Data.Time
19-- | Prepend path piece to all operations of the spec.
24-- | Prepend path piece to all operations of the spec.
20-- Leading and trailing slashes are trimmed/added automatically.
25-- Leading and trailing slashes are trimmed/added automatically.
@@ -37,11 +42,6 @@ prependPath path = paths %~ mapKeys (path </>)
37allOperations :: Traversal' Swagger Operation
42allOperations :: Traversal' Swagger Operation
38allOperations = paths.traverse.template
43allOperations = paths.traverse.template
41−-- >>> import Data.Aeson
42−-- >>> import Data.Proxy
43−-- >>> import Data.Time
45-- | @'operationsOf' sub@ will traverse only those operations
45-- | @'operationsOf' sub@ will traverse only those operations
46-- that are present in @sub@. Note that @'Operation'@ is determined
46-- that are present in @sub@. Note that @'Operation'@ is determined
47-- by both path and method.
47-- by both path and method.
@@ -90,10 +90,14 @@ declareResponse proxy = do
90-- | Set response for specified operations.
90-- | Set response for specified operations.
91-- This will also update global schema definitions.
91-- This will also update global schema definitions.
93+-- If the response already exists it will be overwritten.
93-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
95-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
94-- >>> let res = declareResponse (Proxy :: Proxy Day)
96-- >>> let res = declareResponse (Proxy :: Proxy Day)
95-- >>> encode $ api & setResponseFor allOperations 200 res
97-- >>> encode $ api & setResponseFor allOperations 200 res
96-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"Day\":{\"format\":\"date\",\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}}}"
98-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"Day\":{\"format\":\"date\",\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}}}"
100+-- See also @'setResponseForWith'@.
97setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
101setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
98setResponseFor ops code dres swag = swag
102setResponseFor ops code dres swag = swag
99 & definitions %~ (<> defs)
103 & definitions %~ (<> defs)
@@ -101,3 +105,23 @@ setResponseFor ops code dres swag = swag
102 (defs, res) = runDeclare dres mempty
106 (defs, res) = runDeclare dres mempty
108+-- | Set or update response for specified operations.
109+-- This will also update global schema definitions.
111+-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
112+-- then just the new response is used.
114+-- See also @'setResponseFor'@.
115+setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
116+setResponseForWith ops f code dres swag = swag
117+ & definitions %~ (<> defs)
118+ & ops . at code %~ Just . Inline . combine
120+ (defs, new) = runDeclare dres mempty
122+ combine (Just (Ref (Reference name))) = case swag ^. responses.at name of
123+ Just old -> f old new
124+ Nothing -> new -- response name can't be dereferenced, replacing with new response
125+ combine (Just (Inline old)) = f old new
126+ combine Nothing = new