Add DocIntro and DocNote types to allow extra docs

This commit provides a way for a user to add information to either the
beginning of the output, and for a HasDoc instance to add extra sections to an
endpoint.

See example/greet.hs for usage of the Intro type.
This commit is contained in:
Christian Marie 2015-01-23 12:19:37 +11:00
parent 44efc7ff20
commit aa64d7a0bf
3 changed files with 146 additions and 30 deletions

View file

@ -6,7 +6,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Data.Aeson
import Data.Proxy
import Data.Text
import Data.Text(Text)
import GHC.Generics
import Servant.API
import Servant.Docs
@ -44,6 +44,17 @@ instance ToSample Greet where
, ("If you use ?capital=false", Greet "Hello, haskeller")
]
instance ToIntro "on proper introductions" where
toIntro _ = DocIntro "On proper introductions." -- The title
[ "Hello there."
, "As documentation is usually written for humans, it's often useful \
\to introduce concepts with a few words." ] -- Elements are paragraphs
instance ToIntro "on zebras" where
toIntro _ = DocIntro "This title is below the last"
[ "You'll also note that multiple intros are possible." ]
-- API specification
type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
@ -56,14 +67,17 @@ type TestApi =
-- DELETE /greet/:greetid
:<|> "greet" :> Capture "greetid" Text :> Delete
testApi :: Proxy TestApi
testApi = Proxy
type IntroducedApi =
Intro "on proper introductions" :> Intro "on zebras" :> TestApi
introducedApi :: Proxy IntroducedApi
introducedApi = Proxy
-- Generate the data that lets us have API docs. This
-- is derived from the type as well as from
-- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
docsGreet :: API
docsGreet = docs testApi
docsGreet = docs introducedApi
main :: IO ()
main = putStrLn $ markdown docsGreet

View file

@ -1,7 +1,16 @@
POST /greet
-----------
#### On proper introductions.
**Request Body**:
Hello there.
As documentation is usually written for humans, it's often useful to introduce concepts with a few words.
#### This title is below the last
You'll also note that multiple intros are possible.
## POST /greet
#### Request Body:
``` javascript
{
@ -9,7 +18,7 @@ POST /greet
}
```
**Response**:
#### Response:
- Status code 201
- If you use ?capital=true
@ -28,21 +37,20 @@ POST /greet
}
```
GET /hello/:name
----------------
## GET /hello/:name
**Captures**:
#### Captures:
- *name*: name of the person to greet
**GET Parameters**:
#### GET Parameters:
- capital
- **Values**: *true, false*
- **Description**: Get the greeting message in uppercase (true) or not (false). Default is false.
**Response**:
#### Response:
- Status code 200
- If you use ?capital=true
@ -61,14 +69,13 @@ GET /hello/:name
}
```
DELETE /greet/:greetid
----------------------
## DELETE /greet/:greetid
**Captures**:
#### Captures:
- *greetid*: identifier of the greet msg to remove
**Response**:
#### Response:
- Status code 204
- No response body

View file

