@@ -1,4 +1,5 @@
11{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DeriveGeneric #-}
34{-# LANGUAGE TupleSections #-}
45{-# LANGUAGE TypeOperators #-}
@@ -14,7 +15,12 @@
1415--
1516-- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
1617--
17−-- You can then call 'markdown' on it:
18+-- Alternately, if you wish to add one or more introductions to your
19+-- documentation, use 'docsWithIntros':
20+--
21+-- @docsWithIntros :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
22+--
23+-- You can then call 'markdown' on the 'API' value:
1824--
1925-- @markdown :: 'API' -> String@
2026--
@@ -29,61 +35,100 @@
2935-- markdown pretty printer in action:
3036--
3137-- > {-# LANGUAGE DataKinds #-}
32−-- > {-# LANGUAGE PolyKinds #-}
33−-- > {-# LANGUAGE TypeFamilies #-}
3438-- > {-# LANGUAGE DeriveGeneric #-}
3539-- > {-# LANGUAGE TypeOperators #-}
3640-- > {-# LANGUAGE FlexibleInstances #-}
3741-- > {-# LANGUAGE OverloadedStrings #-}
38−-- >
42+-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
43+-- > import Data.Aeson
3944-- > import Data.Proxy
40−-- > import Data.Text
41−-- > import Servant
45+-- > import Data.Text(Text)
46+-- > import GHC.Generics
47+-- > import Servant.API
48+-- > import Servant.Docs
4249-- >
43−-- > -- our type for a Greeting message
44−-- > data Greet = Greet { _msg :: Text }
50+-- > -- * Example
51+-- >
52+-- > -- | A greet message data type
53+-- > newtype Greet = Greet Text
4554-- > deriving (Generic, Show)
4655-- >
47−-- > -- we get our JSON serialization for free
4856-- > instance FromJSON Greet
4957-- > instance ToJSON Greet
5058-- >
51−-- > -- we provide a sample value for the 'Greet' type
52−-- > instance ToSample Greet where
53−-- > toSample = Just g
59+-- > -- We add some useful annotations to our captures,
60+-- > -- query parameters and request body to make the docs
61+-- > -- really helpful.
62+-- > instance ToCapture (Capture "name" Text) where
63+-- > toCapture _ = DocCapture "name" "name of the person to greet"
5464-- >
55−-- > where g = Greet "Hello, haskeller!"
65+-- > instance ToCapture (Capture "greetid" Text) where
66+-- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
5667-- >
5768-- > instance ToParam (QueryParam "capital" Bool) where
5869-- > toParam _ =
5970-- > DocQueryParam "capital"
6071-- > ["true", "false"]
61−-- > "Get the greeting message in uppercase (true) or not (false). Default is false."
72+-- > "Get the greeting message in uppercase (true) or not (false).\
73+-- > \Default is false."
74+-- > Normal
6275-- >
63−-- > instance ToCapture (Capture "name" Text) where
64−-- > toCapture _ = DocCapture "name" "name of the person to greet"
76+-- > instance ToParam (MatrixParam "lang" String) where
77+-- > toParam _ =
78+-- > DocQueryParam "lang"
79+-- > ["en", "sv", "fr"]
80+-- > "Get the greeting message selected language. Default is en."
81+-- > Normal
82+-- >
83+-- > instance ToSample Greet where
84+-- > toSample = Just $ Greet "Hello, haskeller!"
85+-- >
86+-- > toSamples =
87+-- > [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
88+-- > , ("If you use ?capital=false", Greet "Hello, haskeller")
89+-- > ]
90+-- >
91+-- > intro1 :: DocIntro
92+-- > intro1 = DocIntro "On proper introductions." -- The title
93+-- > [ "Hello there."
94+-- > , "As documentation is usually written for humans, it's often useful \
95+-- > \to introduce concepts with a few words." ] -- Elements are paragraphs
96+-- >
97+-- > intro2 :: DocIntro
98+-- > intro2 = DocIntro "This title is below the last"
99+-- > [ "You'll also note that multiple intros are possible." ]
65100-- >
66−-- > instance ToCapture (Capture "greetid" Text) where
67−-- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
68101-- >
69102-- > -- API specification
70103-- > type TestApi =
71−-- > "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
72−-- > :<|> "greet" :> RQBody Greet :> Post Greet
73−-- > :<|> "delete" :> Capture "greetid" Text :> Delete
104+-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON
105+-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
106+-- >
107+-- > -- POST /greet with a Greet as JSON in the request body,
108+-- > -- returns a Greet as JSON
109+-- > :<|> "greet" :> ReqBody Greet :> Post Greet
110+-- >
111+-- > -- DELETE /greet/:greetid
112+-- > :<|> "greet" :> Capture "greetid" Text :> Delete
74113-- >
75114-- > testApi :: Proxy TestApi
76115-- > testApi = Proxy
77116-- >
78−-- > -- Generate the Documentation's ADT
79−-- > greetDocs :: API
80−-- > greetDocs = docs testApi
117+-- > -- Generate the data that lets us have API docs. This
118+-- > -- is derived from the type as well as from
119+-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
120+-- > --
121+-- > -- If you didn't want intros you could just call:
122+-- > --
123+-- > -- > docs testAPI
124+-- > docsGreet :: API
125+-- > docsGreet = docsWithIntros [intro1, intro2] testApi
81126-- >
82127-- > main :: IO ()
83−-- > main = putStrLn $ markdown greetDocs
128+-- > main = putStrLn $ markdown docsGreet
84129module Servant.Docs
85130 ( -- * 'HasDocs' class and key functions
86− HasDocs(..), docs, markdown
131+ HasDocs(..), docs, docsWithIntros, markdown
87132
88133 , -- * Classes you need to implement for your types
89134 ToSample(..)
@@ -98,8 +143,10 @@ module Servant.Docs
98143 , API, emptyAPI
99144 , DocCapture(..), capSymbol, capDesc
100145 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
146+ , DocNote(..), noteTitle, noteBody
147+ , DocIntro(..)
101148 , Response, respStatus, respBody, defResponse
102− , Action, captures, headers, params, rqbody, response, defAction
149+ , Action, captures, headers, notes, params, rqbody, response, defAction
103150 , single
104151
105152 , -- * Useful modules when defining your doc printers
@@ -110,6 +157,7 @@ module Servant.Docs
110157import Control.Lens hiding (Action)
111158import Data.Aeson
112159import Data.Aeson.Encode.Pretty (encodePretty)
160+import Data.Ord(comparing)
113161import Data.ByteString.Lazy.Char8 (ByteString)
114162import Data.Hashable
115163import Data.HashMap.Strict (HashMap)
@@ -188,12 +236,20 @@ defEndpoint = Endpoint [] DocGET
188236
189237instance Hashable Endpoint
190238
191−-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
192−type API = HashMap Endpoint Action
239+-- | Our API documentation type, a product of top-level information and a good
240+-- old hashmap from 'Endpoint' to 'Action'
241+data API = API
242+ { _apiIntros :: [DocIntro]
243+ , _apiEndpoints :: HashMap Endpoint Action
244+ } deriving (Eq, Show)
245+
246+instance Monoid API where
247+ API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
248+ mempty = API mempty mempty
193249
194250-- | An empty 'API'
195251emptyAPI :: API
196−emptyAPI = HM.empty
252+emptyAPI = mempty
197253
198254-- | A type to represent captures. Holds the name of the capture
199255-- and a description.
@@ -216,6 +272,24 @@ data DocQueryParam = DocQueryParam
216272 , _paramKind :: ParamKind
217273 } deriving (Eq, Show)
218274
275+-- | An introductory paragraph for your documentation. You can pass these to
276+-- 'docsWithIntros'.
277+data DocIntro = DocIntro
278+ { _introTitle :: String -- ^ Appears above the intro blob
279+ , _introBody :: [String] -- ^ Each String is a paragraph.
280+ } deriving (Eq, Show)
281+
282+instance Ord DocIntro where
283+ compare = comparing _introTitle
284+
285+-- | A type to represent extra notes that may be attached to an 'Action'.
286+--
287+-- This is intended to be used when writing your own HasDocs instances to
288+-- add extra sections to your endpoint's documentation.
289+data DocNote = DocNote
290+ { _noteTitle :: String
291+ , _noteBody :: [String]
292+ } deriving (Eq, Show)
219293
220294-- | Type of GET parameter:
221295--
@@ -269,6 +343,7 @@ data Action = Action
269343 { _captures :: [DocCapture] -- type collected + user supplied info
270344 , _headers :: [Text] -- type collected
271345 , _params :: [DocQueryParam] -- type collected + user supplied info
346+ , _notes :: [DocNote] -- user supplied
272347 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
273348 , _rqbody :: Maybe ByteString -- user supplied
274349 , _response :: Response -- user supplied
@@ -289,6 +364,7 @@ defAction =
289364 []
290365 []
291366 []
367+ []
292368 Nothing
293369 defResponse
294370
@@ -296,19 +372,28 @@ defAction =
296372-- 'API' is a 'Monoid', so combine multiple endpoints with
297373-- 'mappend' or '<>'.
298374single :: Endpoint -> Action -> API
299−single = HM.singleton
375+single e a = API mempty (HM.singleton e a)
300376
301377-- gimme some lenses
378+makeLenses ''API
302379makeLenses ''Endpoint
303380makeLenses ''DocCapture
304381makeLenses ''DocQueryParam
382+makeLenses ''DocIntro
383+makeLenses ''DocNote
305384makeLenses ''Response
306385makeLenses ''Action
307386
308−-- | Generate the docs for a given API that implements 'HasDocs'.
387+-- | Generate the docs for a given API that implements 'HasDocs'. This is the
388+-- default way to create documentation.
309389docs :: HasDocs layout => Proxy layout -> API
310390docs p = docsFor p (defEndpoint, defAction)
311391
392+-- | Generate the docs for a given API that implements 'HasDocs' with with any
393+-- number of introduction(s)
394+docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
395+docsWithIntros intros p = docs p & apiIntros <>~ intros
396+
312397-- | The class that abstracts away the impact of API combinators
313398-- on documentation generation.
314399class HasDocs layout where
@@ -388,13 +473,15 @@ class ToCapture c where
388473-- | Generate documentation in Markdown format for
389474-- the given 'API'.
390475markdown :: API -> String
391−markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
476+markdown api = unlines $
477+ introsStr (api ^. apiIntros)
478+ ++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints)
392479
393480 where printEndpoint :: Endpoint -> Action -> [String]
394481 printEndpoint endpoint action =
395482 str :
396− replicate len '-' :
397483 "" :
484+ notesStr (action ^. notes) ++
398485 capturesStr (action ^. captures) ++
399486 mxParamsStr (action ^. mxParams) ++
400487 headersStr (action ^. headers) ++
@@ -403,13 +490,35 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
403490 responseStr (action ^. response) ++
404491 []
405492
406− where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
407− len = length str
493+ where str = "## " ++ show (endpoint^.method)
494+ ++ " " ++ showPath (endpoint^.path)
495+
496+ introsStr :: [DocIntro] -> [String]
497+ introsStr = concatMap introStr
498+
499+ introStr :: DocIntro -> [String]
500+ introStr i =
501+ ("#### " ++ i ^. introTitle) :
502+ "" :
503+ intersperse "" (i ^. introBody) ++
504+ "" :
505+ []
506+
507+ notesStr :: [DocNote] -> [String]
508+ notesStr = concatMap noteStr
509+
510+ noteStr :: DocNote -> [String]
511+ noteStr nt =
512+ ("#### " ++ nt ^. noteTitle) :
513+ "" :
514+ intersperse "" (nt ^. noteBody) ++
515+ "" :
516+ []
408517
409518 capturesStr :: [DocCapture] -> [String]
410519 capturesStr [] = []
411520 capturesStr l =
412− "**Captures**: " :
521+ "#### Captures:" :
413522 "" :
414523 map captureStr l ++
415524 "" :
@@ -420,14 +529,14 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
420529 mxParamsStr :: [(String, [DocQueryParam])] -> [String]
421530 mxParamsStr [] = []
422531 mxParamsStr l =
423− "**Matrix Parameters**: " :
532+ "#### Matrix Parameters:" :
424533 "" :
425534 map segmentStr l ++
426535 "" :
427536 []
428537 segmentStr :: (String, [DocQueryParam]) -> String
429538 segmentStr (segment, l) = unlines $
430− ("**" ++ segment ++ "**: ") :
539+ ("**" ++ segment ++ "**:") :
431540 "" :
432541 map paramStr l ++
433542 "" :
@@ -443,7 +552,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
443552 paramsStr :: [DocQueryParam] -> [String]
444553 paramsStr [] = []
445554 paramsStr l =
446− "**GET Parameters**: " :
555+ "#### GET Parameters:" :
447556 "" :
448557 map paramStr l ++
449558 "" :
@@ -468,7 +577,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
468577 rqbodyStr :: Maybe ByteString -> [String]
469578 rqbodyStr Nothing = []
470579 rqbodyStr (Just b) =
471− "**Request Body**: " :
580+ "#### Request Body:" :
472581 jsonStr b
473582
474583 jsonStr b =
@@ -481,7 +590,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
481590
482591 responseStr :: Response -> [String]
483592 responseStr resp =
484− "**Response**: " :
593+ "#### Response:" :
485594 "" :
486595 (" - Status code " ++ show (resp ^. respStatus)) :
487596 bodies