@@ -85,7 +85,7 @@
8585-- > main = printMarkdown greetDocs
8686module Servant.Docs
8787 ( -- * 'HasDocs' class and key functions
88− HasDocs(..), docs, printMarkdown
88+ HasDocs(..), docs, markdown, printMarkdown
8989
9090 , -- * Classes you need to implement for your types
9191 ToSample(..), ToParam(..), ToCapture(..)
@@ -106,7 +106,6 @@ module Servant.Docs
106106 ) where
107107
108108import Control.Lens hiding (Action)
109−import Control.Monad (when)
110109import Data.Aeson
111110import Data.ByteString.Lazy.Char8 (ByteString)
112111import Data.Hashable
@@ -114,9 +113,9 @@ import Data.HashMap.Strict (HashMap)
114113import Data.List
115114import Data.Monoid
116115import Data.Proxy
116+import Data.String.Conversions
117117import GHC.Generics
118118
119−import qualified Data.ByteString.Lazy.Char8 as LB
120119import qualified Data.HashMap.Strict as HM
121120
122121-- | Supported HTTP request methods
@@ -349,69 +348,80 @@ class ToCapture c where
349348-- | Print documentation in Markdown format for
350349-- the given 'API', on standard output.
351350printMarkdown :: API -> IO ()
352−printMarkdown = imapM_ printEndpoint
353−
354− where printEndpoint endpoint action = do
355− putStrLn $ str
356− putStrLn $ replicate len '-'
357− putStrLn ""
358− capturesStr (action ^. captures)
359− paramsStr (action ^. params)
360− rqbodyStr (action ^. rqbody)
361− responseStr (action ^. response)
351+printMarkdown = print . markdown
352+
353+markdown :: API -> String
354+markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
355+
356+ where printEndpoint :: Endpoint -> Action -> [String]
357+ printEndpoint endpoint action =
358+ str :
359+ replicate len '-' :
360+ "" :
361+ capturesStr (action ^. captures) ++
362+ paramsStr (action ^. params) ++
363+ rqbodyStr (action ^. rqbody) ++
364+ responseStr (action ^. response) ++
365+ []
362366
363367 where str = show (endpoint^.method) ++ " " ++ endpoint^.path
364368 len = length str
365369
366− capturesStr :: [DocCapture] -> IO ()
367− capturesStr [] = return ()
368− capturesStr l = do
369− putStrLn "**Captures**: "
370− putStrLn ""
371− mapM_ captureStr l
372− putStrLn ""
370+ capturesStr :: [DocCapture] -> [String]
371+ capturesStr [] = []
372+ capturesStr l =
373+ "**Captures**: " :
374+ "" :
375+ map captureStr l ++
376+ "" :
377+ []
373378 captureStr cap =
374− putStrLn $ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
375−
376− paramsStr :: [DocQueryParam] -> IO ()
377− paramsStr [] = return ()
378− paramsStr l = do
379− putStrLn "**GET Parameters**: "
380− putStrLn ""
381− mapM_ paramStr l
382− putStrLn ""
383− paramStr param = do
384− putStrLn $ " - " ++ param ^. paramName
385− when (not (null values) || param ^. paramKind /= Flag) $
386− putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*"
387− putStrLn $ " - **Description**: " ++ param ^. paramDesc
388− when (param ^. paramKind == List) $
389− putStrLn $ " - This parameter is a **list**. All GET parameters with the name "
390− ++ param ^. paramName ++ "[] will forward their values in a list to the handler."
391− when (param ^. paramKind == Flag) $
392− putStrLn $ " - This parameter is a **flag**. This means no value is expected to be associated to this parameter."
379+ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
380+
381+ paramsStr :: [DocQueryParam] -> [String]
382+ paramsStr [] = []
383+ paramsStr l =
384+ "**GET Parameters**: " :
385+ "" :
386+ map paramStr l ++
387+ "" :
388+ []
389+ paramStr param = unlines $
390+ (" - " ++ param ^. paramName) :
391+ (if (not (null values) || param ^. paramKind /= Flag)
392+ then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
393+ else []) ++
394+ (" - **Description**: " ++ param ^. paramDesc) :
395+ (if (param ^. paramKind == List)
396+ then [" - This parameter is a **list**. All GET parameters with the name "
397+ ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
398+ else []) ++
399+ (if (param ^. paramKind == Flag)
400+ then [" - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
401+ else []) ++
402+ []
393403
394404 where values = param ^. paramValues
395405
396− rqbodyStr :: Maybe ByteString -> IO ()
397− rqbodyStr Nothing = return ()
398− rqbodyStr (Just b) = do
399− putStrLn "**Request Body**: "
406+ rqbodyStr :: Maybe ByteString -> [String]
407+ rqbodyStr Nothing = []
408+ rqbodyStr (Just b) =
409+ "**Request Body**: " :
400410 jsonStr b
401411
402− jsonStr b = do
403− putStrLn ""
404− putStrLn "``` javascript"
405− LB.putStrLn b
406− putStrLn "```"
407− putStrLn ""
408−
409− responseStr :: Response -> IO ()
410− responseStr resp = do
411− putStrLn $ "**Response**: "
412− putStrLn $ ""
413− putStrLn $ " - Status code " ++ show (resp ^. respStatus)
414− resp ^. respBody &
415− maybe (putStrLn " - No response body\n")
416− (\b -> putStrLn " - Response body as below." >> jsonStr b)
417−
412+ jsonStr b =
413+ "" :
414+ "``` javascript" :
415+ cs b :
416+ "```" :
417+ "" :
418+ []
419+
420+ responseStr :: Response -> [String]
421+ responseStr resp =
422+ "**Response**: " :
423+ "" :
424+ (" - Status code " ++ show (resp ^. respStatus)) :
425+ (resp ^. respBody &
426+ maybe [" - No response body\n"]
427+ (\b -> " - Response body as below." : jsonStr b))