diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,38 +1,65 @@ -- 0.4.1.4 +## 0.5.0.0 -- 2018-01-17 +This release has behavioural changes to match how servant-docs 0.11.1 +works (hence the major version bump). + +API Change: + +* Add `pandocWith` that takes in a `RenderOptions`. This allows for: + + - Selecting whether to show all or just one mime-type for requests + and responses. + + - Optionally group all Notes under a common header. + +Behavioural Changes: + +* Display notes, auth + +* Rationalise header depths + +* Document the HTTP method the parameters of an endpoint belong to + (rather than assuming `GET` for all of them). + +* Handle multiple content types for request/response bodies. + +* Add a grouping header for the Headers and endpoint is sensitive to. + +## 0.4.1.4 -- 2017-07-25 + Supports servant-docs 0.11. Changed behaviour means that this release can no longer support older versions. -New maintainer: Ivan Miljenovic - -- 0.4.1.3 +## 0.4.1.3 -- 2017-07-25 Updated dependencies for http-media, pandoc-types and servant-docs. -- 0.4.1.2 +New maintainer: Ivan Miljenovic +## 0.4.1.2 -- 2015-11-18 + Explicit import list for lens to hopefully avoid dependency problems. -- 0.4.1.1 +## 0.4.1.1 -- 201-07-26 Modify version bounds -- 0.4.1 +## 0.4.1 -- 2015-06-26 Put end points in canonical order. -- 0.4 +## 0.4.0 -- 2015-05-23 Update for servant 0.4 -- 0.1.0.2 +## 0.1.0.2 -- 2015-01-04 Fix breaking interface change from servant-docs 0.3 -- 0.1.0.1 +## 0.1.0.1 -- 2015-01-04 Fix trailing "," when rendering list of values -- 0.1 +## 0.1 -- 2015-01-04 -* Initial release +Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,27 +1,81 @@ -There are two ways in which to use this module. +[![Hackage](https://img.shields.io/hackage/v/servant-pandoc.svg)](https://hackage.haskell.org/package/servant-pandoc) [![Build Status](https://travis-ci.org/mpickering/servant-pandoc.svg)](https://travis-ci.org/mpickering/servant-pandoc) -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. +An extension to [servant-docs] that allows you to use [Pandoc] to +render your Servant API documentation. -``` - import Text.Pandoc import Servant.Docs.Pandoc import Servant.Docs - import Data.Default (def) +[servant-docs]: http://hackage.haskell.org/package/servant-docs +[Pandoc]: http://pandoc.org/ - myApi :: Proxy MyAPI myApi = Proxy +How to use this package +======================= - writeDocs :: API -\> IO () writeDocs api = writeFile "api.mw" - (writeMediaWiki def (pandoc api)) +Generate documentation directly +------------------------------- + +A very simple program to render the API documentation as a mediawiki +document might look as follows. + +```haskell +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 +Create a Pandoc filter +---------------------- + +The `makeFilter` function allows you 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 +append the API documentation to the end of the document. Example +usage: -``` +```haskell -- api.hs main :: IO () main = makeFilter (docs myApi) +``` -> pandoc -o api.pdf --filter=api.hs manual.md -```` +Then to run this: + +```sh +pandoc -o api.pdf --filter=api.hs manual.md +``` + +### Custom filters + +A more sophisticated filter might be to actually convert introduction +and note bodies to Markdown before processing (note: this is not +enabled by default as the `pandoc` library is GPL-licensed, whereas +this library uses `pandoc-types` which is BSD3-licensed): + +```haskell +import Data.Monoid (mconcat, (<>)) +import Servant.Docs.Pandoc (pandoc) +import Text.Pandoc (readMarkdown) +import Text.Pandoc.JSON (Block(Para, Plain), Inline(Str), Pandoc(Pandoc), + toJSONFilter) +import Text.Pandoc.Options (def) +import Text.Pandoc.Walk (walkM) + +main :: IO () +main = toJSONFilter append + where + append :: Pandoc -> Pandoc + append = (<> mconcat (walkM parseMarkdown (pandoc myApi))) + +parseMarkdown :: Block -> [Block] +parseMarkdown bl = case bl of + Para [Str str] -> toMarkdown str + Plain [Str str] -> toMarkdown str + _ -> [bl] + where + toMarkdown = either (const [bl]) unPandoc . readMarkdown def + + unPandoc (Pandoc _ bls) = bls +``` diff --git a/servant-pandoc.cabal b/servant-pandoc.cabal --- a/servant-pandoc.cabal +++ b/servant-pandoc.cabal @@ -1,12 +1,12 @@ name: servant-pandoc -version: 0.4.1.4 +version: 0.5.0.0 synopsis: Use Pandoc to render servant API documentation description: Use pandoc to generate documentation for your Servant API. license: MIT license-file: LICENSE author: Matthew Pickering, Ivan Miljenovic maintainer: Ivan.Miljenovic@gmail.com -category: Web +category: Web, Servant build-type: Simple extra-source-files: CHANGELOG, README.md @@ -27,12 +27,15 @@ , http-media >=0.6 && <0.8 , lens >=4.9 && <5 , pandoc-types >=1.12 && <1.18 - , servant-docs == 0.11.* + , servant-docs >= 0.11.1 && < 0.12 , unordered-containers >=0.2 && <0.3 , text >=1.2 && <1.3 , bytestring >=0.10 && <0.11 , string-conversions >= 0.1 && < 0.5 , case-insensitive >= 0.2 && < 1.3 + + if !impl(ghc >= 8.0) + build-depends: semigroups >= 0.17 && < 0.19 hs-source-dirs: src diff --git a/src/Servant/Docs/Pandoc.hs b/src/Servant/Docs/Pandoc.hs --- a/src/Servant/Docs/Pandoc.hs +++ b/src/Servant/Docs/Pandoc.hs @@ -2,10 +2,9 @@ ---------------------------------- -- | 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. +-- 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 @@ -28,26 +27,76 @@ -- > main = makeFilter (docs myApi) -- -- >> pandoc -o api.pdf --filter=api.hs manual.md -module Servant.Docs.Pandoc (pandoc, makeFilter) where +-- +-- A more sophisticated filter can be used to actually convert +-- introduction and note bodies into Markdown for pandoc to be able to +-- process: +-- +-- > import Data.Monoid (mconcat, (<>)) +-- > import Servant.Docs.Pandoc (pandoc) +-- > import Text.Pandoc (readMarkdown) +-- > import Text.Pandoc.JSON (Block(Para, Plain), Inline(Str), Pandoc(Pandoc), +-- > toJSONFilter) +-- > import Text.Pandoc.Options (def) +-- > import Text.Pandoc.Walk (walkM) +-- > +-- > main :: IO () +-- > main = toJSONFilter append +-- > where +-- > append :: Pandoc -> Pandoc +-- > append = (<> mconcat (walkM parseMarkdown (pandoc myApi))) +-- > +-- > parseMarkdown :: Block -> [Block] +-- > parseMarkdown bl = case bl of +-- > Para [Str str] -> toMarkdown str +-- > Plain [Str str] -> toMarkdown str +-- > _ -> [bl] +-- > where +-- > toMarkdown = either (const [bl]) unPandoc . readMarkdown def +-- > +-- > unPandoc (Pandoc _ bls) = bls +module Servant.Docs.Pandoc + ( pandoc + , pandocWith + , makeFilter + ) where -import Control.Lens ((^.)) +import Servant.Docs (API, Action, DocAuthentication, DocCapture, DocNote, + DocQueryParam, Endpoint, ParamKind(Flag, List), + RenderingOptions, Response, + ShowContentTypes(AllContentTypes, FirstContentType), + apiEndpoints, apiIntros, authDataRequired, authInfo, + authIntro, capDesc, capSymbol, captures, + defRenderingOptions, headers, introBody, introTitle, + method, noteBody, noteTitle, notes, notesHeading, + paramDesc, paramKind, paramName, paramValues, params, path, + requestExamples, respBody, respStatus, respTypes, response, + responseExamples, rqbody, rqtypes) + +import Control.Lens (mapped, view, (%~), (^.)) import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as B (unpack) +import qualified Data.ByteString.Lazy.Char8 as B import Data.CaseInsensitive (foldedCase) -import Data.Foldable (foldMap) +import Data.Foldable (fold, foldMap) import qualified Data.HashMap.Strict as HM -import Data.List (intercalate, sort) -import Data.Monoid (mconcat, mempty, (<>)) +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty((:|)), groupWith) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (isJust) +import Data.Monoid (mappend, mconcat, mempty, (<>)) import Data.String.Conversions (convertString) import Data.Text (Text, unpack) +import qualified Data.Text as T 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) +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. -- @@ -60,130 +109,222 @@ inject :: Pandoc -> Pandoc inject p = p <> pandoc api +-- | Define these values for consistency rather than magic numbers. +topLevel, endpointLevel, sectionLevel, subsectionLevel :: Int +topLevel = 1 +endpointLevel = topLevel + 1 +sectionLevel = endpointLevel + 1 +subsectionLevel = sectionLevel + 1 --- | Generate a `Pandoc` representation of a given +-- | Generate a 'Pandoc' representation of a given -- `API`. +-- +-- This is equivalent to @'pandocWith' 'defRenderingOptions'@. pandoc :: API -> Pandoc -pandoc api = B.doc $ intros <> mconcat endpoints +pandoc = pandocWith defRenderingOptions - 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) +-- | Generate a 'Pandoc' representation of a given API using the specified options. +-- +-- These options allow you to customise aspects such as: +-- +-- * Choose how many content-types for each request body example are +-- shown with 'requestExamples'. +-- +-- * Choose how many content-types for each response body example +-- are shown with 'responseExamples'. +-- +-- * Whether all 'notes' should be grouped together under a common +-- heading with 'notesHeading'. +-- +-- For example, to only show the first content-type of each example: +-- +-- @ +-- markdownWith ('defRenderingOptions' +-- & 'requestExamples' '.~' 'FirstContentType' +-- & 'responseExamples' '.~' 'FirstContentType' ) +-- myAPI +-- @ +-- +-- @since 0.5.0.0 +pandocWith :: RenderingOptions -> API -> Pandoc +pandocWith renderOpts api = B.doc $ intros <> mconcat endpoints + where + printEndpoint :: Endpoint -> Action -> Blocks + printEndpoint endpoint action = mconcat + [ B.header endpointLevel hdrStr + , notesStr (action ^. notes) + , authStr (action ^. authInfo) + , capturesStr (action ^. captures) + , headersStr (action ^. headers) + , paramsStr (action ^. params) + , rqbodyStrs (action ^. rqtypes) (action ^. rqbody) + , responseStr (action ^. response) + ] + where + hdrStr :: Inlines + hdrStr = mconcat [ B.str (convertString (endpoint ^. method)) + , B.space + , B.code (showPath (endpoint ^. path)) + ] - 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 topLevel (B.str $ i ^. introTitle) <> + paraStr (i ^. introBody) + endpoints = map (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints - 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 + notesStr :: [DocNote] -> Blocks + notesStr = addHeading . foldMap noteStr + where + addHeading = maybe id (mappend . B.header sectionLevel . B.str) (renderOpts ^. notesHeading) - 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) + noteStr :: DocNote -> Blocks + noteStr nt = B.header lvl (B.text (nt ^. noteTitle)) <> paraStr (nt ^. noteBody) + where + lvl = if isJust (renderOpts ^. notesHeading) + then subsectionLevel + else sectionLevel - headersStr :: [Text] -> Blocks - headersStr [] = mempty - headersStr l = B.bulletList (map (B.para . headerStr) l) + authStr :: [DocAuthentication] -> Blocks + authStr [] = mempty + authStr auths = mconcat + [ B.header sectionLevel "Authentication" + , paraStr (mapped %~ view authIntro $ auths) + , B.para "Clients must supply the following data" + , B.bulletList (map (B.plain . B.str) (mapped %~ view authDataRequired $ auths)) + ] - where headerStr hname = "This endpoint is sensitive to the value of the" <> B.space <> - (B.strong . B.str $ unpack hname) <> B.space <> "HTTP header." + capturesStr :: [DocCapture] -> Blocks + capturesStr [] = mempty + capturesStr l = + B.header sectionLevel "Captures" <> + B.bulletList (map captureStr l) - paramsStr :: [DocQueryParam] -> Blocks - paramsStr [] = mempty - paramsStr l = - B.header 2 "GET Parameters" <> - B.bulletList (map paramStr l) + captureStr cap = + B.plain $ B.emph (B.str $ cap ^. capSymbol) <> ":" <> B.space <> B.text (cap ^. capDesc) - 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] - ) + headersStr :: [Text] -> Blocks + headersStr [] = mempty + headersStr l = B.header sectionLevel "Headers" <> 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." - where values = param ^. paramValues + paramsStr :: [DocQueryParam] -> Blocks + paramsStr [] = mempty + paramsStr l = + B.header sectionLevel "Query Parameters" <> + B.bulletList (map paramStr l) - rqbodyStrs :: [MediaType] -> [(Text, MediaType, ByteString)] -> Blocks - rqbodyStrs [] [] = mempty - rqbodyStrs types bs = - B.header 2 "Request Body" <> - formatTypes types <> - B.bulletList (map bodyStr bs) + paramStr :: DocQueryParam -> Blocks + paramStr param = + B.plain (B.str (param ^. paramName)) <> + B.definitionList ( + [(B.strong "Values", + [B.plain (B.emph + (foldr1 (\a b -> a <> "," <> 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 query 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" <> + ". This means no value is expected to be associated to this parameter." + | param ^. paramKind == Flag] + ) + where + values = param ^. paramValues - formatTypes [] = mempty - formatTypes ts = B.bulletList - [ B.plain "Supported content types are:" - , B.bulletList (map (B.plain . B.code . show) ts) - ] + rqbodyStrs :: [MediaType] -> [(Text, MediaType, ByteString)] -> Blocks + rqbodyStrs [] [] = mempty + rqbodyStrs types bs = + B.header sectionLevel "Request Body" <> + B.bulletList (formatTypes types : formatBodies (renderOpts ^. requestExamples) bs) - 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 - ] + formatTypes [] = mempty + formatTypes ts = mconcat + [ B.plain "Supported content types are:" + , B.bulletList (map (B.plain . B.code . show) ts) + ] - codeStr :: MediaType -> ByteString -> Blocks - codeStr media b = - B.codeBlockWith ("",[markdownForType media],[]) (B.unpack b) + -- This assumes that when the bodies are created, identical + -- labels and representations are located next to each other. + formatBodies :: ShowContentTypes -> [(Text, M.MediaType, ByteString)] -> [Blocks] + formatBodies ex bds = map formatBody (select bodyGroups) + where + bodyGroups :: [(Text, NonEmpty M.MediaType, ByteString)] + bodyGroups = + map (\grps -> let (t,_,b) = NE.head grps in (t, fmap (\(_,m,_) -> m) grps, b)) + . groupWith (\(t,_,b) -> (t,b)) + $ bds - 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] + select = case ex of + AllContentTypes -> id + FirstContentType -> map (\(t,ms,b) -> (t, NE.head ms :| [], b)) - -- 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 + formatBody :: (Text, NonEmpty M.MediaType, ByteString) -> Blocks + formatBody (t, medias, b) = mconcat + [ B.para . mconcat $ + [ title + , " (" + , mediaList medias + , "): " + ] + , codeStr media b + ] + where + mediaList = fold . NE.intersperse ", " . fmap (B.code . show) + + media = NE.head medias + + title + | T.null t = "Example" + | otherwise = B.text (convertString t) + + codeStr :: MediaType -> ByteString -> Blocks + codeStr media b = + B.codeBlockWith ("",[markdownForType media],[]) (B.unpack b) + + responseStr :: Response -> Blocks + responseStr resp = + B.header sectionLevel "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 -> formatBodies (renderOpts ^. responseExamples) xs) + + -- 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 mt = + case M.subType mt of + "x-www-form-urlencoded" -> "html" + t -> convertString (foldedCase t) + +paraStr :: [String] -> Blocks +paraStr = foldMap (B.para . B.str) + +-- Duplicate of Servant.Docs.Internal +showPath :: [String] -> String +showPath [] = "/" +showPath ps = concatMap ('/':) ps