@ -1,4 +1,5 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
@ -91,6 +92,7 @@ module Servant.Docs
, sampleByteStrings
, ToParam(..)
, ToCapture(..)
, ToIntro(..)
, -- * ADTs to represent an 'API'
Method(..)
@ -98,8 +100,10 @@ module Servant.Docs
, API, emptyAPI
, DocCapture(..), capSymbol, capDesc
, DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
, DocNote(..), noteTitle, noteBody
, DocIntro(..), Intro
, Response, respStatus, respBody, defResponse
, Action, captures, headers, params, rqbody, response, defAction
, Action, captures, headers, notes, params, rqbody, response, defAction
, single
, -- * Useful modules when defining your doc printers
@ -110,6 +114,7 @@ module Servant.Docs
import Control.Lens hiding (Action)
import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Ord(comparing)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Hashable
import Data.HashMap.Strict (HashMap)
@ -188,12 +193,36 @@ defEndpoint = Endpoint [] DocGET
instance Hashable Endpoint
-- | Our API type, a good old hashmap from 'Endpoint' to 'Action'
type API = HashMap Endpoint Action
-- | Our API documentation type, a product of top-level information and a good
-- old hashmap from 'Endpoint' to 'Action'
data API = API
{ _apiIntros :: [DocIntro]
, _apiEndpoints :: HashMap Endpoint Action
} deriving (Eq, Show)
instance Monoid API where
API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
mempty = API mempty mempty
-- | A way for a developer to insert an introductory paragraph manually. This
-- is not to be used in server or client facing API types.
--
-- Example:
--
-- > type OurAPI = "users" :> Get [User]
-- > type IntroducedAPI = Intro "of human bondage" :> OurAPI
-- >
-- > instance ToIntro "of human bondage" where
-- > toIntro = DocIntro "A title for the intro section"
-- > [ "A blob of text that will be at the top."
-- > , "List elements are paragraphs."
-- > ]
--
data Intro (name :: Symbol)
-- | An empty 'API'
emptyAPI :: API
emptyAPI = HM.empty
emptyAPI = mempty
-- | A type to represent captures. Holds the name of the capture
-- and a description.
@ -216,6 +245,26 @@ data DocQueryParam = DocQueryParam
, _paramKind :: ParamKind
} deriving (Eq, Show)
-- | An introductory paragraph for your documentation. You can attach these
-- with the 'Intro' type.
--
data DocIntro = DocIntro
{ _introTitle :: String -- ^ Appears above the intro blob
, _introBody :: [String] -- ^ Each String is a paragraph.
} deriving (Eq, Show)
instance Ord DocIntro where
compare = comparing _introTitle
-- | A type to represent extra notes that may be attached to an 'Action'.
--
-- This is intended to be used when writing your own HasDocs instances to
-- add extra sections to your endpoint's documentation.
data DocNote = DocNote
{ _noteTitle :: String
, _noteBody :: [String]
} deriving (Eq, Show)
-- | Type of GET parameter:
--
-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@ -268,6 +317,7 @@ data Action = Action
{ _captures :: [DocCapture] -- type collected + user supplied info
, _headers :: [Text] -- type collected
, _params :: [DocQueryParam] -- type collected + user supplied info
, _notes :: [DocNote] -- user supplied
, _rqbody :: Maybe ByteString -- user supplied
, _response :: Response -- user supplied
} deriving (Eq, Show)
@ -284,6 +334,7 @@ data Action = Action
defAction :: Action
defAction =
Action []
[]
[]
[]
Nothing
@ -293,12 +344,15 @@ defAction =
-- 'API' is a 'Monoid', so combine multiple endpoints with
-- 'mappend' or '<>'.
single :: Endpoint -> Action -> API
single = HM.singleton
single e a = API mempty (HM.singleton e a)
-- gimme some lenses
makeLenses ''API
makeLenses ''Endpoint
makeLenses ''DocCapture
makeLenses ''DocQueryParam
makeLenses ''DocIntro
makeLenses ''DocNote
makeLenses ''Response
makeLenses ''Action
@ -382,16 +436,26 @@ class ToParam t where
class ToCapture c where
toCapture :: Proxy c -> DocCapture
-- | The class to define the contents of an 'Intro'
-- Example of an instance:
--
-- > instance ToIntro "an intro" where
-- > toIntro _ = DocIntro "This is some text"
class ToIntro (intro :: Symbol) where
toIntro :: Proxy intro -> DocIntro
-- | Generate documentation in Markdown format for
-- the given 'API'.
markdown :: API -> String
markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
markdown api = unlines $
introsStr (api ^. apiIntros)
++ (concatMap (uncurry printEndpoint) . HM.toList $ api ^. apiEndpoints)
where printEndpoint :: Endpoint -> Action -> [String]
printEndpoint endpoint action =
str :
replicate len '-' :
"" :
notesStr (action ^. notes) ++
capturesStr (action ^. captures) ++
headersStr (action ^. headers) ++
paramsStr (action ^. params) ++
@ -399,13 +463,35 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
responseStr (action ^. response) ++
[]
where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
len = length str
where str = "## " ++ show (endpoint^.method)
++ " " ++ showPath (endpoint^.path)
introsStr :: [DocIntro] -> [String]
introsStr = concatMap introStr
introStr :: DocIntro -> [String]
introStr i =
("#### " ++ i ^. introTitle) :
"" :
intersperse "" (i ^. introBody) ++
"" :
[]
notesStr :: [DocNote] -> [String]
notesStr = concatMap noteStr
noteStr :: DocNote -> [String]
noteStr nt =
("#### " ++ nt ^. noteTitle) :
"" :
intersperse "" (nt ^. noteBody) ++
"" :
[]
capturesStr :: [DocCapture] -> [String]
capturesStr [] = []
capturesStr l =
"**Captures**: " :
"#### Captures:" :
"" :
map captureStr l ++
"" :
@ -423,7 +509,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
paramsStr :: [DocQueryParam] -> [String]
paramsStr [] = []
paramsStr l =
"**GET Parameters**: " :
"#### GET Parameters:" :
"" :
map paramStr l ++
"" :
@ -448,7 +534,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
rqbodyStr :: Maybe ByteString -> [String]
rqbodyStr Nothing = []
rqbodyStr (Just b) =
"**Request Body**: " :
"#### Request Body:" :
jsonStr b
jsonStr b =
@ -461,7 +547,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
responseStr :: Response -> [String]
responseStr resp =
"**Response**: " :
"#### Response:" :
"" :
(" - Status code " ++ show (resp ^. respStatus)) :
bodies
@ -607,6 +693,15 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
endpoint' = endpoint & path <>~ [symbolVal pa]
pa = Proxy :: Proxy path
instance (KnownSymbol intro, HasDocs sublayout, ToIntro intro)
=> HasDocs (Intro intro :> sublayout) where
docsFor Proxy x =
docsFor sublayoutP x & apiIntros %~ (toIntro intro <|)
where sublayoutP = Proxy :: Proxy sublayout
intro :: Proxy intro
intro = Proxy
{-
-- | Serve your API's docs as markdown embedded in an html \<pre> tag.