f960d97 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Merge pull request #829 from ivan-m/multiple-content-types

f960d97Alp Mestanogullari9 years ago

doc/tutorial/Docs.lhs+69−27

compare with master

unifiedsplit

@@ -23,6 +23,7 @@ import Network.Wai

23import Servant.API

24import Servant.Docs

25import Servant.Server

26+import Web.FormUrlEncoded(FromForm(..), ToForm(..))

26```

27```

28And we'll import some things from one of our earlier modules

29And we'll import some things from one of our earlier modules

@@ -110,12 +111,6 @@ markdown :: API -> String

110That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`.

111That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`.

111

112

112````````` text

113````````` text

113−## Welcome

114−

115−This is our super webservice's API.

116−

117−Enjoy!

118−

119## GET /hello

114## GET /hello

120

115

121#### GET Parameters:

116#### GET Parameters:

@@ -132,19 +127,20 @@ Enjoy!

132

127

133- Supported content types are:

128- Supported content types are:

134

129

130+ - `application/json;charset=utf-8`

135 - `application/json`

131 - `application/json`

136

132

137−- When a value is provided for 'name'

133+- When a value is provided for 'name' (`application/json;charset=utf-8`, `application/json`):

138

134

139− ```javascript

135+ ```javascript

140− {"msg":"Hello, Alp"}

136+{"msg":"Hello, Alp"}

141− ```

137+ ```

142

138

143−- When 'name' is not specified

139+- When 'name' is not specified (`application/json;charset=utf-8`, `application/json`):

144

140

145− ```javascript

141+ ```javascript

146− {"msg":"Hello, anonymous coward"}

142+{"msg":"Hello, anonymous coward"}

147− ```

143+ ```

148

144

149## POST /marketing

145## POST /marketing

150

146

@@ -152,28 +148,30 @@ Enjoy!

152

148

153- Supported content types are:

149- Supported content types are:

154

150

151+ - `application/json;charset=utf-8`

155 - `application/json`

152 - `application/json`

156

153

157−- Example: `application/json`

154+- Example (`application/json;charset=utf-8`, `application/json`):

158

155

159− ```javascript

156+ ```javascript

160− {"email":"alp@foo.com","interested_in":["haskell","mathematics"],"age":26,"name":"Alp"}

157+{"clientAge":26,"clientEmail":"alp@foo.com","clientName":"Alp","clientInterestedIn":["haskell","mathematics"]}

161− ```

158+ ```

162

159

163#### Response:

160#### Response:

164

161

165−- Status code 201

162+- Status code 200

166- Headers: []

163- Headers: []

167

164

168- Supported content types are:

165- Supported content types are:

169

166

167+ - `application/json;charset=utf-8`

170 - `application/json`

168 - `application/json`

171

169

172−- Response body as below.

170+- Example (`application/json;charset=utf-8`, `application/json`):

173

171

174− ```javascript

172+ ```javascript

175− {"subject":"Hey Alp, we miss you!","body":"Hi Alp,\n\nSince you've recently turned 26, have you checked out our latest haskell, mathematics products? Give us a visit!","to":"alp@foo.com","from":"great@company.com"}

173+{"subject":"Hey Alp, we miss you!","body":"Hi Alp,\n\nSince you've recently turned 26, have you checked out our latest haskell, mathematics products? Give us a visit!","to":"alp@foo.com","from":"great@company.com"}

176− ```

174+ ```

177

175

178## GET /position/:x/:y

176## GET /position/:x/:y

179

177

@@ -189,13 +187,14 @@ Enjoy!

189

187

190- Supported content types are:

188- Supported content types are:

191

189

190+ - `application/json;charset=utf-8`

192 - `application/json`

191 - `application/json`

193

192

194−- Response body as below.

193+- Example (`application/json;charset=utf-8`, `application/json`):

195

194

196− ```javascript

195+ ```javascript

197− {"x":3,"y":14}

196+{"yCoord":14,"xCoord":3}

198− ```

197+ ````

199

198

200`````````

199`````````

201

200

@@ -213,6 +212,49 @@ docsBS = encodeUtf8

213

212

214`docsWithIntros` just takes an additional parameter, a list of `DocIntro`s that must be displayed before any endpoint docs.

213`docsWithIntros` just takes an additional parameter, a list of `DocIntro`s that must be displayed before any endpoint docs.

215

214

215+More customisation can be done with the `markdownWith` function, which allows customising some of the parameters used when generating Markdown. The most obvious of these is how to handle when a request or response body has multiple content types. For example, if we make a slight change to the `/marketing` endpoint of our API so that the request body can also be encoded as a form:

216+

217+``` haskell

