@@ -16,6 +16,11 @@ import Data.Swagger.Internal
1616import Data.Swagger.Lens
1717import Data.Swagger.Schema
1818
19+-- $setup
20+-- >>> import Data.Aeson
21+-- >>> import Data.Proxy
22+-- >>> import Data.Time
23+
1924-- | Prepend path piece to all operations of the spec.
2025-- Leading and trailing slashes are trimmed/added automatically.
2126--
@@ -37,11 +42,6 @@ prependPath path = paths %~ mapKeys (path </>)
3742allOperations :: Traversal' Swagger Operation
3843allOperations = paths.traverse.template
3944
40−-- $setup
41−-- >>> import Data.Aeson
42−-- >>> import Data.Proxy
43−-- >>> import Data.Time
44−
4545-- | @'operationsOf' sub@ will traverse only those operations
4646-- that are present in @sub@. Note that @'Operation'@ is determined
4747-- by both path and method.
@@ -90,10 +90,14 @@ declareResponse proxy = do
9090-- | Set response for specified operations.
9191-- This will also update global schema definitions.
9292--
93+-- If the response already exists it will be overwritten.
94+--
9395-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
9496-- >>> let res = declareResponse (Proxy :: Proxy Day)
9597-- >>> encode $ api & setResponseFor allOperations 200 res
9698-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"Day\":{\"format\":\"date\",\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}}}"
99+--
100+-- See also @'setResponseForWith'@.
97101setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
98102setResponseFor ops code dres swag = swag
99103 & definitions %~ (<> defs)
@@ -101,3 +105,23 @@ setResponseFor ops code dres swag = swag
101105 where
102106 (defs, res) = runDeclare dres mempty
103107
108+-- | Set or update response for specified operations.
109+-- This will also update global schema definitions.
110+--
111+-- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
112+-- then just the new response is used.
113+--
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
119+ where
120+ (defs, new) = runDeclare dres mempty
121+
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
127+