servant-pandoc 0.1.0.2 → 0.4.0
raw patch · 2 files changed
+49/−19 lines, 2 filesdep +http-mediadep +lensdep +semigroupoidsdep ~basedep ~servant-docsPVP ok
version bump matches the API change (PVP)
Dependencies added: http-media, lens, semigroupoids
Dependency ranges changed: base, servant-docs
API changes (from Hackage documentation)
Files
- servant-pandoc.cabal +17/−4
- src/Servant/Docs/Pandoc.hs +32/−15
servant-pandoc.cabal view
@@ -10,13 +10,13 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.2+version: 0.4.0 -- A short (one-line) description of the package. synopsis: Use Pandoc to render servant API documentation -- A longer description of the package.--- description:+description: See <https://github.com/mpickering/servant-pandoc/blob/master/README.md README>. -- The license under which the package is released. license: MIT@@ -45,6 +45,9 @@ -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 +source-repository head+ type: git+ location: https://github.com/mpickering/servant-pandoc/ library -- Modules exported by the library.@@ -57,12 +60,22 @@ other-extensions: OverloadedStrings -- Other library packages from which modules are imported.- build-depends: base >=4.7 && <4.8, pandoc-types >=1.12 && <1.13, servant-docs >=0.3 && <0.4, unordered-containers >=0.2 && <0.3, text >=1.2 && <1.3, bytestring >=0.10 && <0.11+ build-depends: base >=4.7 && <5+ , http-media >=0.6 && <0.7+ , lens >=4.9 && <4.10+ , pandoc-types >=1.12 && <1.13+ , servant-docs >=0.4 && <0.5+ , unordered-containers >=0.2 && <0.3+ , text >=1.2 && <1.3+ , bytestring >=0.10 && <0.11 + -- temporary workaround+ -- (see https://github.com/mpickering/servant-pandoc/issues/2 for details)+ , semigroupoids <4.5+ -- Directories containing source files. hs-source-dirs: src -- Base language which the package is written in. default-language: Haskell2010 ghc-options: -Wall-
src/Servant/Docs/Pandoc.hs view
@@ -35,11 +35,15 @@ import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.JSON (toJSONFilter) import Servant.Docs+import Network.HTTP.Media (MediaType) import qualified Data.HashMap.Strict as HM import Data.Text (Text, unpack)+import Data.Monoid ((<>), mempty, mconcat) import Data.List (intercalate)+import Data.Foldable (foldMap) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as B (unpack)+import Control.Lens -- | Helper function which can be used to make a pandoc filter which@@ -58,7 +62,7 @@ -- | Generate a `Pandoc` representation of a given -- `API`. pandoc :: API -> Pandoc-pandoc = B.doc . mconcat . map (uncurry printEndpoint) . HM.toList+pandoc api = B.doc $ intros <> mconcat endpoints where printEndpoint :: Endpoint -> Action -> Blocks printEndpoint endpoint action =@@ -66,19 +70,26 @@ capturesStr (action ^. captures) <> headersStr (action ^. headers) <> paramsStr (action ^. params) <>- rqbodyStr (action ^. rqbody) <>+ rqbodyStrs (action ^. rqbody) <> responseStr (action ^. response) where str :: Inlines- str = B.str (show (endpoint^.method)) <> B.space <> B.code (intercalate "/" (endpoint ^. path))+ 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) . 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.doubleQuoted . B.str$ (cap ^. capSymbol)) <> ":" <> B.space <> B.str (cap ^. capDesc)+ B.plain $ B.emph (B.str $ cap ^. capSymbol) <> ":" <> B.space <> B.str (cap ^. capDesc) headersStr :: [Text] -> Blocks headersStr [] = mempty@@ -127,16 +138,22 @@ where values = param ^. paramValues - rqbodyStr :: Maybe ByteString -> Blocks- rqbodyStr Nothing = mempty- rqbodyStr (Just b) =+ rqbodyStrs :: [(MediaType, ByteString)] -> Blocks+ rqbodyStrs [] = mempty+ rqbodyStrs bs = B.header 2 "Request Body" <>- jsonStr b+ foldMap bodyStr bs - jsonStr :: ByteString -> Blocks- jsonStr b =- B.codeBlockWith ("",["javascript"],[]) (B.unpack b)+ bodyStr :: (MediaType, ByteString) -> Blocks+ bodyStr (media, bs) = case show media of+ "text/html" -> codeStr "html" bs+ "application/json" -> codeStr "javascript" bs+ _ -> codeStr "text" bs + codeStr :: String -> ByteString -> Blocks+ codeStr lang b =+ B.codeBlockWith ("",[lang],[]) (B.unpack b)+ responseStr :: Response -> Blocks responseStr resp = B.header 2 "Response" <>@@ -147,8 +164,8 @@ [] -> [B.plain "No response body"] xs -> map renderResponse xs) where- renderResponse ("", r) =- B.plain "Response body at below" <> jsonStr r- renderResponse (ctx, r) =- B.plain (B.str . unpack $ ctx) <> jsonStr r+ renderResponse ("", media, r) =+ B.plain (B.str $ "Response body (" <> show media <> ")") <> bodyStr (media, r)+ renderResponse (ctx, media, r) =+ B.plain (B.str $ unpack ctx <> " (" <> show media <> ")") <> bodyStr (media, r)