servant-pandoc 0.4.1.4 → 0.5.0.0
raw patch · 4 files changed
+378/−153 lines, 4 filesdep +semigroupsdep ~servant-docsPVP ok
version bump matches the API change (PVP)
Dependencies added: semigroups
Dependency ranges changed: servant-docs
API changes (from Hackage documentation)
+ Servant.Docs.Pandoc: pandocWith :: RenderingOptions -> API -> Pandoc
Files
- CHANGELOG +39/−12
- README.md +69/−15
- servant-pandoc.cabal +6/−3
- src/Servant/Docs/Pandoc.hs +264/−123
CHANGELOG view
@@ -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
README.md view
@@ -1,27 +1,81 @@-There are two ways in which to use this module.+[](https://hackage.haskell.org/package/servant-pandoc) [](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+```
servant-pandoc.cabal view
@@ -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
src/Servant/Docs/Pandoc.hs view
@@ -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