@@ -1,4 +1,5 @@
11{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DeriveGeneric #-}
34{-# LANGUAGE TupleSections #-}
45{-# LANGUAGE TypeOperators #-}
@@ -91,6 +92,7 @@ module Servant.Docs
9192 , sampleByteStrings
9293 , ToParam(..)
9394 , ToCapture(..)
95+ , ToIntro(..)
9496
9597 , -- * ADTs to represent an 'API'
9698 Method(..)
@@ -98,8 +100,10 @@ module Servant.Docs
98100 , API, emptyAPI
99101 , DocCapture(..), capSymbol, capDesc
100102 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
103+ , DocNote(..), noteTitle, noteBody
104+ , DocIntro(..), Intro
101105 , Response, respStatus, respBody, defResponse
102− , Action, captures, headers, params, rqbody, response, defAction
106+ , Action, captures, headers, notes, params, rqbody, response, defAction
103107 , single
104108
105109 , -- * Useful modules when defining your doc printers
@@ -110,6 +114,7 @@ module Servant.Docs
110114import Control.Lens hiding (Action)
111115import Data.Aeson
112116import Data.Aeson.Encode.Pretty (encodePretty)
117+import Data.Ord(comparing)
113118import Data.ByteString.Lazy.Char8 (ByteString)
114119import Data.Hashable
115120import Data.HashMap.Strict (HashMap)
@@ -188,12 +193,36 @@ defEndpoint = Endpoint [] DocGET
188193
189194instance Hashable Endpoint
190195
191−-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
192−type API = HashMap Endpoint Action
196+-- | Our API documentation type, a product of top-level information and a good
197+-- old hashmap from 'Endpoint' to 'Action'
198+data API = API
199+ { _apiIntros :: [DocIntro]
200+ , _apiEndpoints :: HashMap Endpoint Action
201+ } deriving (Eq, Show)
202+
203+instance Monoid API where
204+ API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
205+ mempty = API mempty mempty
206+
207+-- | A way for a developer to insert an introductory paragraph manually. This
208+-- is not to be used in server or client facing API types.
209+--
210+-- Example:
211+--
212+-- > type OurAPI = "users" :> Get [User]
213+-- > type IntroducedAPI = Intro "of human bondage" :> OurAPI
214+-- >
215+-- > instance ToIntro "of human bondage" where
216+-- > toIntro = DocIntro "A title for the intro section"
217+-- > [ "A blob of text that will be at the top."
218+-- > , "List elements are paragraphs."
219+-- > ]
220+--
221+data Intro (name :: Symbol)
193222
194223-- | An empty 'API'
195224emptyAPI :: API
196−emptyAPI = HM.empty
225+emptyAPI = mempty
197226
198227-- | A type to represent captures. Holds the name of the capture
199228-- and a description.
@@ -216,6 +245,26 @@ data DocQueryParam = DocQueryParam
216245 , _paramKind :: ParamKind
217246 } deriving (Eq, Show)
218247
248+-- | An introductory paragraph for your documentation. You can attach these
249+-- with the 'Intro' type.
250+--
251+data DocIntro = DocIntro
252+ { _introTitle :: String -- ^ Appears above the intro blob
253+ , _introBody :: [String] -- ^ Each String is a paragraph.
254+ } deriving (Eq, Show)
255+
256+instance Ord DocIntro where
257+ compare = comparing _introTitle
258+
259+-- | A type to represent extra notes that may be attached to an 'Action'.
260+--
261+-- This is intended to be used when writing your own HasDocs instances to
262+-- add extra sections to your endpoint's documentation.
263+data DocNote = DocNote
264+ { _noteTitle :: String
265+ , _noteBody :: [String]
266+ } deriving (Eq, Show)
267+
219268-- | Type of GET parameter:
220269--
221270-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -268,6 +317,7 @@ data Action = Action
268317 { _captures :: [DocCapture] -- type collected + user supplied info
269318 , _headers :: [Text] -- type collected
270319 , _params :: [DocQueryParam] -- type collected + user supplied info
320+ , _notes :: [DocNote] -- user supplied
271321 , _rqbody :: Maybe ByteString -- user supplied
272322 , _response :: Response -- user supplied
273323 } deriving (Eq, Show)
@@ -284,6 +334,7 @@ data Action = Action
284334defAction :: Action
285335defAction =
286336 Action []
337+ []
287338 []
288339 []
289340 Nothing
@@ -293,12 +344,15 @@ defAction =
293344-- 'API' is a 'Monoid', so combine multiple endpoints with
294345-- 'mappend' or '<>'.
295346single :: Endpoint -> Action -> API
296−single = HM.singleton
347+single e a = API mempty (HM.singleton e a)
297348
298349-- gimme some lenses
350+makeLenses ''API
299351makeLenses ''Endpoint
300352makeLenses ''DocCapture
301353makeLenses ''DocQueryParam
354+makeLenses ''DocIntro
355+makeLenses ''DocNote
302356makeLenses ''Response
303357makeLenses ''Action
304358
@@ -382,16 +436,26 @@ class ToParam t where
382436class ToCapture c where
383437 toCapture :: Proxy c -> DocCapture
384438
439+-- | The class to define the contents of an 'Intro'
440+-- Example of an instance:
441+--
442+-- > instance ToIntro "an intro" where
443+-- > toIntro _ = DocIntro "This is some text"
444+class ToIntro (intro :: Symbol) where
445+ toIntro :: Proxy intro -> DocIntro
446+
385447-- | Generate documentation in Markdown format for
386448-- the given 'API'.
387449markdown :: API -> String
388−markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
450+markdown api = unlines $
451+ introsStr (api ^. apiIntros)
452+ ++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints)
389453
390454 where printEndpoint :: Endpoint -> Action -> [String]
391455 printEndpoint endpoint action =
392456 str :
393− replicate len '-' :
394457 "" :
458+ notesStr (action ^. notes) ++
395459 capturesStr (action ^. captures) ++
396460 headersStr (action ^. headers) ++
397461 paramsStr (action ^. params) ++
@@ -399,13 +463,35 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
399463 responseStr (action ^. response) ++
400464 []
401465
402− where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
403− len = length str
466+ where str = "## " ++ show (endpoint^.method)
467+ ++ " " ++ showPath (endpoint^.path)
468+
469+ introsStr :: [DocIntro] -> [String]
470+ introsStr = concatMap introStr
471+
472+ introStr :: DocIntro -> [String]
473+ introStr i =
474+ ("#### " ++ i ^. introTitle) :
475+ "" :
476+ intersperse "" (i ^. introBody) ++
477+ "" :
478+ []
479+
480+ notesStr :: [DocNote] -> [String]
481+ notesStr = concatMap noteStr
482+
483+ noteStr :: DocNote -> [String]
484+ noteStr nt =
485+ ("#### " ++ nt ^. noteTitle) :
486+ "" :
487+ intersperse "" (nt ^. noteBody) ++
488+ "" :
489+ []
404490
405491 capturesStr :: [DocCapture] -> [String]
406492 capturesStr [] = []
407493 capturesStr l =
408− "**Captures**: " :
494+ "#### Captures:" :
409495 "" :
410496 map captureStr l ++
411497 "" :
@@ -423,7 +509,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
423509 paramsStr :: [DocQueryParam] -> [String]
424510 paramsStr [] = []
425511 paramsStr l =
426− "**GET Parameters**: " :
512+ "#### GET Parameters:" :
427513 "" :
428514 map paramStr l ++
429515 "" :
@@ -448,7 +534,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
448534 rqbodyStr :: Maybe ByteString -> [String]
449535 rqbodyStr Nothing = []
450536 rqbodyStr (Just b) =
451− "**Request Body**: " :
537+ "#### Request Body:" :
452538 jsonStr b
453539
454540 jsonStr b =
@@ -461,7 +547,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
461547
462548 responseStr :: Response -> [String]
463549 responseStr resp =
464− "**Response**: " :
550+ "#### Response:" :
465551 "" :
466552 (" - Status code " ++ show (resp ^. respStatus)) :
467553 bodies
@@ -607,6 +693,15 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
607693 endpoint' = endpoint & path <>~ [symbolVal pa]
608694 pa = Proxy :: Proxy path
609695
696+instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro)
697+ => HasDocs (Intro intro :> sublayout) where
698+
699+ docsFor Proxy x =
700+ docsFor sublayoutP x & apiIntros %~ (toIntro intro <|)
701+ where sublayoutP = Proxy :: Proxy sublayout
702+ intro :: Proxy intro
703+ intro = Proxy
704+
610705{-
611706
612707-- | Serve your API's docs as markdown embedded in an html \<pre> tag.