servant-docs 0.11 → 0.11.1
raw patch · 5 files changed
+207/−47 lines, 5 filesdep ~semigroupsdep ~servant
Dependency ranges changed: semigroups, servant
Files
- CHANGELOG.md +17/−0
- servant-docs.cabal +12/−6
- src/Servant/Docs.hs +5/−1
- src/Servant/Docs/Internal.hs +166/−40
- test/Servant/DocsSpec.hs +7/−0
CHANGELOG.md view
@@ -1,3 +1,20 @@+[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)+[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)++0.11.1+------++* Export `DocAuthentication` and related lenses.+* Make `defAction`'s documentation visible in Haddock documentation.+* Add a markdown header for the Headers an endpoint is sensitive to.+* Document the HTTP Method the parameters of an endpoint belong to+ (rather than assuming `GET` for all of them).+* Content type of sample response body is also displayed.+* Can now customise various aspects of how the document is produced+ using `markdownWith` and `RenderingOptions`:+ - How many content-types for each example are shown+ - Whether notes should be grouped together under their own header.+ 0.11 ----
servant-docs.cabal view
@@ -1,10 +1,10 @@ name: servant-docs-version: 0.11+version: 0.11.1 synopsis: generate API docs for your servant webservice description: Library for generating API docs from a servant API definition. .- Runnable example <https://github.com/haskell-servant/servant-docs/blob/master/example/greet.hs here>.+ Runnable example <https://github.com/haskell-servant/servant/blob/master/servant-docs/example/greet.hs here>. . <https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md CHANGELOG> license: BSD3@@ -12,10 +12,14 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors-category: Servant Web+category: Servant, Web build-type: Simple cabal-version: >=1.10-tested-with: GHC >= 7.8+tested-with:+ GHC==7.8.4+ GHC==7.10.3+ GHC==8.0.2+ GHC==8.2.1 homepage: http://haskell-servant.readthedocs.org/ Bug-reports: http://github.com/haskell-servant/servant/issues extra-source-files:@@ -42,14 +46,14 @@ , http-media >= 0.6 , http-types >= 0.7 , lens- , servant == 0.11.*+ , servant == 0.12.* , string-conversions , text , unordered-containers , control-monad-omega == 0.3.* if !impl(ghc >= 8.0) build-depends:- semigroups >=0.16.2.2 && <0.19+ semigroups >=0.17 && <0.19 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -75,6 +79,8 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Servant.DocsSpec+ build-tool-depends:+ hspec-discover:hspec-discover hs-source-dirs: test ghc-options: -Wall build-depends:
src/Servant/Docs.hs view
@@ -24,6 +24,9 @@ module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, pretty, markdown+ -- ** Customising generated documentation+ , markdownWith, RenderingOptions(..), defRenderingOptions+ , requestExamples, responseExamples, ShowContentTypes(..), notesHeading -- * Generating docs with extra information , docsWith, docsWithIntros, docsWithOptions , ExtraInfo(..), extraInfo@@ -43,12 +46,13 @@ , -- * ADTs to represent an 'API' Endpoint, path, method, defEndpoint , API, apiIntros, apiEndpoints, emptyAPI+ , DocAuthentication(..), authIntro, authDataRequired , DocCapture(..), capSymbol, capDesc , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind , DocNote(..), noteTitle, noteBody , DocIntro(..), introTitle, introBody , Response(..), respStatus, respTypes, respBody, defResponse- , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction+ , Action, authInfo, captures, headers, notes, params, rqtypes, rqbody, response, defAction , single ) where
src/Servant/Docs/Internal.hs view
@@ -20,24 +20,31 @@ #include "overlapping-compat.h" module Servant.Docs.Internal where -import Prelude ()+import Prelude () import Prelude.Compat+ import Control.Applicative import Control.Arrow (second)-import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),- (&), (.~), (<>~), (^.), (|>))+import Control.Lens (makeLenses, mapped, over,+ traversed, view, (%~), (&), (.~),+ (<>~), (^.), (|>)) import qualified Control.Monad.Omega as Omega-import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.ByteString.Char8 as BSC+import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.CaseInsensitive as CI+import Data.Foldable (fold) import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.List.Compat (intercalate, intersperse, sort)+import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)+import qualified Data.List.NonEmpty as NE import Data.Maybe-import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..))-import Data.Semigroup (Semigroup (..))+import Data.Monoid (All (..), Any (..), Dual (..),+ First (..), Last (..),+ Product (..), Sum (..)) import Data.Ord (comparing)-import Data.Proxy (Proxy(Proxy))+import Data.Proxy (Proxy (Proxy))+import Data.Semigroup (Semigroup (..)) import Data.String.Conversions (cs) import Data.Text (Text, unpack) import GHC.Generics@@ -125,9 +132,10 @@ , _capDesc :: String -- user supplied } deriving (Eq, Ord, Show) --- | A type to represent a /GET/ parameter from the Query String. Holds its name,--- the possible values (leave empty if there isn't a finite number of them),--- and a description of how it influences the output or behavior.+-- | A type to represent a /GET/ (or other possible 'HTTP.Method')+-- parameter from the Query String. Holds its name, the possible+-- values (leave empty if there isn't a finite number of them), and+-- a description of how it influences the output or behavior. -- -- Write a 'ToParam' instance for your GET parameter types data DocQueryParam = DocQueryParam@@ -185,7 +193,7 @@ defaultDocOptions = DocOptions { _maxSamples = 5 } --- | Type of GET parameter:+-- | Type of GET (or other 'HTTP.Method') parameter: -- -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter -- - List corresponds to @QueryParams@, i.e GET parameters with multiple values@@ -235,7 +243,7 @@ -- at an endpoint, with its lenses: -- -- - List of captures ('captures')--- - List of GET parameters ('params')+-- - List of GET (or other 'HTTP.Method') parameters ('params') -- - What the request body should look like, if any is requested ('rqbody') -- - What the response should be if everything goes well ('response') --@@ -263,7 +271,7 @@ Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ = Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp --- Default 'Action'. Has no 'captures', no GET 'params', expects+-- | Default 'Action'. Has no 'captures', no query 'params', expects -- no request body ('rqbody') and the typical response is 'defResponse'. -- -- Tweakable with lenses.@@ -290,6 +298,39 @@ single :: Endpoint -> Action -> API single e a = API mempty (HM.singleton e a) +-- | How many content-types for each example should be shown?+--+-- @since 0.11.1+data ShowContentTypes = AllContentTypes -- ^ For each example, show each content type.+ | FirstContentType -- ^ For each example, show only one content type.+ deriving (Eq, Ord, Show, Read, Bounded, Enum)++-- | Customise how an 'API' is converted into documentation.+--+-- @since 0.11.1+data RenderingOptions = RenderingOptions+ { _requestExamples :: !ShowContentTypes+ -- ^ How many content types to display for request body examples?+ , _responseExamples :: !ShowContentTypes+ -- ^ How many content types to display for response body examples?+ , _notesHeading :: !(Maybe String)+ -- ^ Optionally group all 'notes' together under a common heading.+ } deriving (Show)++-- | Default API generation options.+--+-- All content types are shown for both 'requestExamples' and+-- 'responseExamples'; 'notesHeading' is set to 'Nothing'+-- (i.e. un-grouped).+--+-- @since 0.11.1+defRenderingOptions :: RenderingOptions+defRenderingOptions = RenderingOptions+ { _requestExamples = AllContentTypes+ , _responseExamples = AllContentTypes+ , _notesHeading = Nothing+ }+ -- gimme some lenses makeLenses ''DocAuthentication makeLenses ''DocOptions@@ -301,6 +342,7 @@ makeLenses ''DocNote makeLenses ''Response makeLenses ''Action+makeLenses ''RenderingOptions -- | Generate the docs for a given API that implements 'HasDocs'. This is the -- default way to create documentation.@@ -487,8 +529,8 @@ enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s in concatMap enc samples' --- | The class that helps us automatically get documentation--- for GET parameters.+-- | The class that helps us automatically get documentation for GET+-- (or other 'HTTP.Method') parameters. -- -- Example of an instance: --@@ -516,8 +558,34 @@ -- | Generate documentation in Markdown format for -- the given 'API'.+--+-- This is equivalent to @'markdownWith' 'defRenderingOptions'@. markdown :: API -> String-markdown api = unlines $+markdown = markdownWith defRenderingOptions++-- | Generate documentation in Markdown format for+-- the 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'.+--+-- For example, to only show the first content-type of each example:+--+-- @+-- markdownWith ('defRenderingOptions'+-- & 'requestExamples' '.~' 'FirstContentType'+-- & 'responseExamples' '.~' 'FirstContentType' )+-- myAPI+-- @+--+-- @since 0.11.1+markdownWith :: RenderingOptions -> API -> String+markdownWith RenderingOptions{..} api = unlines $ introsStr (api ^. apiIntros) ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints) @@ -529,14 +597,16 @@ authStr (action ^. authInfo) ++ capturesStr (action ^. captures) ++ headersStr (action ^. headers) ++- paramsStr (action ^. params) +++ paramsStr meth (action ^. params) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++ responseStr (action ^. response) ++ [] - where str = "## " ++ BSC.unpack (endpoint^.method)+ where str = "## " ++ BSC.unpack meth ++ " " ++ showPath (endpoint^.path) + meth = endpoint ^. method+ introsStr :: [DocIntro] -> [String] introsStr = concatMap introStr @@ -549,22 +619,28 @@ [] notesStr :: [DocNote] -> [String]- notesStr = concatMap noteStr+ notesStr = addHeading+ . concatMap noteStr+ where+ addHeading nts = maybe nts (\hd -> ("### " ++ hd) : "" : nts) _notesHeading noteStr :: DocNote -> [String] noteStr nt =- ("#### " ++ nt ^. noteTitle) :+ (hdr ++ nt ^. noteTitle) : "" : intersperse "" (nt ^. noteBody) ++ "" : []-+ where+ hdr | isJust _notesHeading = "#### "+ | otherwise = "### " authStr :: [DocAuthentication] -> [String]+ authStr [] = [] authStr auths = let authIntros = mapped %~ view authIntro $ auths clientInfos = mapped %~ view authDataRequired $ auths- in "#### Authentication":+ in "### Authentication": "": unlines authIntros : "":@@ -576,7 +652,7 @@ capturesStr :: [DocCapture] -> [String] capturesStr [] = [] capturesStr l =- "#### Captures:" :+ "### Captures:" : "" : map captureStr l ++ "" :@@ -587,28 +663,33 @@ headersStr :: [Text] -> [String] headersStr [] = []- headersStr l = [""] ++ map headerStr l ++ [""]+ headersStr l =+ "### Headers:" :+ "" :+ map headerStr l +++ "" :+ [] where headerStr hname = "- This endpoint is sensitive to the value of the **" ++ unpack hname ++ "** HTTP header." - paramsStr :: [DocQueryParam] -> [String]- paramsStr [] = []- paramsStr l =- "#### GET Parameters:" :+ paramsStr :: HTTP.Method -> [DocQueryParam] -> [String]+ paramsStr _ [] = []+ paramsStr m l =+ ("### " ++ cs m ++ " Parameters:") : "" :- map paramStr l +++ map (paramStr m) l ++ "" : [] - paramStr param = unlines $+ paramStr m param = unlines $ ("- " ++ param ^. paramName) : (if (not (null values) || param ^. paramKind /= Flag) then [" - **Values**: *" ++ intercalate ", " values ++ "*"] else []) ++ (" - **Description**: " ++ param ^. paramDesc) : (if (param ^. paramKind == List)- then [" - This parameter is a **list**. All GET parameters with the name "+ then [" - This parameter is a **list**. All " ++ cs m ++ " parameters with the name " ++ param ^. paramName ++ "[] will forward their values in a list to the handler."] else []) ++ (if (param ^. paramKind == Flag)@@ -621,39 +702,63 @@ rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String] rqbodyStr [] [] = [] rqbodyStr types s =- ["#### Request:", ""]+ ["### Request:", ""] <> formatTypes types- <> concatMap formatBody s+ <> formatBodies _requestExamples s formatTypes [] = [] formatTypes ts = ["- Supported content types are:", ""] <> map (\t -> " - `" <> show t <> "`") ts <> [""] - formatBody (t, m, b) =- "- Example (" <> cs t <> "): `" <> cs (show m) <> "`" :- contentStr m 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)] -> [String]+ formatBodies ex bds = concatMap 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 + select = case ex of+ AllContentTypes -> id+ FirstContentType -> map (\(t,ms,b) -> (t, NE.head ms :| [], b))++ formatBody :: (Text, NonEmpty M.MediaType, ByteString) -> [String]+ formatBody (t, ms, b) =+ "- " <> title <> " (" <> mediaList ms <> "):" :+ contentStr (NE.head ms) b+ where+ mediaList = fold . NE.intersperse ", " . fmap (\m -> "`" ++ show m ++ "`")++ title+ | T.null t = "Example"+ | otherwise = cs t+ markdownForType mime_type = case (M.mainType mime_type, M.subType mime_type) of ("text", "html") -> "html" ("application", "xml") -> "xml"+ ("text", "xml") -> "xml" ("application", "json") -> "javascript" ("application", "javascript") -> "javascript" ("text", "css") -> "css" (_, _) -> "" + contentStr mime_type body = "" :- "```" <> markdownForType mime_type :+ " ```" <> markdownForType mime_type : cs body :- "```" :+ " ```" : "" : [] responseStr :: Response -> [String] responseStr resp =- "#### Response:" :+ "### Response:" : "" : ("- Status code " ++ show (resp ^. respStatus)) : ("- Headers: " ++ show (resp ^. respHeaders)) :@@ -665,7 +770,7 @@ [] -> ["- No response body\n"] [("", t, r)] -> "- Response body as below." : contentStr t r xs ->- concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs+ formatBodies _responseExamples xs -- * Instances @@ -797,6 +902,27 @@ instance HasDocs Raw where docsFor _proxy (endpoint, action) _ = single endpoint action+++instance (KnownSymbol desc, HasDocs api)+ => HasDocs (Description desc :> api) where++ docsFor Proxy (endpoint, action) =+ docsFor subApiP (endpoint, action')++ where subApiP = Proxy :: Proxy api+ action' = over notes (|> note) action+ note = DocNote (symbolVal (Proxy :: Proxy desc)) []++instance (KnownSymbol desc, HasDocs api)+ => HasDocs (Summary desc :> api) where++ docsFor Proxy (endpoint, action) =+ docsFor subApiP (endpoint, action')++ where subApiP = Proxy :: Proxy api+ action' = over notes (|> note) action+ note = DocNote (symbolVal (Proxy :: Proxy desc)) [] -- TODO: We use 'AllMimeRender' here because we need to be able to show the -- example data. However, there's no reason to believe that the instances of
test/Servant/DocsSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}@@ -7,6 +8,12 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -freduction-depth=100 #-}+#else+{-# OPTIONS_GHC -fcontext-stack=100 #-}+#endif+ module Servant.DocsSpec where import Control.Lens