218+type ExampleAPI2 = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position

219+ :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage

220+ :<|> "marketing" :> ReqBody '[JSON, FormUrlEncoded] ClientInfo :> Post '[JSON] Email

221+

222+instance ToForm ClientInfo

223+instance FromForm ClientInfo

224+

225+exampleAPI2 :: Proxy ExampleAPI2

226+exampleAPI2 = Proxy

227+

228+api2Docs :: API

229+api2Docs = docs exampleAPI2

230+```

231+

232+The relevant output of `markdown api2Docs` is now:

233+

234+```````` text

235+#### Request:

236+

237+- Supported content types are:

238+

239+ - `application/json;charset=utf-8`

240+ - `application/json`

241+ - `application/x-www-form-urlencoded`

242+

243+- Example (`application/json;charset=utf-8`, `application/json`):

244+

245+ ```javascript

246+{"clientAge":26,"clientEmail":"alp@foo.com","clientName":"Alp","clientInterestedIn":["haskell","mathematics"]}

247+ ```

248+

249+- Example (`application/x-www-form-urlencoded`):

250+

251+ ```

252+clientAge=26&clientEmail=alp%40foo.com&clientName=Alp&clientInterestedIn=haskell&clientInterestedIn=mathematics

253+ ```

254+````````

255+

256+If, however, you don't want the extra example encoding shown, then you can use `markdownWith (defRenderingOptions & requestExamples .~ FirstContentType)` to get behaviour identical to `markdown apiDocs`.

257+

216We can now serve the API *and* the API docs with a simple server.

258We can now serve the API *and* the API docs with a simple server.

217

259

218``` haskell

