{-# LANGUAGE QuasiQuotes #-}
module WebGear.Swagger.UI (
swaggerUI,
) where
import Control.Arrow ((<+>))
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Network.HTTP.Types as HTTP
import Network.Wai.Application.Static (embeddedSettings)
import WebGear.Core (
Body,
HTML (..),
JSON (..),
RequestHandler,
RequiredResponseHeader,
Response (..),
Sets,
StdHandler,
UnknownContentBody,
match,
method,
pathEnd,
respondA,
route,
serveStatic,
)
import qualified WebGear.Swagger.UI.Embedded as Embedded
swaggerUI ::
( StdHandler h m
, Sets
h
[ RequiredResponseHeader "Content-Type" Text
, Body HTML ByteString
, Body JSON apiSpec
, UnknownContentBody
]
Response
) =>
apiSpec ->
RequestHandler h ts
swaggerUI :: forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString,
Body JSON apiSpec, UnknownContentBody]
Response) =>
apiSpec -> RequestHandler h ts
swaggerUI apiSpec
apiSpec =
RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
rootEndpoint
RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
indexHtml
RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> apiSpec -> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec]
Response) =>
apiSpec -> RequestHandler h ts
swaggerJson apiSpec
apiSpec
RequestHandler h ts -> RequestHandler h ts -> RequestHandler h ts
forall b c. h b c -> h b c -> h b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> RequestHandler h ts
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
StdHandler h m =>
RequestHandler h ts
uiAssets
rootEndpoint ::
( StdHandler h m
, Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
) =>
RequestHandler h ts
rootEndpoint :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
rootEndpoint = StdMethod -> Middleware h ts (Method : ts)
forall (h :: * -> * -> *) (ts :: [*]).
(Get h Method Request, ArrowChoice h,
ArrowError RouteMismatch h) =>
StdMethod -> Middleware h ts (Method : ts)
method StdMethod
HTTP.GET Middleware h ts (Method : ts) -> Middleware h ts (Method : ts)
forall a b. (a -> b) -> a -> b
$ Middleware h (Method : ts) (PathEnd : Method : ts)
forall (h :: * -> * -> *) (ts :: [*]).
(Get h PathEnd Request, ArrowChoice h,
ArrowError RouteMismatch h) =>
Middleware h ts (PathEnd : ts)
pathEnd RequestHandler h (PathEnd : Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
serveIndexHtml
indexHtml ::
( StdHandler h m
, Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
) =>
RequestHandler h ts
indexHtml :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
indexHtml = [route| HTTP.GET /index.html |] RequestHandler h (PathEnd : Path : Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
serveIndexHtml
serveIndexHtml ::
( StdHandler h m
, Sets h [RequiredResponseHeader "Content-Type" Text, Body HTML ByteString] Response
) =>
RequestHandler h ts
serveIndexHtml :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body HTML ByteString]
Response) =>
RequestHandler h ts
serveIndexHtml = proc With Request ts
_request ->
Status -> HTML -> h ByteString Response
forall body mt (h :: * -> * -> *) (m :: * -> *).
(Handler h m,
Sets
h
'[Status, Body mt body, RequiredResponseHeader "Content-Type" Text]
Response,
MIMEType mt) =>
Status -> mt -> h body Response
respondA Status
HTTP.ok200 HTML
HTML -< ByteString
Embedded.indexHtmlFile
swaggerJson ::
( StdHandler h m
, Sets h [RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec] Response
) =>
apiSpec ->
RequestHandler h ts
swaggerJson :: forall (h :: * -> * -> *) (m :: * -> *) apiSpec (ts :: [*]).
(StdHandler h m,
Sets
h
'[RequiredResponseHeader "Content-Type" Text, Body JSON apiSpec]
Response) =>
apiSpec -> RequestHandler h ts
swaggerJson apiSpec
apiSpec =
[route| HTTP.GET /swagger.json |] (RequestHandler h (PathEnd : Path : Method : ts)
-> RequestHandler h ts)
-> RequestHandler h (PathEnd : Path : Method : ts)
-> RequestHandler h ts
forall a b. (a -> b) -> a -> b
$
proc With Request (PathEnd : Path : Method : ts)
_request -> Status -> JSON -> h apiSpec Response
forall body mt (h :: * -> * -> *) (m :: * -> *).
(Handler h m,
Sets
h
'[Status, Body mt body, RequiredResponseHeader "Content-Type" Text]
Response,
MIMEType mt) =>
Status -> mt -> h body Response
respondA Status
HTTP.ok200 JSON
JSON -< apiSpec
apiSpec
uiAssets :: (StdHandler h m) => RequestHandler h ts
uiAssets :: forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
StdHandler h m =>
RequestHandler h ts
uiAssets =
[match| HTTP.GET / |] Middleware h ts (Method : ts) -> Middleware h ts (Method : ts)
forall a b. (a -> b) -> a -> b
$
StaticSettings -> RequestHandler h (Method : ts)
forall (h :: * -> * -> *) (m :: * -> *) (ts :: [*]).
Handler h m =>
StaticSettings -> RequestHandler h ts
serveStatic ([(String, ByteString)] -> StaticSettings
embeddedSettings [(String, ByteString)]
Embedded.uiAssetsDir)