diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +1.2 +--- + +- WithResource combinator for Servant-managed resources [#1630](https://github.com/haskell-servant/servant/pull/1630) + + For servant-swagger, this meant the addition of a `HasSwagger` instance. + 1.1.9 ------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,7 +24,7 @@ ### Usage -Please refer to [haddock documentation](http://hackage.haskell.org/package/servant/servant-swagger). +Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger). Some examples can be found in [`example/` directory](/example). 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.1.11 +version: 1.2 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 || ==8.8.4 || ==8.10.2 +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 extra-source-files: README.md @@ -50,7 +50,7 @@ custom-setup setup-depends: base >=4.9 && <5, - Cabal >= 1.24, + Cabal >= 1.24 && <4, cabal-doctest >=1.0.6 && <1.1 library @@ -72,12 +72,12 @@ 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.13 + , base-compat >=0.10.5 && <0.14 , bytestring >=0.10.8.1 && <0.12 , http-media >=0.7.1.3 && <0.9 , insert-ordered-containers >=0.2.1.0 && <0.3 , lens >=4.17 && <6 - , servant >=0.18.2 && <0.20 + , servant >=0.20 && <0.21 , singleton-bool >=0.1.4 && <0.2 , swagger2 >=2.3.0.1 && <3 , text >=1.2.3.0 && <2.1 @@ -92,7 +92,7 @@ build-depends: base, directory >= 1.0, - doctest >= 0.17 && <0.21, + doctest >= 0.17 && <0.22, 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.10 + build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.11 build-depends: base , base-compat , aeson >=1.4.2.0 && <3 - , hspec >=2.6.0 && <2.10 + , hspec >=2.6.0 && <2.11 , QuickCheck , lens , lens-aeson >=1.0.2 && <1.3 diff --git a/src/Servant/Swagger.hs b/src/Servant/Swagger.hs --- a/src/Servant/Swagger.hs +++ b/src/Servant/Swagger.hs @@ -55,6 +55,7 @@ -- >>> import Data.Typeable -- >>> import GHC.Generics -- >>> import Servant.API +-- >>> import System.Environment -- >>> import Test.Hspec -- >>> import Test.QuickCheck -- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8 @@ -64,6 +65,7 @@ -- >>> :set -XGeneralizedNewtypeDeriving -- >>> :set -XOverloadedStrings -- >>> :set -XTypeOperators +-- >>> setEnv "HSPEC_COLOR" "no" -- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable) -- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON) -- >>> instance ToJSON User 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 @@ -3,11 +3,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE UndecidableInstances #-} #endif @@ -30,11 +32,13 @@ import Data.Swagger.Declare import Data.Text (Text) import qualified Data.Text as Text +import GHC.Generics (D1, Meta(..), Rep) import GHC.TypeLits import Network.HTTP.Media (MediaType) 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 @@ -149,6 +153,10 @@ addParam :: Param -> Swagger -> Swagger addParam param = allOperations.parameters %~ (Inline param :) +-- | Add a tag to every operation in the spec. +addTag :: Text -> Swagger -> Swagger +addTag tag = allOperations.tags %~ ([tag] <>) + -- | Add accepted content types to every operation in the spec. addConsumes :: [MediaType] -> Swagger -> Swagger addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs)) @@ -296,6 +304,10 @@ instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) +-- | @'WithResource'@ combinator does not change our specification at all. +instance (HasSwagger sub) => HasSwagger (WithResource res :> sub) where + toSwagger _ = toSwagger (Proxy :: Proxy sub) + instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where toSwagger _ = prependPath piece (toSwagger (Proxy :: Proxy sub)) where @@ -438,6 +450,9 @@ & description .~ transDesc (reflectDescription (Proxy :: Proxy mods)) & required ?~ True & schema .~ ParamBody ref + +instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where + toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes))) -- ======================================================================= -- Below are the definitions that should be in Servant.API.ContentTypes diff --git a/src/Servant/Swagger/Internal/Test.hs b/src/Servant/Swagger/Internal/Test.hs --- a/src/Servant/Swagger/Internal/Test.hs +++ b/src/Servant/Swagger/Internal/Test.hs @@ -29,10 +29,12 @@ -- >>> import Control.Applicative -- >>> import GHC.Generics -- >>> import Test.QuickCheck +-- >>> import System.Environment (setEnv) -- >>> :set -XDeriveGeneric -- >>> :set -XGeneralizedNewtypeDeriving -- >>> :set -XDataKinds -- >>> :set -XTypeOperators +-- >>> setEnv "HSPEC_COLOR" "no" -- | Verify that every type used with @'JSON'@ content type in a servant API -- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@. @@ -76,7 +78,7 @@ -- >>> type ContactAPI = Get '[JSON] Contact -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy ContactAPI) -- ... --- ...No instance for (Arbitrary Contact) +-- ...No instance for ...Arbitrary Contact... -- ... arising from a use of ‘validateEveryToJSON’ -- ... validateEveryToJSON