{-# LANGUAGE CPP #-}
{-# 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,
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
#if MIN_VERSION_servant(0,7,0)
#else
#if MIN_VERSION_servant(0,5,0)
import Control.Monad.Trans.Except (ExceptT)
type Handler = ExceptT ServantErr IO
#else
import Control.Monad.Trans.Either (EitherT)
type Handler = EitherT ServantErr IO
#endif
#endif
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
#if MIN_VERSION_servant(0,14,0)
#define LINK Link ~ MkLink api Link
#define LINKPATH uriPath . linkURI
#elif MIN_VERSION_servant(0,10,0)
#define LINK Link ~ MkLink api
#define LINKPATH uriPath . linkURI
#else
#define LINK URI ~ MkLink api
#define LINKPATH uriPath
#endif
instance (KnownSymbol dir, HasLink api, LINK, IsElem api api)
=> ToMarkup (SwaggerUiHtml dir api)
where
toMarkup (SwaggerUiHtml template) = preEscapedToMarkup
$ T.replace "SERVANT_SWAGGER_UI_SCHEMA" schema
$ T.replace "SERVANT_SWAGGER_UI_DIR" dir
$ template
where
schema = T.pack $ LINKPATH $ safeLink proxyApi proxyApi
dir = T.pack $ symbolVal (Proxy :: Proxy dir)
proxyApi = Proxy :: Proxy api
swaggerSchemaUIServerImpl
:: (Server api ~ Handler Swagger)
=> T.Text -> [(FilePath, ByteString)]
-> Swagger -> Server (SwaggerSchemaUI' dir api)
swaggerSchemaUIServerImpl indexTemplate files swagger = return swagger
:<|> return (SwaggerUiHtml indexTemplate)
:<|> return (SwaggerUiHtml indexTemplate)
:<|> rest
where
rest =
#if MIN_VERSION_servant_server(0,11,0)
Tagged $
#endif
staticApp $ embeddedSettings files