git.iko.soy/servant
on master help sign in
Merge pull request #11 from haskell-servant/wip-note-api
795a770Christian Marie
example/greet.hs+19−3
compare with master
unifiedsplit
@@ -60,6 +60,11 @@ instance ToSample Greet where
60 , ("If you use ?capital=false", Greet "Hello, haskeller")
60 , ("If you use ?capital=false", Greet "Hello, haskeller")
61 ]
61 ]
62
62
63+-- We define some introductory sections, these will appear at the top of the
64+-- documentation.
65+--
66+-- We pass them in with 'docsWith', below. If you only want to add
67+-- introductions, you may use 'docsWithIntros'
63intro1 :: DocIntro
68intro1 :: DocIntro
64intro1 = DocIntro "On proper introductions." -- The title
69intro1 = DocIntro "On proper introductions." -- The title
65 [ "Hello there."
70 [ "Hello there."
@@ -86,15 +91,26 @@ type TestApi =
86testApi :: Proxy TestApi
91testApi :: Proxy TestApi
87testApi = Proxy
92testApi = Proxy
88
93
94+-- Build some extra information for the DELETE /greet/:greetid endpoint. We
95+-- want to add documentation about a secret unicorn header and some extra
96+-- notes.
97+extra :: ExtraInfo TestApi
98+extra =
99+ extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
100+ defAction & headers <>~ ["unicorns"]
101+ & notes <>~ [ DocNote "Title" ["This is some text"]
102+ , DocNote "Second secton" ["And some more"]
103+ ]
104+
89-- Generate the data that lets us have API docs. This
105-- Generate the data that lets us have API docs. This
90-- is derived from the type as well as from
106-- is derived from the type as well as from
91-- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
107-- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
92--
108--
93−-- If you didn't want intros you could just call:
109+-- If you didn't want intros and extra information, you could just call:
94--
110--
95−-- > docs testAPI
111+-- > docs testAPI :: API
96docsGreet :: API
112docsGreet :: API
97−docsGreet = docsWithIntros [intro1, intro2] testApi
113+docsGreet = docsWith [intro1, intro2] extra testApi
98
114
99main :: IO ()
115main :: IO ()
100main = putStrLn $ markdown docsGreet
116main = putStrLn $ markdown docsGreet
example/greet.md+58−18
@@ -10,24 +10,35 @@ You'll also note that multiple intros are possible.
10
10
11## POST /greet
11## POST /greet
12
12
13−#### Request Body:
13+#### Request:
14
14
15+- Supported content types are:
16+
17+ - `application/json`
18+
19+- Example: `application/json`
20+
15−``` javascript
21+```javascript
16"Hello, haskeller!"
22"Hello, haskeller!"
17```
23```
18
24
19#### Response:
25#### Response:
20
26
21− - Status code 201
27+- Status code 201
22− - If you use ?capital=true
28+
29+- Supported content types are:
23
30
31+ - `application/json`
32+
33+- If you use ?capital=true
34+
24−``` javascript
35+```javascript
25"HELLO, HASKELLER"
36"HELLO, HASKELLER"
26```
37```
27
38
28− - If you use ?capital=false
39+- If you use ?capital=false
29
40
30−``` javascript
41+```javascript
31"Hello, haskeller"
42"Hello, haskeller"
32```
43```
33
44
@@ -37,48 +48,77 @@ You'll also note that multiple intros are possible.
37
48
38- *name*: name of the person to greet
49- *name*: name of the person to greet
39
50
40−#### Matrix Parameters**:
51+#### Matrix Parameters:
41
52
42**hello**:
53**hello**:
43
54
44− - lang
55+- lang
45 - **Values**: *en, sv, fr*
56 - **Values**: *en, sv, fr*
46 - **Description**: Get the greeting message selected language. Default is en.
57 - **Description**: Get the greeting message selected language. Default is en.
47
58
48
59
49
60
50−
51#### GET Parameters:
61#### GET Parameters:
52
62
53− - capital
63+- capital
54 - **Values**: *true, false*
64 - **Values**: *true, false*
55 - **Description**: Get the greeting message in uppercase (true) or not (false).Default is false.
65 - **Description**: Get the greeting message in uppercase (true) or not (false).Default is false.
56
66
57
67
58#### Response:
68#### Response:
59
69
60− - Status code 200
70+- Status code 200
61− - If you use ?capital=true
62
71
72+- Supported content types are:
73+
74+ - `application/json`
75+ - `text/plain;charset=utf-8`
76+
77+- If you use ?capital=true
78+
63−``` javascript
79+```javascript
64"HELLO, HASKELLER"
80"HELLO, HASKELLER"
65```
81```
66
82
67− - If you use ?capital=false
83+- If you use ?capital=true
84+
85+```
86+"HELLO, HASKELLER"
87+```
68
88
89+- If you use ?capital=false
90+
69−``` javascript
91+```javascript
92+"Hello, haskeller"
93+```
94+
95+- If you use ?capital=false
96+
97+```
70"Hello, haskeller"
98"Hello, haskeller"
71```
99```
72
100
73## DELETE /greet/:greetid
101## DELETE /greet/:greetid
74
102
103+#### Title
104+
105+This is some text
106+
107+#### Second secton
108+
109+And some more
110+
75#### Captures:
111#### Captures:
76
112
77- *greetid*: identifier of the greet msg to remove
113- *greetid*: identifier of the greet msg to remove
78
114
115+
116+- This endpoint is sensitive to the value of the **unicorns** HTTP header.
117+
79#### Response:
118#### Response:
80
119
81− - Status code 204
120+- Status code 200
121+
82− - No response body
122+- No response body
83
123
84
124
src/Servant/Docs.hs+131−33
@@ -1,16 +1,16 @@
1−{-# LANGUAGE ConstraintKinds #-}
1+{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TupleSections #-}
5+{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE TemplateHaskell #-}
4−{-# LANGUAGE FlexibleContexts #-}
7+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TemplateHaskell #-}
11+{-# LANGUAGE ConstraintKinds #-}
10−{-# LANGUAGE TupleSections #-}
11−{-# LANGUAGE TypeFamilies #-}
12−{-# LANGUAGE TypeOperators #-}
13−{-# LANGUAGE UndecidableInstances #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+{-# LANGUAGE PolyKinds #-}
14
14
15-------------------------------------------------------------------------------
15-------------------------------------------------------------------------------
16-- | This module lets you get API docs for free. It lets generate
16-- | This module lets you get API docs for free. It lets generate
@@ -37,15 +37,17 @@
37-- Here's a little (but complete) example that you can run to see the
37-- Here's a little (but complete) example that you can run to see the
38-- markdown pretty printer in action:
38-- markdown pretty printer in action:
39--
39--
40−-- > {-# LANGUAGE DataKinds #-}
40+-- > {-# LANGUAGE DataKinds #-}
41−-- > {-# LANGUAGE DeriveGeneric #-}
41+-- > {-# LANGUAGE DeriveGeneric #-}
42−-- > {-# LANGUAGE TypeOperators #-}
43−-- > {-# LANGUAGE FlexibleInstances #-}
42+-- > {-# LANGUAGE FlexibleInstances #-}
43+-- > {-# LANGUAGE MultiParamTypeClasses #-}
44−-- > {-# LANGUAGE OverloadedStrings #-}
44+-- > {-# LANGUAGE OverloadedStrings #-}
45+-- > {-# LANGUAGE TypeOperators #-}
45-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
46-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
46-- > import Data.Aeson
47-- > import Data.Aeson
47-- > import Data.Proxy
48-- > import Data.Proxy
48−-- > import Data.Text(Text)
49+-- > import Data.String.Conversions
50+-- > import Data.Text (Text)
49-- > import GHC.Generics
51-- > import GHC.Generics
50-- > import Servant.API
52-- > import Servant.API
51-- > import Servant.Docs
53-- > import Servant.Docs
@@ -56,9 +58,15 @@
56-- > newtype Greet = Greet Text
58-- > newtype Greet = Greet Text
57-- > deriving (Generic, Show)
59-- > deriving (Generic, Show)
58-- >
60-- >
61+-- > -- | We can get JSON support automatically. This will be used to parse
62+-- > -- and encode a Greeting as 'JSON'.
59-- > instance FromJSON Greet
63-- > instance FromJSON Greet
60-- > instance ToJSON Greet
64-- > instance ToJSON Greet
61-- >
65-- >
66+-- > -- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
67+-- > instance MimeRender PlainText Greet where
68+-- > toByteString Proxy (Greet s) = "\"" <> cs s <> "\""
69+-- >
62-- > -- We add some useful annotations to our captures,
70-- > -- We add some useful annotations to our captures,
63-- > -- query parameters and request body to make the docs
71-- > -- query parameters and request body to make the docs
64-- > -- really helpful.
72-- > -- really helpful.
@@ -91,6 +99,11 @@
91-- > , ("If you use ?capital=false", Greet "Hello, haskeller")
99-- > , ("If you use ?capital=false", Greet "Hello, haskeller")
92-- > ]
100-- > ]
93-- >
101-- >
102+-- > -- We define some introductory sections, these will appear at the top of the
103+-- > -- documentation.
104+-- > --
105+-- > -- We pass them in with 'docsWith', below. If you only want to add
106+-- > -- introductions, you may use 'docsWithIntros'
94-- > intro1 :: DocIntro
107-- > intro1 :: DocIntro
95-- > intro1 = DocIntro "On proper introductions." -- The title
108-- > intro1 = DocIntro "On proper introductions." -- The title
96-- > [ "Hello there."
109-- > [ "Hello there."
@@ -104,8 +117,8 @@
104-- >
117-- >
105-- > -- API specification
118-- > -- API specification
106-- > type TestApi =
119-- > type TestApi =
107−-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON
120+-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
108−-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
121+-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
109-- >
122-- >
110-- > -- POST /greet with a Greet as JSON in the request body,
123-- > -- POST /greet with a Greet as JSON in the request body,
111-- > -- returns a Greet as JSON
124-- > -- returns a Greet as JSON
@@ -117,21 +130,34 @@
117-- > testApi :: Proxy TestApi
130-- > testApi :: Proxy TestApi
118-- > testApi = Proxy
131-- > testApi = Proxy
119-- >
132-- >
133+-- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We
134+-- > -- want to add documentation about a secret unicorn header and some extra
135+-- > -- notes.
136+-- > extra :: ExtraInfo TestApi
137+-- > extra =
138+-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
139+-- > defAction & headers <>~ ["unicorns"]
140+-- > & notes <>~ [ DocNote "Title" ["This is some text"]
141+-- > , DocNote "Second secton" ["And some more"]
142+-- > ]
143+-- >
120-- > -- Generate the data that lets us have API docs. This
144-- > -- Generate the data that lets us have API docs. This
121-- > -- is derived from the type as well as from
145-- > -- is derived from the type as well as from
122-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
146-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
123-- > --
147-- > --
124−-- > -- If you didn't want intros you could just call:
148+-- > -- If you didn't want intros and extra information, you could just call:
125-- > --
149-- > --
126−-- > -- > docs testAPI
150+-- > -- > docs testAPI :: API
127-- > docsGreet :: API
151-- > docsGreet :: API
128−-- > docsGreet = docsWithIntros [intro1, intro2] testApi
152+-- > docsGreet = docsWith [intro1, intro2] extra testApi
129-- >
153-- >
130-- > main :: IO ()
154-- > main :: IO ()
131-- > main = putStrLn $ markdown docsGreet
155-- > main = putStrLn $ markdown docsGreet
132module Servant.Docs
156module Servant.Docs
133 ( -- * 'HasDocs' class and key functions
157 ( -- * 'HasDocs' class and key functions
134− HasDocs(..), docs, docsWithIntros, markdown
158+ HasDocs(..), docs, markdown
159+ -- * Generating docs with extra information
160+ , ExtraInfo(..), docsWith, docsWithIntros, extraInfo
135
161
136 , -- * Classes you need to implement for your types
162 , -- * Classes you need to implement for your types
137 ToSample(..)
163 ToSample(..)
@@ -158,7 +184,7 @@ module Servant.Docs
158 ) where
184 ) where
159
185
160import Control.Applicative
186import Control.Applicative
161−import Control.Lens
187+import Control.Lens hiding (Action)
162import Data.Aeson
188import Data.Aeson
163import Data.ByteString.Lazy.Char8 (ByteString)
189import Data.ByteString.Lazy.Char8 (ByteString)
164import Data.Hashable
190import Data.Hashable
@@ -172,7 +198,9 @@ import Data.String.Conversions
172import Data.Text (Text, pack, unpack)
198import Data.Text (Text, pack, unpack)
173import GHC.Generics
199import GHC.Generics
174import GHC.TypeLits
200import GHC.TypeLits
201+import GHC.Exts(Constraint)
175import Servant.API
202import Servant.API
203+import Servant.Utils.Links
176import Servant.API.ContentTypes
204import Servant.API.ContentTypes
177
205
178import qualified Data.HashMap.Strict as HM
206import qualified Data.HashMap.Strict as HM
@@ -296,6 +324,17 @@ data DocNote = DocNote
296 , _noteBody :: [String]
324 , _noteBody :: [String]
297 } deriving (Eq, Show)
325 } deriving (Eq, Show)
298
326
327+-- | Type of extra information that a user may wish to "union" with their
328+-- documentation.
329+--
330+-- These are intended to be built using extraInfo.
331+-- Multiple ExtraInfo may be combined with the monoid instance.
332+newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
333+instance Monoid (ExtraInfo a) where
334+ mempty = ExtraInfo mempty
335+ ExtraInfo a `mappend` ExtraInfo b =
336+ ExtraInfo $ HM.unionWith combineAction a b
337+
299-- | Type of GET parameter:
338-- | Type of GET parameter:
300--
339--
301-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
340-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
@@ -357,6 +396,16 @@ data Action = Action
357 , _response :: Response -- user supplied
396 , _response :: Response -- user supplied
358 } deriving (Eq, Show)
397 } deriving (Eq, Show)
359
398
399+-- | Combine two Actions, we can't make a monoid as merging Response breaks the
400+-- laws.
401+--
402+-- As such, we invent a non-commutative, left associative operation
403+-- 'combineAction' to mush two together taking the response, body and content
404+-- types from the very left.
405+combineAction :: Action -> Action -> Action
406+Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
407+ Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
408+
360-- Default 'Action'. Has no 'captures', no GET 'params', expects
409-- Default 'Action'. Has no 'captures', no GET 'params', expects
361-- no request body ('rqbody') and the typical response is 'defResponse'.
410-- no request body ('rqbody') and the typical response is 'defResponse'.
362--
411--
@@ -398,10 +447,62 @@ makeLenses ''Action
398docs :: HasDocs layout => Proxy layout -> API
447docs :: HasDocs layout => Proxy layout -> API
399docs p = docsFor p (defEndpoint, defAction)
448docs p = docsFor p (defEndpoint, defAction)
400
449
450+-- | Closed type family, check if endpoint is exactly within API.
451+
452+-- We aren't sure what affects how an Endpoint is built up, so we require an
453+-- exact match.
454+type family IsIn (endpoint :: *) (api :: *) :: Constraint where
455+ IsIn e (sa :<|> sb) = Or (IsIn e sa) (IsIn e sb)
456+ IsIn (e :> sa) (e :> sb) = IsIn sa sb
457+ IsIn e e = ()
458+
459+-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
460+--
461+-- The safety here is to ensure that you only add custom documentation to an
462+-- endpoint that actually exists within your API.
463+--
464+-- > extra :: ExtraInfo TestApi
465+-- > extra =
466+-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
467+-- > defAction & headers <>~ ["unicorns"]
468+-- > & notes <>~ [ DocNote "Title" ["This is some text"]
469+-- > , DocNote "Second secton" ["And some more"]
470+-- > ]
471+
472+extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
473+ => Proxy endpoint -> Action -> ExtraInfo layout
474+extraInfo p action =
475+ let api = docsFor p (defEndpoint, defAction)
476+ -- Assume one endpoint, HasLink constraint means that we should only ever
477+ -- point at one endpoint.
478+ in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
479+
480+-- | Generate documentation given some extra introductions (in the form of
481+-- 'DocInfo') and some extra endpoint documentation (in the form of
482+-- 'ExtraInfo'.
483+--
484+-- The extra introductions will be prepended to the top of the documentation,
485+-- before the specific endpoint documentation. The extra endpoint documentation
486+-- will be "unioned" with the automatically generated endpoint documentation.
487+--
488+-- You are expected to build up the ExtraInfo with the Monoid instance and
489+-- 'extraInfo'.
490+--
491+-- If you only want to add an introduction, use 'docsWithIntros'.
492+docsWith :: HasDocs layout
493+ => [DocIntro]
494+ -> ExtraInfo layout
495+ -> Proxy layout
496+ -> API
497+docsWith intros (ExtraInfo endpoints) p =
498+ docs p & apiIntros <>~ intros
499+ & apiEndpoints %~ HM.unionWith combineAction endpoints
500+
501+
401-- | Generate the docs for a given API that implements 'HasDocs' with with any
502-- | Generate the docs for a given API that implements 'HasDocs' with with any
402-- number of introduction(s)
503-- number of introduction(s)
403docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
504docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
404−docsWithIntros intros p = docs p & apiIntros <>~ intros
505+docsWithIntros intros = docsWith intros mempty
405
506
406-- | The class that abstracts away the impact of API combinators
507-- | The class that abstracts away the impact of API combinators
407-- on documentation generation.
508-- on documentation generation.
@@ -567,10 +668,7 @@ markdown api = unlines $
567 mxParamsStr l =
668 mxParamsStr l =
568 "#### Matrix Parameters:" :
669 "#### Matrix Parameters:" :
569 "" :
670 "" :
570− map segmentStr l ++
671+ map segmentStr l
571− "" :
572− []
573−
574 segmentStr :: (String, [DocQueryParam]) -> String
672 segmentStr :: (String, [DocQueryParam]) -> String
575 segmentStr (segment, l) = unlines $
673 segmentStr (segment, l) = unlines $
576 ("**" ++ segment ++ "**:") :
674 ("**" ++ segment ++ "**:") :
@@ -620,7 +718,7 @@ markdown api = unlines $
620 <> concatMap formatBody samples
718 <> concatMap formatBody samples
621
719
622 formatTypes [] = []
720 formatTypes [] = []
623− formatTypes ts = ["- Supported content types are: ", ""]
721+ formatTypes ts = ["- Supported content types are:", ""]
624 <> map (\t -> " - `" <> show t <> "`") ts
722 <> map (\t -> " - `" <> show t <> "`") ts
625 <> [""]
723 <> [""]
626
724
@@ -639,7 +737,7 @@ markdown api = unlines $
639
737
640 contentStr mime_type body =
738 contentStr mime_type body =
641 "" :
739 "" :
642− "``` " <> markdownForType mime_type :
740+ "```" <> markdownForType mime_type :
643 cs body :
741 cs body :
644 "```" :
742 "```" :
645 "" :
743 "" :