260``` haskell

doc/tutorial/tutorial.cabal+1

@@ -31,6 +31,7 @@ library

31 , servant-docs == 0.11.*

32 , servant-js >= 0.9 && <0.10

33 , warp

34+ , http-api-data

34 , http-media

35 , http-media

35 , lucid

36 , lucid

36 , time

37 , time

servant-docs/CHANGELOG.md+2

@@ -7,6 +7,8 @@

7* Document the HTTP Method the parameters of an endpoint belong to

8 (rather than assuming `GET` for all of them).

9* Content type of sample response body is also displayed.

10+* Can now control how many content-types for each example are shown

11+ with `markdownWith` and `RenderingOptions`.

110.11

130.11

12----

14----

servant-docs/servant-docs.cabal+1−1

@@ -49,7 +49,7 @@ library

49 , control-monad-omega == 0.3.*

50 if !impl(ghc >= 8.0)

51 build-depends:

52− semigroups >=0.16.2.2 && <0.19

52+ semigroups >=0.17 && <0.19

53 hs-source-dirs: src

54 default-language: Haskell2010

55 ghc-options: -Wall

servant-docs/src/Servant/Docs.hs+3

@@ -24,6 +24,9 @@

24module Servant.Docs

25 ( -- * 'HasDocs' class and key functions

26 HasDocs(..), docs, pretty, markdown

27+ -- ** Customising generated documentation

28+ , markdownWith, RenderingOptions(..), defRenderingOptions

29+ , requestExamples, responseExamples, ShowContentTypes(..)

27 -- * Generating docs with extra information

30 -- * Generating docs with extra information

28 , docsWith, docsWithIntros, docsWithOptions

31 , docsWith, docsWithIntros, docsWithOptions

29 , ExtraInfo(..), extraInfo

32 , ExtraInfo(..), extraInfo

servant-docs/src/Servant/Docs/Internal.hs+102−15

@@ -20,24 +20,31 @@

20#include "overlapping-compat.h"

21module Servant.Docs.Internal where

23−import Prelude ()

23+import Prelude ()

24import Prelude.Compat

25+

25import Control.Applicative

26import Control.Applicative

26import Control.Arrow (second)

27import Control.Arrow (second)

27−import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),

28+import Control.Lens (makeLenses, mapped, over,

29+ traversed, view, (%~), (&), (.~),

28− (&), (.~), (<>~), (^.), (|>))

30+ (<>~), (^.), (|>))

29import qualified Control.Monad.Omega as Omega

31import qualified Control.Monad.Omega as Omega

30−import Data.ByteString.Lazy.Char8 (ByteString)

31import qualified Data.ByteString.Char8 as BSC

32import qualified Data.ByteString.Char8 as BSC

33+import Data.ByteString.Lazy.Char8 (ByteString)

32import qualified Data.CaseInsensitive as CI

34import qualified Data.CaseInsensitive as CI

35+import Data.Foldable (fold)

33import Data.Hashable (Hashable)

36import Data.Hashable (Hashable)

34import Data.HashMap.Strict (HashMap)

37import Data.HashMap.Strict (HashMap)

35import Data.List.Compat (intercalate, intersperse, sort)

38import Data.List.Compat (intercalate, intersperse, sort)

39+import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)

40+import qualified Data.List.NonEmpty as NE

36import Data.Maybe

41import Data.Maybe

37−import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..))

42+import Data.Monoid (All (..), Any (..), Dual (..),

38−import Data.Semigroup (Semigroup (..))

43+ First (..), Last (..),

44+ Product (..), Sum (..))

39import Data.Ord (comparing)

45import Data.Ord (comparing)

40−import Data.Proxy (Proxy(Proxy))

46+import Data.Proxy (Proxy (Proxy))

47+import Data.Semigroup (Semigroup (..))

41import Data.String.Conversions (cs)

48import Data.String.Conversions (cs)

42import Data.Text (Text, unpack)

49import Data.Text (Text, unpack)

43import GHC.Generics

50import GHC.Generics

@@ -291,6 +298,35 @@ defAction =

291single :: Endpoint -> Action -> API

298single :: Endpoint -> Action -> API

292single e a = API mempty (HM.singleton e a)

299single e a = API mempty (HM.singleton e a)

293

300

301+-- | How many content-types for each example should be shown?

302+--

303+-- @since 0.11.1

304+data ShowContentTypes = AllContentTypes -- ^ For each example, show each content type.

305+ | FirstContentType -- ^ For each example, show only one content type.

306+ deriving (Eq, Ord, Show, Read, Bounded, Enum)

307+

308+-- | Customise how an 'API' is converted into documentation.

309+--

310+-- @since 0.11.1

311+data RenderingOptions = RenderingOptions

312+ { _requestExamples :: !ShowContentTypes

313+ -- ^ How many content types to display for request body examples?

314+ , _responseExamples :: !ShowContentTypes

315+ -- ^ How many content types to display for response body examples?

316+ } deriving (Show)

317+

318+-- | Default API generation options.

319+--

320+-- All content types are shown for both 'requestExamples' and

321+-- 'responseExamples'.

322+--

323+-- @since 0.11.1

324+defRenderingOptions :: RenderingOptions

325+defRenderingOptions = RenderingOptions

326+ { _requestExamples = AllContentTypes

327+ , _responseExamples = AllContentTypes

328+ }

329+

294-- gimme some lenses

330-- gimme some lenses

295makeLenses ''DocAuthentication

331makeLenses ''DocAuthentication

296makeLenses ''DocOptions

332makeLenses ''DocOptions

@@ -302,6 +338,7 @@ makeLenses ''DocIntro

302makeLenses ''DocNote

338makeLenses ''DocNote

303makeLenses ''Response

339makeLenses ''Response

304makeLenses ''Action

340makeLenses ''Action

341+makeLenses ''RenderingOptions

305

342

306-- | Generate the docs for a given API that implements 'HasDocs'. This is the

343-- | Generate the docs for a given API that implements 'HasDocs'. This is the

307-- default way to create documentation.

344-- default way to create documentation.

@@ -517,8 +554,34 @@ class ToAuthInfo a where

517

554

518-- | Generate documentation in Markdown format for

555-- | Generate documentation in Markdown format for

519-- the given 'API'.

556-- the given 'API'.

557+--

558+-- This is equivalent to @'markdownWith' 'defRenderingOptions'@.

520markdown :: API -> String

559markdown :: API -> String

521−markdown api = unlines $

560+markdown = markdownWith defRenderingOptions

561+

562+-- | Generate documentation in Markdown format for

563+-- the given 'API' using the specified options.

564+--

565+-- These options allow you to customise aspects such as:

566+--

567+-- * Choose how many content-types for each request body example are

568+-- shown with 'requestExamples'.

569+--

570+-- * Choose how many content-types for each response body example

571+-- are shown with 'responseExamples'.

572+--

573+-- For example, to only show the first content-type of each example:

574+--

575+-- @

576+-- markdownWith ('defRenderingOptions'

577+-- & 'requestExamples' '.~' 'FirstContentType'

578+-- & 'responseExamples' '.~' 'FirstContentType' )

579+-- myAPI

580+-- @

581+--

582+-- @since 0.11.1

583+markdownWith :: RenderingOptions -> API -> String

584+markdownWith RenderingOptions{..} api = unlines $

522 introsStr (api ^. apiIntros)

585 introsStr (api ^. apiIntros)

523 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)

586 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)

524

587

@@ -632,31 +695,55 @@ markdown api = unlines $

632 rqbodyStr types s =

695 rqbodyStr types s =

633 ["#### Request:", ""]

696 ["#### Request:", ""]

634 <> formatTypes types

697 <> formatTypes types

635− <> concatMap formatBody s

698+ <> formatBodies _requestExamples s

636

699

637 formatTypes [] = []

700 formatTypes [] = []

638 formatTypes ts = ["- Supported content types are:", ""]

701 formatTypes ts = ["- Supported content types are:", ""]

639 <> map (\t -> " - `" <> show t <> "`") ts

702 <> map (\t -> " - `" <> show t <> "`") ts

640 <> [""]

703 <> [""]

641

704

642− formatBody (t, m, b) =

705+ -- This assumes that when the bodies are created, identical

706+ -- labels and representations are located next to each other.

707+ formatBodies :: ShowContentTypes -> [(Text, M.MediaType, ByteString)] -> [String]

708+ formatBodies ex bds = concatMap formatBody (select bodyGroups)

709+ where

710+ bodyGroups :: [(Text, NonEmpty M.MediaType, ByteString)]

711+ bodyGroups =

712+ map (\grps -> let (t,_,b) = NE.head grps in (t, fmap (\(_,m,_) -> m) grps, b))

713+ . groupWith (\(t,_,b) -> (t,b))

714+ $ bds

715+

716+ select = case ex of

717+ AllContentTypes -> id

718+ FirstContentType -> map (\(t,ms,b) -> (t, NE.head ms :| [], b))

719+

720+ formatBody :: (Text, NonEmpty M.MediaType, ByteString) -> [String]

721+ formatBody (t, ms, b) =

722+ "- " <> title <> " (" <> mediaList ms <> "):" :

723+ contentStr (NE.head ms) b

724+ where

725+ mediaList = fold . NE.intersperse ", " . fmap (\m -> "`" ++ show m ++ "`")

726+

727+ title

643− "- Example (" <> cs t <> "): `" <> cs (show m) <> "`" :

728+ | T.null t = "Example"

644− contentStr m b

729+ | otherwise = cs t

645

730

646 markdownForType mime_type =

731 markdownForType mime_type =

647 case (M.mainType mime_type, M.subType mime_type) of

732 case (M.mainType mime_type, M.subType mime_type) of

648 ("text", "html") -> "html"

733 ("text", "html") -> "html"

649 ("application", "xml") -> "xml"

734 ("application", "xml") -> "xml"

735+ ("text", "xml") -> "xml"

650 ("application", "json") -> "javascript"

736 ("application", "json") -> "javascript"

651 ("application", "javascript") -> "javascript"

737 ("application", "javascript") -> "javascript"

652 ("text", "css") -> "css"

738 ("text", "css") -> "css"

653 (_, _) -> ""

739 (_, _) -> ""

654

740

741+

655 contentStr mime_type body =

742 contentStr mime_type body =

656 "" :

743 "" :

657− "```" <> markdownForType mime_type :

