module Servant.Docs.Pandoc (pandoc, makeFilter) where
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder (Blocks, Inlines)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.JSON (toJSONFilter)
import Servant.Docs
import qualified Data.HashMap.Strict as HM
import Data.Text (Text, unpack)
import Data.List (intercalate)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B (unpack)
makeFilter :: API -> IO ()
makeFilter api = toJSONFilter inject
where
inject :: Pandoc -> Pandoc
inject p = p <> pandoc api
pandoc :: API -> Pandoc
pandoc = B.doc . mconcat . map (uncurry printEndpoint) . HM.toList
where printEndpoint :: Endpoint -> Action -> Blocks
printEndpoint endpoint action =
B.header 1 str <>
capturesStr (action ^. captures) <>
headersStr (action ^. headers) <>
paramsStr (action ^. params) <>
rqbodyStr (action ^. rqbody) <>
responseStr (action ^. response)
where str :: Inlines
str = B.str (show (endpoint^.method)) <> B.space <> B.code (intercalate "/" (endpoint ^. path))
capturesStr :: [DocCapture] -> Blocks
capturesStr [] = mempty
capturesStr l =
B.header 2 "Captures" <>
B.bulletList (map captureStr l)
captureStr cap =
B.plain $ B.emph (B.doubleQuoted . B.str$ (cap ^. capSymbol)) <> ":" <> B.space <> B.str (cap ^. capDesc)
headersStr :: [Text] -> Blocks
headersStr [] = mempty
headersStr l = B.bulletList (map (B.para . headerStr) l)
where headerStr hname = "This endpoint is sensitive to the value of the" <> B.space <>
(B.strong . B.str $ unpack hname) <> B.space <> "HTTP header."
paramsStr :: [DocQueryParam] -> Blocks
paramsStr [] = mempty
paramsStr l =
B.header 2 "GET Parameters" <>
B.bulletList (map paramStr l)
paramStr param =
B.plain (B.str (param ^. paramName)) <>
B.definitionList (
[(B.strong "Values",
[B.plain (B.emph
(foldr1 (\a b -> a <> B.str "," <> B.space <> b) (map B.str values)))])
| not (null values) || param ^. paramKind /= Flag]
++
[(B.strong "Description",
[B.plain $ B.str (param ^. paramDesc)])])
<>
B.bulletList (
[B.plain $ "This parameter is a" <>
B.space <>
B.strong "list" <>
". All GET parameters with the name" <>
B.space <>
B.str (param ^. paramName) <>
B.space <>
B.code "[]" <> B.space <>
"will forward their values in a list to the handler."
| param ^. paramKind == List]
++
[B.plain $ "This parameter is a" <>
B.space <>
B.strong "flag." <>
B.space <>
"This means no value is expected to be associated to this parameter."
| param ^. paramKind == Flag]
)
where values = param ^. paramValues
rqbodyStr :: Maybe ByteString -> Blocks
rqbodyStr Nothing = mempty
rqbodyStr (Just b) =
B.header 2 "Request Body" <>
jsonStr b
jsonStr :: ByteString -> Blocks
jsonStr b =
B.codeBlockWith ("",["javascript"],[]) (B.unpack b)
responseStr :: Response -> Blocks
responseStr resp =
B.header 2 "Response" <>
B.bulletList (
[B.plain $ "Status code" <> B.space <> (B.str . show) (resp ^. respStatus)]
++
(resp ^. respBody &
maybe [B.plain "No response body"]
(\b -> [B.plain "Response body as below." <> jsonStr b])))