From 9aaeaf2a2df87ae2803d8ae94863fd2032c168e2 Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Thu, 14 Nov 2024 17:00:59 +1000 Subject: [PATCH 1/3] Whitespace lint --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2499585..da4af3b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,7 +14,7 @@ * Support servant-0.15 - support for 'Stream' and 'StreamBody' combinators - orphan 'ToSchema (SourceT m a)' instance -* Fix BodyTypes to work with generalized ReqBody' +* Fix BodyTypes to work with generalized ReqBody' [#88](https://github.com/haskell-servant/servant-swagger/pull/88) 1.1.6 From 76e94297ca0accd4e2a8c52673e2d6587b7e74a8 Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Thu, 14 Nov 2024 17:01:08 +1000 Subject: [PATCH 2/3] Stop NoContent appearing in BodyTypes if it appears inside Headers Recurse through `Headers hdrs` just like any other decorator that should be ignored. --- CHANGELOG.md | 6 ++++++ src/Servant/OpenApi/Internal/TypeLevel/API.hs | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index da4af3b..243d686 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +Unreleased +---------- + +* Do not count `NoContent` as a body type if it appears in `Headers + hdrs NoContent`. + 1.1.8 ------- diff --git a/src/Servant/OpenApi/Internal/TypeLevel/API.hs b/src/Servant/OpenApi/Internal/TypeLevel/API.hs index 41feeba..5f10cf5 100644 --- a/src/Servant/OpenApi/Internal/TypeLevel/API.hs +++ b/src/Servant/OpenApi/Internal/TypeLevel/API.hs @@ -86,7 +86,7 @@ type AddBodyType c cs a as = If (Elem c cs) (a ': as) as -- completely empty on responses to requests that only accept 'application/json', while -- setting the content-type in the response accordingly.) type family BodyTypes' c api :: [*] where - BodyTypes' c (Verb verb b cs (Headers hdrs a)) = AddBodyType c cs a '[] + BodyTypes' c (Verb verb b cs (Headers hdrs a)) = BodyTypes' c (Verb verb b cs a) BodyTypes' c (Verb verb b cs NoContent) = '[] BodyTypes' c (Verb verb b cs a) = AddBodyType c cs a '[] BodyTypes' c (ReqBody' mods cs a :> api) = AddBodyType c cs a (BodyTypes' c api) From 1532c22c43d7a733463c8ec56bdb90f17518b310 Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Fri, 15 Nov 2024 11:35:12 +1000 Subject: [PATCH 3/3] Fix superclass conditions on HasOpenApi (UVerb method cs (a ': as)) Unconditionally requesting `ToSchema a` etc means that we erroneously demand `ToSchema NoContent`. Instead delegate to the `HasOpenApi` instance for the related `Verb`, allowing the overlapping instances for `NoContent` to be selected. --- CHANGELOG.md | 2 ++ src/Servant/OpenApi/Internal.hs | 5 +---- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 243d686..212f352 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,8 @@ Unreleased ---------- +* The `HasOpenApi` instance that recurses through `UVerb` responses no + longer demands `ToSchema NoContent`. * Do not count `NoContent` as a body type if it appears in `Headers hdrs NoContent`. diff --git a/src/Servant/OpenApi/Internal.hs b/src/Servant/OpenApi/Internal.hs index 7551058..ce21e8a 100644 --- a/src/Servant/OpenApi/Internal.hs +++ b/src/Servant/OpenApi/Internal.hs @@ -198,10 +198,7 @@ instance HasOpenApi (UVerb method cs '[]) where -- | @since <2.0.1.0> instance {-# OVERLAPPABLE #-} - ( ToSchema a, - HasStatus a, - AllAccept cs, - OpenApiMethod method, + ( HasOpenApi (Verb method (StatusOf a) cs a), HasOpenApi (UVerb method cs as) ) => HasOpenApi (UVerb method cs (a ': as))