diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +1.2.1 +----- + +- Add IsIn instance for NamedRoutes [#1707](https://github.com/haskell-servant/servant/pull/1707) + 1.2 --- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger). -Some examples can be found in [`example/` directory](/example). +Some examples can be found in [`example/` directory](/servant-swagger/example). ### Try it out diff --git a/servant-swagger.cabal b/servant-swagger.cabal --- a/servant-swagger.cabal +++ b/servant-swagger.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: servant-swagger -version: 1.2 +version: 1.2.1 synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API. description: Swagger is a project used to describe and document RESTful APIs. The core of the @@ -28,7 +28,7 @@ copyright: (c) 2015-2018, Servant contributors category: Web, Servant, Swagger build-type: Custom -tested-with: GHC==8.6.5, GHC==8.8.4, GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.7, GHC ==9.4.4 +tested-with: GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.8, GHC ==9.4.8, GHC ==9.6.4, GHC ==9.8.2 extra-source-files: README.md @@ -49,7 +49,7 @@ custom-setup setup-depends: - base >=4.9 && <5, + base >=4.14 && <5, Cabal >= 1.24 && <4, cabal-doctest >=1.0.6 && <1.1 @@ -71,16 +71,16 @@ hs-source-dirs: src build-depends: aeson >=1.4.2.0 && <3 , aeson-pretty >=0.8.7 && <0.9 - , base >=4.9.1.0 && <5 - , base-compat >=0.10.5 && <0.14 - , bytestring >=0.10.8.1 && <0.12 + , base >=4.14 && <5 + , base-compat >=0.10.5 && <0.15 + , bytestring >=0.10.8.1 && <0.13 , http-media >=0.7.1.3 && <0.9 , insert-ordered-containers >=0.2.1.0 && <0.3 , lens >=4.17 && <6 - , servant >=0.20 && <0.21 + , servant >=0.20.2 && <0.21 , singleton-bool >=0.1.4 && <0.2 , swagger2 >=2.3.0.1 && <3 - , text >=1.2.3.0 && <2.1 + , text >=1.2.3.0 && <2.2 , unordered-containers >=0.2.9.0 && <0.3 , hspec @@ -90,9 +90,9 @@ test-suite doctests ghc-options: -Wall build-depends: - base, + base < 5, directory >= 1.0, - doctest >= 0.17 && <0.22, + doctest >= 0.17 && <0.23, servant, QuickCheck, filepath @@ -106,11 +106,11 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.11 - build-depends: base + build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.12 + build-depends: base < 5 , base-compat , aeson >=1.4.2.0 && <3 - , hspec >=2.6.0 && <2.11 + , hspec >=2.6.0 && <2.12 , QuickCheck , lens , lens-aeson >=1.0.2 && <1.3 diff --git a/src/Servant/Swagger/Internal.hs b/src/Servant/Swagger/Internal.hs --- a/src/Servant/Swagger/Internal.hs +++ b/src/Servant/Swagger/Internal.hs @@ -38,7 +38,6 @@ import Servant.API import Servant.API.Description (FoldDescription, reflectDescription) -import Servant.API.Generic (ToServantApi, AsApi) import Servant.API.Modifiers (FoldRequired) import Servant.Swagger.Internal.TypeLevel.API @@ -470,10 +469,15 @@ class ToResponseHeader h where toResponseHeader :: Proxy h -> (HeaderName, Swagger.Header) -instance (KnownSymbol sym, ToParamSchema a) => ToResponseHeader (Header sym a) where - toResponseHeader _ = (hname, Swagger.Header Nothing hschema) +instance (KnownSymbol sym, ToParamSchema a, KnownSymbol (FoldDescription mods)) => ToResponseHeader (Header' mods sym a) where + toResponseHeader _ = + ( hname + , Swagger.Header (transDesc $ reflectDescription (Proxy :: Proxy mods)) hschema + ) where hname = Text.pack (symbolVal (Proxy :: Proxy sym)) + transDesc "" = Nothing + transDesc desc = Just (Text.pack desc) hschema = toParamSchema (Proxy :: Proxy a) class AllToResponseHeader hs where diff --git a/src/Servant/Swagger/Internal/TypeLevel/API.hs b/src/Servant/Swagger/Internal/TypeLevel/API.hs --- a/src/Servant/Swagger/Internal/TypeLevel/API.hs +++ b/src/Servant/Swagger/Internal/TypeLevel/API.hs @@ -8,6 +8,7 @@ module Servant.Swagger.Internal.TypeLevel.API where import GHC.Exts (Constraint) +import Data.Kind (Type) import Servant.API -- | Build a list of endpoints from an API. @@ -43,6 +44,7 @@ IsIn e (a :<|> b) = Or (IsIn e a) (IsIn e b) IsIn (e :> a) (e :> b) = IsIn a b IsIn e e = () + IsIn e (NamedRoutes record) = IsIn e (ToServantApi record) -- | Check whether a type is a member of a list of types. -- This is a type-level analogue of @'elem'@. @@ -75,7 +77,7 @@ -- @'NoContent'@ is removed from the list and not tested. (This allows for leaving the body -- 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 +type family BodyTypes' c api :: [Type] where BodyTypes' c (Verb verb b cs (Headers hdrs a)) = AddBodyType c cs a '[] BodyTypes' c (Verb verb b cs NoContent) = '[] BodyTypes' c (Verb verb b cs a) = AddBodyType c cs a '[] diff --git a/src/Servant/Swagger/Internal/TypeLevel/Every.hs b/src/Servant/Swagger/Internal/TypeLevel/Every.hs --- a/src/Servant/Swagger/Internal/TypeLevel/Every.hs +++ b/src/Servant/Swagger/Internal/TypeLevel/Every.hs @@ -18,6 +18,8 @@ #endif module Servant.Swagger.Internal.TypeLevel.Every where +import Data.Kind + (Type) import Data.Proxy import GHC.Exts (Constraint) @@ -48,7 +50,7 @@ -- | Apply multiple constraint constructors to a type as a class. -- -- This is different from @'EveryTF'@ in that it allows partial application. -class EveryTF cs x => Every (cs :: [* -> Constraint]) (x :: *) where +class EveryTF cs x => Every (cs :: [Type -> Constraint]) (x :: Type) where instance Every '[] x where instance (c x, Every cs x) => Every (c ': cs) x where