servant-pandoc-0.4.1.4: src/Servant/Docs/Pandoc.hs
{-# LANGUAGE OverloadedStrings #-}
----------------------------------
-- | There are two ways in which to use this module.
--
-- The first is to use the renderer directly with the pandoc API.
-- A very simple
-- program to render the API documentation as a mediawiki document might look as
-- follows.
--
-- > import Text.Pandoc
-- > import Servant.Docs.Pandoc
-- > import Servant.Docs
-- > import Data.Default (def)
-- >
-- > myApi :: Proxy MyAPI
-- > myApi = Proxy
-- >
-- > writeDocs :: API -> IO ()
-- > writeDocs api = writeFile "api.mw" (writeMediaWiki def (pandoc api))
--
-- The second approach is to use `makeFilter` to make a filter which can be
-- used directly with pandoc from the command line. This filter will just
-- append the API documentation to the end of the document.
-- Example usage
--
-- > -- api.hs
-- > main :: IO ()
-- > main = makeFilter (docs myApi)
--
-- >> pandoc -o api.pdf --filter=api.hs manual.md
module Servant.Docs.Pandoc (pandoc, makeFilter) where
import Control.Lens ((^.))
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B (unpack)
import Data.CaseInsensitive (foldedCase)
import Data.Foldable (foldMap)
import qualified Data.HashMap.Strict as HM
import Data.List (intercalate, sort)
import Data.Monoid (mconcat, mempty, (<>))
import Data.String.Conversions (convertString)
import Data.Text (Text, unpack)
import Network.HTTP.Media (MediaType)
import qualified Network.HTTP.Media as M
import Servant.Docs
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.JSON (toJSONFilter)
-- | Helper function which can be used to make a pandoc filter which
-- appends the generate docs to the end of the document.
--
-- This function is exposed for convenience. More experienced authors can
-- of course define a more complicated filter to inject the API
-- documentation.
makeFilter :: API -> IO ()
makeFilter api = toJSONFilter inject
where
inject :: Pandoc -> Pandoc
inject p = p <> pandoc api
-- | Generate a `Pandoc` representation of a given
-- `API`.
pandoc :: API -> Pandoc
pandoc api = B.doc $ intros <> mconcat endpoints
where printEndpoint :: Endpoint -> Action -> Blocks
printEndpoint endpoint action =
B.header 1 str <>
capturesStr (action ^. captures) <>
headersStr (action ^. headers) <>
paramsStr (action ^. params) <>
rqbodyStrs (action ^. rqtypes) (action ^. rqbody) <>
responseStr (action ^. response)
where str :: Inlines
str = B.str (show (endpoint^.method)) <> B.space <> B.code ("/" ++ intercalate "/" (endpoint ^. path))
intros = if null (api ^. apiIntros) then mempty else intros'
intros' = foldMap printIntro (api ^. apiIntros)
printIntro i =
B.header 1 (B.str $ i ^. introTitle) <>
foldMap (B.para . B.str) (i ^. introBody)
endpoints = map (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints
capturesStr :: [DocCapture] -> Blocks
capturesStr [] = mempty
capturesStr l =
B.header 2 "Captures" <>
B.bulletList (map captureStr l)
captureStr cap =
B.plain $ B.emph (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
rqbodyStrs :: [MediaType] -> [(Text, MediaType, ByteString)] -> Blocks
rqbodyStrs [] [] = mempty
rqbodyStrs types bs =
B.header 2 "Request Body" <>
formatTypes types <>
B.bulletList (map bodyStr bs)
formatTypes [] = mempty
formatTypes ts = B.bulletList
[ B.plain "Supported content types are:"
, B.bulletList (map (B.plain . B.code . show) ts)
]
bodyStr :: (Text, MediaType, ByteString) -> Blocks
bodyStr (t, media, bs) = mconcat
[ B.plain . mconcat $
[ "Example ("
, B.text (convertString t)
, "): "
, B.code (show media)
]
, codeStr media bs
]
codeStr :: MediaType -> ByteString -> Blocks
codeStr media b =
B.codeBlockWith ("",[markdownForType media],[]) (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)) :
formatTypes (resp ^. respTypes) :
case resp ^. respBody of
[] -> [B.plain "No response body"]
[("", t, r)] -> [B.plain "Response body as below.", codeStr t r]
xs -> concatMap renderResponse xs)
where
renderResponse :: (Text, MediaType, ByteString) -> [Blocks]
renderResponse (ctx, t, r) = [B.plain (B.str (convertString ctx)), codeStr t r]
-- Pandoc has a wide range of syntax highlighting available,
-- many (all?) of which seem to correspond to the sub-type of
-- their corresponding media type.
markdownForType :: MediaType -> String
markdownForType = convertString . foldedCase . M.subType