From 884b14c890539fa88f059ec87b8252f22b614038 Mon Sep 17 00:00:00 2001 From: Andres Loeh Date: Wed, 12 May 2021 10:20:11 +0200 Subject: [PATCH] Generalise over the Swagger datatype. This change modifies the previously introduced generalisation of the Haskell datatype that holds the Swagger specification to an aeson Value. By using an aeson Value, all ordering information of object fields is being lost. This information is in principle preserved by aeson, when going via Encoding rather than Value. With this patch, we do not perform any aeson-related translation in the servant-swagger-ui code, and simply use the original datatype. It is servant's own responsibility to handle the actual conversion of the datatype to JSON. Follow-up to #89. Co-Authored-By: srk --- servant-swagger-ui-core/Changelog.md | 17 +++++++++++++++++ .../servant-swagger-ui-core.cabal | 2 +- .../src/Servant/Swagger/UI/Core.hs | 17 +++++++++-------- servant-swagger-ui-example/src/Main.hs | 6 +++--- .../servant-swagger-ui-jensoleg.cabal | 4 ++-- .../src/Servant/Swagger/UI/JensOleG.hs | 3 +-- servant-swagger-ui-redoc/CHANGELOG.md | 16 ++++++++++++++++ .../servant-swagger-ui-redoc.cabal | 4 ++-- .../src/Servant/Swagger/UI/ReDoc.hs | 5 ++--- servant-swagger-ui/CHANGELOG.md | 16 ++++++++++++++++ servant-swagger-ui/servant-swagger-ui.cabal | 4 ++-- servant-swagger-ui/src/Servant/Swagger/UI.hs | 5 ++--- 12 files changed, 73 insertions(+), 26 deletions(-) diff --git a/servant-swagger-ui-core/Changelog.md b/servant-swagger-ui-core/Changelog.md index d139d95..7b72a40 100644 --- a/servant-swagger-ui-core/Changelog.md +++ b/servant-swagger-ui-core/Changelog.md @@ -1,3 +1,20 @@ +# 0.3.6 + +- Generalize to support arbitrary type instead of hardcoded `Value`. + + `SwaggerSchemaUI` now needs one more parameter which typically is + either `Swagger` or `OpenApi`. + + To migrate from older version, alter your API type from + `SwaggerSchemaUI "swagger-ui" "swagger.json"` + to + `SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger` + + Or in case of the more generic variant, old + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Value)` + becomes + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Swagger)` + # 0.3.5 - Generalize `SwaggerSchemaUI` and `swaggerSchemaUIServerImpl` to support arbitrary `Value` instead diff --git a/servant-swagger-ui-core/servant-swagger-ui-core.cabal b/servant-swagger-ui-core/servant-swagger-ui-core.cabal index 796a4c6..35b6083 100644 --- a/servant-swagger-ui-core/servant-swagger-ui-core.cabal +++ b/servant-swagger-ui-core/servant-swagger-ui-core.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: servant-swagger-ui-core -version: 0.3.5 +version: 0.3.6 synopsis: Servant swagger ui core components category: Web, Servant, Swagger description: diff --git a/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs b/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs index 0b9a1bc..821395c 100644 --- a/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs +++ b/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs @@ -46,19 +46,19 @@ module Servant.Swagger.UI.Core ( Handler, ) where -import Data.Aeson (ToJSON (..), Value) import Data.ByteString (ByteString) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Network.Wai.Application.Static (embeddedSettings, staticApp) import Servant import Servant.HTML.Blaze (HTML) import Text.Blaze (ToMarkup (..)) +import Data.Kind (Type) import qualified Data.Text as T -- | Swagger schema + ui api. -- --- @SwaggerSchemaUI "swagger-ui" "swagger.json"@ will result into following hierarchy: +-- @SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger@ will result into following hierarchy: -- -- @ -- \/swagger.json @@ -67,10 +67,11 @@ import qualified Data.Text as T -- \/swagger-ui\/... -- @ -- --- This type does not actually force served type to be @Swagger@ from @swagger2@ package, --- it could be arbitrary @aeson@ 'Value'. -type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) = - SwaggerSchemaUI' dir (schema :> Get '[JSON] Value) +-- The third type parameter specifies which Haskell datatype contains the Swagger +-- description. Typical instantiations are @Swagger@ from the @swagger2@ package, +-- and @OpenApi@ from the @openapi3@ package. +type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) (ctype :: Type) = + SwaggerSchemaUI' dir (schema :> Get '[JSON] ctype) -- | Use 'SwaggerSchemaUI'' when you need even more control over -- where @swagger.json@ is served (e.g. subdirectory). @@ -103,11 +104,11 @@ instance (KnownSymbol dir, HasLink api, Link ~ MkLink api Link, IsElem api api) proxyApi = Proxy :: Proxy api swaggerSchemaUIServerImpl - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => T.Text -> [(FilePath, ByteString)] -> a -> ServerT (SwaggerSchemaUI' dir api) m swaggerSchemaUIServerImpl indexTemplate files swagger - = swaggerSchemaUIServerImpl' indexTemplate files $ return $ toJSON swagger + = swaggerSchemaUIServerImpl' indexTemplate files $ return swagger -- | Use a custom server to serve the Swagger spec source. swaggerSchemaUIServerImpl' diff --git a/servant-swagger-ui-example/src/Main.hs b/servant-swagger-ui-example/src/Main.hs index dcd1dd7..04331c6 100644 --- a/servant-swagger-ui-example/src/Main.hs +++ b/servant-swagger-ui-example/src/Main.hs @@ -136,13 +136,13 @@ type BasicAPI = Get '[PlainText, JSON] Text type API = -- this serves both: swagger.json and swagger-ui - SwaggerSchemaUI "swagger-ui" "swagger.json" + SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger :<|> BasicAPI -- To test nested case type API' = API :<|> "nested" :> API - :<|> SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Value) + :<|> SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Swagger) -- Implementation @@ -174,7 +174,7 @@ server' uiFlavour = server Normal -- Unfortunately we have to specify the basePath manually atm. schemaUiServer - :: (Server api ~ Handler Value) + :: (Server api ~ Handler Swagger) => Swagger -> Server (SwaggerSchemaUI' dir api) schemaUiServer = case uiFlavour of Original -> swaggerSchemaUIServer diff --git a/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal b/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal index 0e7423d..c38174a 100644 --- a/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal +++ b/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: servant-swagger-ui-jensoleg -version: 0.3.5 +version: 0.3.6 synopsis: Servant swagger ui: Jens-Ole Graulund theme category: Web, Servant, Swagger description: @@ -86,7 +86,7 @@ source-repository head library hs-source-dirs: src ghc-options: -Wall - build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 + build-depends: servant-swagger-ui-core >=0.3.6 && <0.4 build-depends: base >=4.7 && <4.22 , aeson >=0.8.0.2 && <2.3 diff --git a/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs b/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs index 200f65e..bda9045 100644 --- a/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs +++ b/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs @@ -55,7 +55,6 @@ module Servant.Swagger.UI.JensOleG ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) #if MIN_VERSION_file_embed_lzma(0,1,0) @@ -71,7 +70,7 @@ import Servant -- -- See jensolegSwaggerSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) jensolegSwaggerSchemaUIServer = swaggerSchemaUIServerImpl jensolegIndexTemplate jensolegFiles diff --git a/servant-swagger-ui-redoc/CHANGELOG.md b/servant-swagger-ui-redoc/CHANGELOG.md index 4b3e017..145e9bc 100644 --- a/servant-swagger-ui-redoc/CHANGELOG.md +++ b/servant-swagger-ui-redoc/CHANGELOG.md @@ -1,3 +1,19 @@ +- 0.3.6.1.22.3 + - Generalize to support arbitrary type instead of hardcoded `Value`. + + `SwaggerSchemaUI` now needs one more parameter which typically is + either `Swagger` or `OpenApi`. + + To migrate from older version, alter your API type from + `SwaggerSchemaUI "swagger-ui" "swagger.json"` + to + `SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger` + + Or in case of the more generic variant, old + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Value)` + becomes + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Swagger)` + - 0.3.2.1.22.3 - Update to ReDoc-1.22.3 diff --git a/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal b/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal index 5c5c08d..5111fb6 100644 --- a/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal +++ b/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: servant-swagger-ui-redoc -version: 0.3.5 +version: 0.3.6 synopsis: Servant swagger ui: ReDoc theme category: Web, Servant, Swagger description: @@ -40,7 +40,7 @@ source-repository head library hs-source-dirs: src ghc-options: -Wall - build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 + build-depends: servant-swagger-ui-core >=0.3.6 && <0.4 build-depends: base >=4.7 && <4.22 , aeson >=0.8.0.2 && <2.3 diff --git a/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs b/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs index 99eaea4..7b3f98f 100644 --- a/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs +++ b/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs @@ -57,7 +57,6 @@ module Servant.Swagger.UI.ReDoc ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) #if MIN_VERSION_file_embed_lzma(0,1,0) @@ -71,7 +70,7 @@ import Servant -- -- See redocSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) redocSchemaUIServer = swaggerSchemaUIServerImpl redocIndexTemplate redocFiles @@ -84,7 +83,7 @@ redocSchemaUIServer = -- redocSchemaUIServerT :: Swagger -> ServerT (SwaggerSchemaUI schema dir) m -- @ redocSchemaUIServerT - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => a -> ServerT (SwaggerSchemaUI' dir api) m redocSchemaUIServerT = swaggerSchemaUIServerImpl redocIndexTemplate redocFiles diff --git a/servant-swagger-ui/CHANGELOG.md b/servant-swagger-ui/CHANGELOG.md index a9e9fc9..5eb0006 100644 --- a/servant-swagger-ui/CHANGELOG.md +++ b/servant-swagger-ui/CHANGELOG.md @@ -1,3 +1,19 @@ +- 0.3.6.5.0.1 + - Generalize to support arbitrary type instead of hardcoded `Value`. + + `SwaggerSchemaUI` now needs one more parameter which typically is + either `Swagger` or `OpenApi`. + + To migrate from older version, alter your API type from + `SwaggerSchemaUI "swagger-ui" "swagger.json"` + to + `SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger` + + Or in case of the more generic variant, old + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Value)` + becomes + `SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Swagger)` + - 0.3.5.4.14.0 - Update to `swagger-ui-4.14.0` diff --git a/servant-swagger-ui/servant-swagger-ui.cabal b/servant-swagger-ui/servant-swagger-ui.cabal index e02e491..1df8ab2 100644 --- a/servant-swagger-ui/servant-swagger-ui.cabal +++ b/servant-swagger-ui/servant-swagger-ui.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: servant-swagger-ui -version: 0.3.5.5.0.1 +version: 0.3.6.5.0.1 synopsis: Servant swagger ui category: Web, Servant, Swagger description: @@ -50,7 +50,7 @@ source-repository head library hs-source-dirs: src ghc-options: -Wall - build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 + build-depends: servant-swagger-ui-core >=0.3.6 && <0.4 build-depends: base >=4.7 && <4.22 , aeson >=0.8.0.2 && <2.3 diff --git a/servant-swagger-ui/src/Servant/Swagger/UI.hs b/servant-swagger-ui/src/Servant/Swagger/UI.hs index 80913bb..2bd419f 100644 --- a/servant-swagger-ui/src/Servant/Swagger/UI.hs +++ b/servant-swagger-ui/src/Servant/Swagger/UI.hs @@ -62,7 +62,6 @@ module Servant.Swagger.UI ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) #if MIN_VERSION_file_embed_lzma(0,1,0) @@ -79,7 +78,7 @@ import Servant -- swaggerSchemaUIServer :: OpenApi -> Server (SwaggerSchemaUI schema dir) -- @ swaggerSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) swaggerSchemaUIServer = swaggerSchemaUIServerImpl swaggerUiIndexTemplate swaggerUiFiles @@ -93,7 +92,7 @@ swaggerSchemaUIServer = -- swaggerSchemaUIServerT :: OpenApi -> ServerT (SwaggerSchemaUI schema dir) m -- @ swaggerSchemaUIServerT - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => a -> ServerT (SwaggerSchemaUI' dir api) m swaggerSchemaUIServerT = swaggerSchemaUIServerImpl swaggerUiIndexTemplate swaggerUiFiles