Add support for ReDoc alternative UI

KtorZ · phadej · commit b48cc5f2eb3c · 2018-04-05T11:11:18.000+03:00
diff --git a/example/Main.hs b/example/Main.hs
@@ -165,6 +165,7 @@ data Variant
 data UIFlavour
     = Original
     | JensOleG
+    | ReDoc
     deriving (Eq)
 
 server' :: UIFlavour -> Server API'
@@ -187,6 +188,7 @@ server' uiFlavour = server Normal
     schemaUiServer = case uiFlavour of
         Original -> swaggerSchemaUIServer
         JensOleG -> jensolegSwaggerSchemaUIServer
+        ReDoc    -> redocSchemaUIServer
 
     swaggerDoc' Normal    = swaggerDoc
     swaggerDoc' Nested    = swaggerDoc
@@ -212,7 +214,9 @@ app = serve api . server'
 main :: IO ()
 main = do
     args <- getArgs
-    let uiFlavour = if "jensoleg" `elem` args then JensOleG else Original
+    let uiFlavour | "jensoleg" `elem` args = JensOleG
+                  | "redoc"    `elem` args = ReDoc
+                  | otherwise              = Original
     case args of
         ("run":_) -> do
             p <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
diff --git a/redoc-dist/redoc.min.js b/redoc-dist/redoc.min.js
diff --git a/redoc.index.html.tmpl b/redoc.index.html.tmpl
@@ -0,0 +1,15 @@
+<!doctype html>
+<html lang="en">
+  <head>
+    <title>ReDoc</title>
+    <meta charset="utf-8"/>
+    <meta name="viewport" content="width=device-width, initial-scale=1">
+    <style>
+      body { margin: 0; padding: 0; }
+    </style>
+  </head>
+  <body>
+    <redoc spec-url='/SERVANT_SWAGGER_UI_SCHEMA'></redoc>
+    <script src="redoc.min.js"> </script>
+  </body>
+</html>
diff --git a/src/Servant/Swagger/UI.hs b/src/Servant/Swagger/UI.hs
@@ -47,6 +47,8 @@ module Servant.Swagger.UI (
     SwaggerSchemaUI',
     swaggerSchemaUIServer,
     jensolegSwaggerSchemaUIServer,
+    redocSchemaUIServer,
+
     -- * Internals
     --
     -- /Note:/ in next major version, these will be moved to separate module.
@@ -60,6 +62,11 @@ module Servant.Swagger.UI (
     -- Current version: @79f3bba07b070cfab1d8c245c4f9229052e20a1a@
     jensolegIndexTemplate,
     jensolegFiles,
+    -- ** ReDoc theme
+    --
+    -- Current Version: v1.21.2 https://rebilly.github.io/ReDoc/releases/v1.21.2/redoc.min.js
+    redocIndexTemplate,
+    redocFiles
     ) where
 
 import Data.ByteString                (ByteString)
@@ -158,6 +165,15 @@ jensolegSwaggerSchemaUIServer
 jensolegSwaggerSchemaUIServer =
     swaggerSchemaUIServerImpl jensolegIndexTemplate jensolegFiles
 
+-- | Serve alternative Swagger UI.
+--
+-- See <https://github.com/Rebilly/ReDoc/tree/v1.x>
+redocSchemaUIServer
+    :: (Server api ~ Handler Swagger)
+    => Swagger -> Server (SwaggerSchemaUI' dir api)
+redocSchemaUIServer =
+    swaggerSchemaUIServerImpl redocIndexTemplate redocFiles
+
 swaggerSchemaUIServerImpl
     :: (Server api ~ Handler Swagger)
     => T.Text -> [(FilePath, ByteString)]
@@ -184,3 +200,9 @@ jensolegIndexTemplate = $(embedStringFile "jensoleg.index.html.tmpl")
 
 jensolegFiles :: [(FilePath, ByteString)]
 jensolegFiles = $(mkRecursiveEmbedded "jensoleg-dist")
+
+redocIndexTemplate :: T.Text
+redocIndexTemplate = $(embedStringFile "redoc.index.html.tmpl")
+
+redocFiles :: [(FilePath, ByteString)]
+redocFiles = $(mkRecursiveEmbedded "redoc-dist")