744+ " ```" <> markdownForType mime_type :

658 cs body :

745 cs body :

659− "```" :

746+ " ```" :

660 "" :

747 "" :

661 []

748 []

662

749

@@ -674,7 +761,7 @@ markdown api = unlines $

674 [] -> ["- No response body\n"]

761 [] -> ["- No response body\n"]

675 [("", t, r)] -> "- Response body as below." : contentStr t r

762 [("", t, r)] -> "- Response body as below." : contentStr t r

676 xs ->

763 xs ->

677− concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx <> " (`" <> cs (show t) <> "`)") : contentStr t r) xs

764+ formatBodies _responseExamples xs

678

765

679-- * Instances

766-- * Instances

680

767

stack-ghc-7.8.4.yaml+2

@@ -23,9 +23,11 @@ extra-deps:

23- http-client-0.4.30

24- natural-transformation-0.4

25- primitive-0.6.1.0

26+- semigroups-0.17

26- servant-js-0.9.3

27- servant-js-0.9.3

27- should-not-typecheck-2.1.0

28- should-not-typecheck-2.1.0

28- time-locale-compat-0.1.1.1

29- time-locale-compat-0.1.1.1

29- uri-bytestring-0.2.2.0

30- uri-bytestring-0.2.2.0

31+- void-0.7.1

30- wai-app-static-3.1.5

32- wai-app-static-3.1.5

31resolver: lts-2.22

33resolver: lts-2.22