servant-swagger 1.1.10 → 1.1.11
raw patch · 10 files changed
+245/−90 lines, 10 filesdep ~base-compatdep ~hspecdep ~lens-aesonnew-uploader
Dependency ranges changed: base-compat, hspec, lens-aeson, servant
Files
- README.md +2/−3
- example/example.cabal +2/−2
- example/swagger.json +3/−6
- servant-swagger.cabal +28/−33
- src/Servant/Swagger.hs +12/−10
- src/Servant/Swagger/Internal.hs +81/−13
- src/Servant/Swagger/Internal/Orphans.hs +13/−2
- src/Servant/Swagger/Internal/Test.hs +20/−17
- src/Servant/Swagger/Internal/TypeLevel/API.hs +0/−1
- test/Servant/SwaggerSpec.hs +84/−3
README.md view
@@ -1,6 +1,5 @@ # servant-swagger -[](https://travis-ci.org/haskell-servant/servant-swagger) [](http://hackage.haskell.org/package/servant-swagger) [](http://stackage.org/lts/package/servant-swagger) [](http://stackage.org/nightly/package/servant-swagger)@@ -25,7 +24,7 @@ ### Usage -Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger).+Please refer to [haddock documentation](http://hackage.haskell.org/package/servant/servant-swagger). Some examples can be found in [`example/` directory](/example). @@ -43,5 +42,5 @@ We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. -Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant-swagger/issues).+Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant/issues).
example/example.cabal view
@@ -1,15 +1,15 @@+cabal-version: 2.2 name: example version: 1.0 synopsis: servant-swagger demonstration description: servant-swagger demonstration-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: David Johnson, Nickolay Kudasov maintainer: nickolay.kudasov@gmail.com copyright: (c) 2015-2016, Servant contributors category: Web build-type: Simple-cabal-version: >=1.10 data-files: swagger.json
example/swagger.json view
@@ -45,8 +45,8 @@ "/todo/{id}": { "get": { "responses": {- "404": {- "description": "`id` not found"+ "400": {+ "description": "Invalid `id`" }, "200": { "schema": {@@ -74,11 +74,8 @@ "application/json;charset=utf-8" ], "responses": {- "404": {- "description": "`id` not found"- }, "400": {- "description": "Invalid `body`"+ "description": "Invalid `body` or `id`" }, "200": { "schema": {
servant-swagger.cabal view
@@ -1,11 +1,12 @@+cabal-version: 2.2 name: servant-swagger-version: 1.1.10+version: 1.1.11 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 - project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/). - This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is - quite popular among developers in different languages. It has also existed for a longer time + Swagger is a project used to describe and document RESTful APIs. The core of the+ project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).+ This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is+ quite popular among developers in different languages. It has also existed for a longer time and has more helpful tooling. . This package provides means to generate a Swagger/OAS specification for a Servant API@@ -18,22 +19,16 @@ * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/); . * and [many others](http://swagger.io/open-source-integrations/).-homepage: https://github.com/haskell-servant/servant-swagger-bug-reports: https://github.com/haskell-servant/servant-swagger/issues-license: BSD3+homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme+bug-reports: https://github.com/haskell-servant/servant/issues+license: BSD-3-Clause license-file: LICENSE-author: David Johnson, Nickolay Kudasov-maintainer: nickolay.kudasov@gmail.com+author: Servant Contributors+maintainer: haskell-servant-maintainers@googlegroups.com copyright: (c) 2015-2018, Servant contributors category: Web, Servant, Swagger build-type: Custom-cabal-version: 1.18-tested-with:- GHC ==8.0.2- || ==8.2.2- || ==8.4.4- || ==8.6.5- || ==8.8.1+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 extra-source-files: README.md@@ -50,12 +45,12 @@ source-repository head type: git- location: https://github.com/haskell-servant/servant-swagger.git+ location: https://github.com/haskell-servant/servant.git custom-setup setup-depends:- base >=4.9 && <4.15,- Cabal >= 1.24 && <3.3,+ base >=4.9 && <5,+ Cabal >= 1.24, cabal-doctest >=1.0.6 && <1.1 library@@ -74,18 +69,18 @@ Servant.Swagger.Internal.TypeLevel.Every Servant.Swagger.Internal.TypeLevel.TMap hs-source-dirs: src- build-depends: aeson >=1.4.2.0 && <1.6+ build-depends: aeson >=1.4.2.0 && <3 , aeson-pretty >=0.8.7 && <0.9- , base >=4.9.1.0 && <4.15- , base-compat >=0.10.5 && <0.12- , bytestring >=0.10.8.1 && <0.11+ , base >=4.9.1.0 && <5+ , base-compat >=0.10.5 && <0.13+ , 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 && <4.20- , servant >=0.17 && <0.19+ , lens >=4.17 && <6+ , servant >=0.18.2 && <0.20 , singleton-bool >=0.1.4 && <0.2- , swagger2 >=2.3.0.1 && <2.7- , text >=1.2.3.0 && <1.3+ , swagger2 >=2.3.0.1 && <3+ , text >=1.2.3.0 && <2.1 , unordered-containers >=0.2.9.0 && <0.3 , hspec@@ -97,7 +92,7 @@ build-depends: base, directory >= 1.0,- doctest >= 0.11.1 && <0.18,+ doctest >= 0.17 && <0.21, servant, QuickCheck, filepath@@ -111,14 +106,14 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10 build-depends: base , base-compat- , aeson- , hspec >=2.6.0 && <2.8+ , aeson >=1.4.2.0 && <3+ , hspec >=2.6.0 && <2.10 , QuickCheck , lens- , lens-aeson >=1.0.2 && <1.2+ , lens-aeson >=1.0.2 && <1.3 , servant , servant-swagger , swagger2
src/Servant/Swagger.hs view
@@ -50,6 +50,7 @@ -- >>> import Control.Applicative -- >>> import Control.Lens -- >>> import Data.Aeson+-- >>> import Data.Aeson.Encode.Pretty -- >>> import Data.Swagger -- >>> import Data.Typeable -- >>> import GHC.Generics@@ -73,6 +74,7 @@ -- >>> type GetUser = Capture "user_id" UserId :> Get '[JSON] User -- >>> type PostUser = ReqBody '[JSON] User :> Post '[JSON] UserId -- >>> type UserAPI = GetUsers :<|> GetUser :<|> PostUser+-- >>> orderedKeys = encodePretty' (defConfig { confCompare = compare, confIndent = Spaces 0 }) -- $howto --@@ -98,12 +100,12 @@ -- $generate -- In order to generate @'Swagger'@ specification for a servant API, just use @'toSwagger'@: ----- >>> BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI)--- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}}+-- >>> BSL8.putStrLn . orderedKeys $ toSwagger (Proxy :: Proxy UserAPI)+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"} -- -- By default @'toSwagger'@ will generate specification for all API routes, parameters, headers, responses and data schemas. ----- For some parameters it will also add 400 and/or 404 responses with a description mentioning parameter name.+-- For some parameters it will also add 400 responses with a description mentioning parameter name. -- -- Data schemas come from @'ToParamSchema'@ and @'ToSchema'@ classes. @@ -113,14 +115,14 @@ -- We can add this information using field lenses from @"Data.Swagger"@: -- -- >>> :{--- BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI)+-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI) -- & info.title .~ "User API" -- & info.version .~ "1.0" -- & info.description ?~ "This is an API for the Users service" -- & info.license ?~ "MIT" -- & host ?~ "example.com" -- :}--- {"swagger":"2.0","info":{"version":"1.0","title":"User API","license":{"name":"MIT"},"description":"This is an API for the Users service"},"host":"example.com","paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}}+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"host":"example.com","info":{"description":"This is an API for the Users service","license":{"name":"MIT"},"title":"User API","version":"1.0"},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"} -- -- It is also useful to annotate or modify certain endpoints. -- @'subOperations'@ provides a convenient way to zoom into a part of an API.@@ -134,11 +136,11 @@ -- >>> let getOps = subOperations (Proxy :: Proxy (GetUsers :<|> GetUser)) (Proxy :: Proxy UserAPI) -- >>> let postOps = subOperations (Proxy :: Proxy PostUser) (Proxy :: Proxy UserAPI) -- >>> :{--- BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI)+-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI) -- & applyTagsFor getOps ["get" & description ?~ "GET operations"] -- & applyTagsFor postOps ["post" & description ?~ "POST operations"] -- :}--- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"tags":["post"],"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}},"tags":[{"name":"get","description":"GET operations"},{"name":"post","description":"POST operations"}]}+-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}},"tags":["get"]},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}},"tags":["post"]}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}},"tags":["get"]}}},"swagger":"2.0","tags":[{"description":"GET operations","name":"get"},{"description":"POST operations","name":"post"}]} -- -- This applies @\"get\"@ tag to the @GET@ endpoints and @\"post\"@ tag to the @POST@ endpoint of the User API. @@ -158,11 +160,11 @@ -- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- <BLANKLINE>--- [User]+-- [User]... -- ...--- User+-- User... -- ...--- UserId+-- UserId... -- ... -- Finished in ... seconds -- 3 examples, 0 failures
src/Servant/Swagger/Internal.hs view
@@ -16,12 +16,14 @@ import Prelude () import Prelude.Compat +import Control.Applicative ((<|>)) import Control.Lens import Data.Aeson import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Foldable (toList) import Data.Proxy+import Data.Typeable import Data.Singletons.Bool import Data.Swagger hiding (Header) import qualified Data.Swagger as Swagger@@ -155,14 +157,6 @@ markdownCode :: Text -> Text markdownCode s = "`" <> s <> "`" -addDefaultResponse404 :: ParamName -> Swagger -> Swagger-addDefaultResponse404 pname = setResponseWith (\old _new -> alter404 old) 404 (return response404)- where- sname = markdownCode pname- description404 = sname <> " not found"- alter404 = description %~ ((sname <> " or ") <>)- response404 = mempty & description .~ description404- addDefaultResponse400 :: ParamName -> Swagger -> Swagger addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400) where@@ -183,6 +177,73 @@ instance SwaggerMethod 'HEAD where swaggerMethod _ = head_ instance SwaggerMethod 'PATCH where swaggerMethod _ = patch +instance HasSwagger (UVerb method cs '[]) where+ toSwagger _ = mempty++-- | @since <TODO>+instance+ {-# OVERLAPPABLE #-}+ ( ToSchema a,+ HasStatus a,+ AllAccept cs,+ SwaggerMethod method,+ HasSwagger (UVerb method cs as)+ ) =>+ HasSwagger (UVerb method cs (a ': as))+ where+ toSwagger _ =+ toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a))+ `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))++-- ATTENTION: do not remove this instance!+-- A similar instance above will always use the more general+-- polymorphic -- HasSwagger instance and will result in a type error+-- since 'NoContent' does not have a 'ToSchema' instance.+instance+ ( KnownNat status,+ AllAccept cs,+ SwaggerMethod method,+ HasSwagger (UVerb method cs as)+ ) =>+ HasSwagger (UVerb method cs (WithStatus status NoContent ': as))+ where+ toSwagger _ =+ toSwagger (Proxy :: Proxy (Verb method status cs NoContent))+ `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as))+++-- workaround for https://github.com/GetShopTV/swagger2/issues/218+-- We'd like to juse use (<>) but the instances are wrong+combinePathItem :: PathItem -> PathItem -> PathItem+combinePathItem s t = PathItem+ { _pathItemGet = _pathItemGet s <> _pathItemGet t+ , _pathItemPut = _pathItemPut s <> _pathItemPut t+ , _pathItemPost = _pathItemPost s <> _pathItemPost t+ , _pathItemDelete = _pathItemDelete s <> _pathItemDelete t+ , _pathItemOptions = _pathItemOptions s <> _pathItemOptions t+ , _pathItemHead = _pathItemHead s <> _pathItemHead t+ , _pathItemPatch = _pathItemPatch s <> _pathItemPatch t+ , _pathItemParameters = _pathItemParameters s <> _pathItemParameters t+ }++combineSwagger :: Swagger -> Swagger -> Swagger+combineSwagger s t = Swagger+ { _swaggerInfo = _swaggerInfo s <> _swaggerInfo t+ , _swaggerHost = _swaggerHost s <|> _swaggerHost t+ , _swaggerBasePath = _swaggerBasePath s <|> _swaggerBasePath t+ , _swaggerSchemes = _swaggerSchemes s <> _swaggerSchemes t+ , _swaggerConsumes = _swaggerConsumes s <> _swaggerConsumes t+ , _swaggerProduces = _swaggerProduces s <> _swaggerProduces t+ , _swaggerPaths = InsOrdHashMap.unionWith combinePathItem (_swaggerPaths s) (_swaggerPaths t)+ , _swaggerDefinitions = _swaggerDefinitions s <> _swaggerDefinitions t+ , _swaggerParameters = _swaggerParameters s <> _swaggerParameters t+ , _swaggerResponses = _swaggerResponses s <> _swaggerResponses t+ , _swaggerSecurityDefinitions = _swaggerSecurityDefinitions s <> _swaggerSecurityDefinitions t+ , _swaggerSecurity = _swaggerSecurity s <> _swaggerSecurity t+ , _swaggerTags = _swaggerTags s <> _swaggerTags t+ , _swaggerExternalDocs = _swaggerExternalDocs s <|> _swaggerExternalDocs t+ }+ instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] a))) @@ -223,6 +284,10 @@ instance (HasSwagger sub) => HasSwagger (RemoteHost :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) +-- | @'Fragment'@ combinator does not change our specification at all.+instance HasSwagger sub => HasSwagger (Fragment a :> sub) where+ toSwagger _ = toSwagger (Proxy :: Proxy sub)+ -- | @'HttpVersion'@ combinator does not change our specification at all. instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub)@@ -236,13 +301,16 @@ where piece = symbolVal (Proxy :: Proxy sym) -instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) & addParam param & prependPath capture- & addDefaultResponse404 tname+ & addDefaultResponse400 tname where- pname = symbolVal (Proxy :: Proxy sym)+ symbol = symbolVal (Proxy :: Proxy sym)+ pname = if symbol == ""+ then camelTo2 '-' . tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)+ else symbol tname = Text.pack pname transDesc "" = Nothing transDesc desc = Just (Text.pack desc)@@ -256,7 +324,7 @@ & paramSchema .~ toParamSchema (Proxy :: Proxy a)) -- | Swagger Spec doesn't have a notion of CaptureAll, this instance is the best effort.-instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where+instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy (Capture sym a :> sub)) instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Description desc :> api) where@@ -352,7 +420,7 @@ & schema .~ ParamBody ref -- | This instance is an approximation.--- +-- -- @since 1.1.7 instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (StreamBody' mods fr ct a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub)
src/Servant/Swagger/Internal/Orphans.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} module Servant.Swagger.Internal.Orphans where import Data.Proxy@@ -7,6 +10,9 @@ import Data.Swagger import Servant.Types.SourceT (SourceT)+#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)+import Servant.API (WithStatus(..))+#endif -- | Pretend that 'SourceT m a' is '[a]'. --@@ -14,3 +20,8 @@ -- instance ToSchema a => ToSchema (SourceT m a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])++#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0)+-- @since 1.1.11+deriving instance ToSchema a => ToSchema (WithStatus s a)+#endif
src/Servant/Swagger/Internal/Test.hs view
@@ -4,10 +4,12 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-} module Servant.Swagger.Internal.Test where import Data.Aeson (ToJSON (..))-import Data.Aeson.Encode.Pretty (encodePretty)+import Data.Aeson.Encode.Pretty (encodePretty', defConfig,+ confCompare) import Data.Swagger (Pattern, ToSchema, toSchema) import Data.Swagger.Schema.Validation@@ -51,10 +53,10 @@ -- -- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- <BLANKLINE>--- ToJSON matches ToSchema--- User+-- ToJSON matches ToSchema...+-- User... -- ...--- UserId+-- UserId... -- ... -- Finished in ... seconds -- 2 examples, 0 failures@@ -116,11 +118,11 @@ -- :} -- <BLANKLINE> -- read . show == id--- Bool+-- Bool... -- ...--- Int+-- Int... -- ...--- [Char]+-- [Char]... -- ... -- Finished in ... seconds -- 3 examples, 0 failures@@ -158,19 +160,19 @@ -- <BLANKLINE> -- Swagger Schema: -- {--- "required": [--- "name",--- "phone"--- ],--- "type": "object", -- "properties": {--- "phone": {--- "type": "integer"--- }, -- "name": { -- "type": "string"+-- },+-- "phone": {+-- "type": "integer" -- }--- }+-- },+-- "required": [+-- "name",+-- "phone"+-- ],+-- "type": "object" -- } -- <BLANKLINE> --@@ -191,7 +193,8 @@ , ppJSONString (toJSON schema) ] where- ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty+ ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty' ppCfg+ ppCfg = defConfig { confCompare = compare } json = toJSON x schema = toSchema (Proxy :: Proxy a)
src/Servant/Swagger/Internal/TypeLevel/API.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE UndecidableInstances #-} module Servant.Swagger.Internal.TypeLevel.API where -import Data.Type.Bool (If) import GHC.Exts (Constraint) import Servant.API
test/Servant/SwaggerSpec.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PackageImports #-} module Servant.SwaggerSpec where@@ -40,6 +41,7 @@ it "Todo API" $ checkAPI (Proxy :: Proxy TodoAPI) todoAPI it "Hackage API (with tags)" $ checkSwagger hackageSwaggerWithTags hackageAPI it "GetPost API (test subOperations)" $ checkSwagger getPostSwagger getPostAPI+ it "UVerb API" $ checkSwagger uverbSwagger uverbAPI it "Comprehensive API" $ do let _x = toSwagger comprehensiveAPI True `shouldBe` True -- type-level test@@ -107,7 +109,7 @@ "schema": { "$ref":"#/definitions/Todo" }, "description": "" },- "404": { "description": "`id` not found" }+ "400": { "description": "Invalid `id`" } }, "produces": [ "application/json;charset=utf-8" ], "parameters":@@ -297,8 +299,8 @@ "/user/{username}":{ "get":{ "responses":{- "404":{- "description":"`username` not found"+ "400":{+ "description":"Invalid `username`" }, "200":{ "schema":{@@ -406,3 +408,82 @@ } |] +-- =======================================================================+-- UVerb API+-- =======================================================================++data Lunch = Lunch {name :: String}+ deriving (Eq, Show, Generic)++instance ToSchema Lunch++instance HasStatus Lunch where+ type StatusOf Lunch = 200++data NoLunch = NoLunch+ deriving (Eq, Show, Generic)++instance ToSchema NoLunch++instance HasStatus NoLunch where+ type StatusOf NoLunch = 404++type UVerbAPI2 =+ "lunch" :> UVerb 'GET '[JSON] '[Lunch, NoLunch]++uverbSwagger :: Swagger+uverbSwagger = toSwagger (Proxy :: Proxy UVerbAPI2)++uverbAPI :: Value+uverbAPI =+ [aesonQQ|+ {+ "swagger": "2.0",+ "info": {+ "version": "",+ "title": ""+ },+ "definitions": {+ "Lunch": {+ "required": [+ "name"+ ],+ "type": "object",+ "properties": {+ "name": {+ "type": "string"+ }+ }+ },+ "NoLunch": {+ "type": "string",+ "enum": [+ "NoLunch"+ ]+ }+ },+ "paths": {+ "/lunch": {+ "get": {+ "responses": {+ "404": {+ "schema": {+ "$ref": "#/definitions/NoLunch"+ },+ "description": ""+ },+ "200": {+ "schema": {+ "$ref": "#/definitions/Lunch"+ },+ "description": ""+ }+ },+ "produces": [+ "application/json;charset=utf-8"+ ]+ }+ }+ }+}+|]