{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Swagger.UI.Core (
SwaggerSchemaUI,
SwaggerSchemaUI',
SwaggerUiHtml(..),
swaggerSchemaUIServerImpl,
swaggerSchemaUIServerImpl',
Handler,
) where
import Data.ByteString (ByteString)
import Data.Swagger (Swagger)
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 qualified Data.Text as T
type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) =
SwaggerSchemaUI' dir (schema :> Get '[JSON] Swagger)
type SwaggerSchemaUI' (dir :: Symbol) (api :: *) =
api
:<|> dir :>
( Get '[HTML] (SwaggerUiHtml dir api)
:<|> "index.html" :> Get '[HTML] (SwaggerUiHtml dir api)
:<|> Raw
)
data SwaggerUiHtml (dir :: Symbol) (api :: *) = SwaggerUiHtml T.Text
instance (KnownSymbol dir, HasLink api, Link ~ MkLink api Link, IsElem api api)
=> ToMarkup (SwaggerUiHtml dir api)
where
toMarkup :: SwaggerUiHtml dir api -> Markup
toMarkup (SwaggerUiHtml Text
template) = Text -> Markup
forall a. ToMarkup a => a -> Markup
preEscapedToMarkup
(Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"SERVANT_SWAGGER_UI_SCHEMA" Text
schema
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"SERVANT_SWAGGER_UI_DIR" Text
dir
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
template
where
schema :: Text
schema = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath (URI -> String) -> (Link -> URI) -> Link -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> URI
linkURI (Link -> String) -> Link -> String
forall a b. (a -> b) -> a -> b
$ Proxy api -> Proxy api -> MkLink api Link
forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink Proxy api
proxyApi Proxy api
proxyApi
dir :: Text
dir = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy dir -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy dir
forall k (t :: k). Proxy t
Proxy :: Proxy dir)
proxyApi :: Proxy api
proxyApi = Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api
swaggerSchemaUIServerImpl
:: (Monad m, ServerT api m ~ m Swagger)
=> T.Text -> [(FilePath, ByteString)]
-> Swagger -> ServerT (SwaggerSchemaUI' dir api) m
swaggerSchemaUIServerImpl :: Text
-> [(String, ByteString)]
-> Swagger
-> ServerT (SwaggerSchemaUI' dir api) m
swaggerSchemaUIServerImpl Text
indexTemplate [(String, ByteString)]
files Swagger
swagger
= Text
-> [(String, ByteString)]
-> ServerT api m
-> ServerT (SwaggerSchemaUI' dir api) m
forall (m :: * -> *) api (dir :: Symbol).
Monad m =>
Text
-> [(String, ByteString)]
-> ServerT api m
-> ServerT (SwaggerSchemaUI' dir api) m
swaggerSchemaUIServerImpl' Text
indexTemplate [(String, ByteString)]
files (ServerT api m -> ServerT (SwaggerSchemaUI' dir api) m)
-> ServerT api m -> ServerT (SwaggerSchemaUI' dir api) m
forall a b. (a -> b) -> a -> b
$ Swagger -> m Swagger
forall (m :: * -> *) a. Monad m => a -> m a
return Swagger
swagger
swaggerSchemaUIServerImpl'
:: Monad m
=> T.Text
-> [(FilePath, ByteString)]
-> ServerT api m
-> ServerT (SwaggerSchemaUI' dir api) m
swaggerSchemaUIServerImpl' :: Text
-> [(String, ByteString)]
-> ServerT api m
-> ServerT (SwaggerSchemaUI' dir api) m
swaggerSchemaUIServerImpl' Text
indexTemplate [(String, ByteString)]
files ServerT api m
server
= ServerT api m
server
ServerT api m
-> (m (SwaggerUiHtml dir api)
:<|> (m (SwaggerUiHtml dir api) :<|> Tagged m Application))
-> ServerT api m
:<|> (m (SwaggerUiHtml dir api)
:<|> (m (SwaggerUiHtml dir api) :<|> Tagged m Application))
forall a b. a -> b -> a :<|> b
:<|> SwaggerUiHtml dir api -> m (SwaggerUiHtml dir api)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> SwaggerUiHtml dir api
forall (dir :: Symbol) api. Text -> SwaggerUiHtml dir api
SwaggerUiHtml Text
indexTemplate)
m (SwaggerUiHtml dir api)
-> (m (SwaggerUiHtml dir api) :<|> Tagged m Application)
-> m (SwaggerUiHtml dir api)
:<|> (m (SwaggerUiHtml dir api) :<|> Tagged m Application)
forall a b. a -> b -> a :<|> b
:<|> SwaggerUiHtml dir api -> m (SwaggerUiHtml dir api)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> SwaggerUiHtml dir api
forall (dir :: Symbol) api. Text -> SwaggerUiHtml dir api
SwaggerUiHtml Text
indexTemplate)
m (SwaggerUiHtml dir api)
-> Tagged m Application
-> m (SwaggerUiHtml dir api) :<|> Tagged m Application
forall a b. a -> b -> a :<|> b
:<|> Tagged m Application
rest
where
rest :: Tagged m Application
rest = Application -> Tagged m Application
forall k (s :: k) b. b -> Tagged s b
Tagged (Application -> Tagged m Application)
-> Application -> Tagged m Application
forall a b. (a -> b) -> a -> b
$ StaticSettings -> Application
staticApp (StaticSettings -> Application) -> StaticSettings -> Application
forall a b. (a -> b) -> a -> b
$ [(String, ByteString)] -> StaticSettings
embeddedSettings [(String, ByteString)]
files