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.

Based on haskell-servant#89

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

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:
@@ -36,7 +36,6 @@ library
   ghc-options:      -Wall
   build-depends:
       base                 >=4.7      && <4.17
-    , aeson                >=0.8.0.2  && <2.1.0
     , blaze-markup         >=0.7.0.2  && <0.9
     , bytestring           >=0.10.4.0 && <0.12
     , http-media           >=0.7.1.3  && <0.9

servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs

@@ -23,7 +23,7 @@
 --     :\<|> "cat" :> Capture ":name" CatName :> Get '[JSON] Cat
 --
 -- -- | API type with bells and whistles, i.e. schema file and swagger-ui.
--- type API = 'SwaggerSchemaUI' "swagger-ui" "swagger.json"
+-- type API = 'SwaggerSchemaUI' "swagger-ui" "swagger.json" Swagger
 --     :\<|> BasicAPI
 --
 -- -- | Servant server for an API
@@ -46,7 +46,6 @@ 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)
@@ -58,7 +57,7 @@ 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 +66,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) (a :: *) =
+    SwaggerSchemaUI' dir (schema :> Get '[JSON] a)
 
 -- | Use 'SwaggerSchemaUI'' when you need even more control over
 -- where @swagger.json@ is served (e.g. subdirectory).
@@ -103,11 +103,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'

servant-swagger-ui-example/src/Main.hs

@@ -16,7 +16,7 @@ import Prelude ()
 import Prelude.Compat
 
 import Control.Lens       hiding ((.=))
-import Data.Aeson         (FromJSON, ToJSON, Value)
+import Data.Aeson         (FromJSON, ToJSON)
 import Data.Maybe         (fromMaybe)
 import Data.String        (IsString (..))
 import Data.Text          (Text)
@@ -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

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.4
+version:            0.3.6
 synopsis:           Servant swagger ui: Jens-Ole Graulund theme
 category:           Web, Servant, Swagger
 description:
@@ -82,10 +82,9 @@ 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.17
-    , aeson            >=0.8.0.2  && <2.1.0
     , bytestring       >=0.10.4.0 && <0.12
     , file-embed-lzma  >=0        && <0.1
     , servant          >=0.14     && <0.20

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)
 import FileEmbedLzma
@@ -67,7 +66,7 @@ import Servant
 --
 -- See <https://github.com/jensoleg/swagger-ui>
 jensolegSwaggerSchemaUIServer
-    :: (Server api ~ Handler Value, ToJSON a)
+    :: (Server api ~ Handler a)
     => a -> Server (SwaggerSchemaUI' dir api)
 jensolegSwaggerSchemaUIServer =
     swaggerSchemaUIServerImpl jensolegIndexTemplate jensolegFiles

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
 

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.4.1.22.3
+version:            0.3.6.1.22.3
 synopsis:           Servant swagger ui: ReDoc theme
 category:           Web, Servant, Swagger
 description:
@@ -36,10 +36,9 @@ 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.17
-    , aeson            >=0.8.0.2  && <2.1.0
     , bytestring       >=0.10.4.0 && <0.12
     , file-embed-lzma  >=0        && <0.1
     , servant          >=0.14     && <0.20

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)
 import FileEmbedLzma
@@ -67,7 +66,7 @@ import Servant
 --
 -- See <https://github.com/Rebilly/ReDoc/tree/v1.x>
 redocSchemaUIServer
-    :: (Server api ~ Handler Value, ToJSON a)
+    :: (Server api ~ Handler a)
     => a -> Server (SwaggerSchemaUI' dir api)
 redocSchemaUIServer =
     swaggerSchemaUIServerImpl redocIndexTemplate redocFiles
@@ -80,7 +79,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

servant-swagger-ui/CHANGELOG.md

@@ -1,3 +1,19 @@
+- 0.3.6.4.5.0
+    - 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.3.47.1
     - Update to `swagger-ui-3.47.1`
     - Generalize `swaggerSchemaUIServer` to support arbitrary `Value` instead of hardcoded `Swagger`

servant-swagger-ui/servant-swagger-ui.cabal

@@ -1,6 +1,6 @@
 cabal-version:      1.12
 name:               servant-swagger-ui
-version:            0.3.5.4.5.0
+version:            0.3.6.4.5.0
 synopsis:           Servant swagger ui
 category:           Web, Servant, Swagger
 description:
@@ -46,10 +46,9 @@ 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.17
-    , aeson            >=0.8.0.2  && <2.1.0
     , bytestring       >=0.10.4.0 && <0.12
     , file-embed-lzma  >=0        && <0.1
     , servant          >=0.14     && <0.20

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)
 import FileEmbedLzma
@@ -75,7 +74,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
@@ -89,7 +88,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