0556556 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge remote-tracking branch 'origin/master' into wip-note-api

0556556Christian Marie12 years ago

README.md+8−3

compare with master

unifiedsplit

@@ -27,10 +27,15 @@ import Servant

27data Greet = Greet { _msg :: Text }

28 deriving (Generic, Show)

30−-- we get our JSON serialization for free

30+-- we get our JSON serialization for free. This will be used by the default

31+-- 'MimeRender' instance for 'JSON'.

31instance FromJSON Greet

32instance FromJSON Greet

32instance ToJSON Greet

33instance ToJSON Greet

35+-- We can also implement 'MimeRender' explicitly for additional formats.

36+instance MimeRender PlainText Greet where

37+ toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"

38+

34-- we provide a sample value for the 'Greet' type

39-- we provide a sample value for the 'Greet' type

35instance ToSample Greet where

40instance ToSample Greet where

36 toSample = Just g

41 toSample = Just g

@@ -51,8 +56,8 @@ instance ToCapture (Capture "greetid" Text) where

52-- API specification

57-- API specification

53type TestApi =

58type TestApi =

54− "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet

59+ "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON,PlainText] Greet

55− :<|> "greet" :> RQBody Greet :> Post Greet

60+ :<|> "greet" :> RQBody '[JSON] Greet :> Post '[JSON] Greet

56 :<|> "delete" :> Capture "greetid" Text :> Delete

61 :<|> "delete" :> Capture "greetid" Text :> Delete

58testApi :: Proxy TestApi

63testApi :: Proxy TestApi

example/greet.hs+17−9

@@ -1,12 +1,14 @@

1−{-# LANGUAGE DataKinds #-}

1+{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

2+{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE TypeOperators #-}

4−{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

5−{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE TypeOperators #-}

6{-# OPTIONS_GHC -fno-warn-orphans #-}

7{-# OPTIONS_GHC -fno-warn-orphans #-}

7import Data.Aeson

8import Data.Aeson

8import Data.Proxy

9import Data.Proxy

9−import Data.Text(Text)

10+import Data.String.Conversions

11+import Data.Text (Text)

10import GHC.Generics

12import GHC.Generics

11import Servant.API

13import Servant.API

12import Servant.Docs

14import Servant.Docs

@@ -17,9 +19,15 @@ import Servant.Docs

17newtype Greet = Greet Text

19newtype Greet = Greet Text

18 deriving (Generic, Show)

20 deriving (Generic, Show)

22+-- | We can get JSON support automatically. This will be used to parse

23+-- and encode a Greeting as 'JSON'.

20instance FromJSON Greet

24instance FromJSON Greet

21instance ToJSON Greet

25instance ToJSON Greet

27+-- | We can also implement 'MimeRender' for additional formats like 'PlainText'.

28+instance MimeRender PlainText Greet where

29+ toByteString Proxy (Greet s) = "\"" <> cs s <> "\""

30+

23-- We add some useful annotations to our captures,

31-- We add some useful annotations to our captures,

24-- query parameters and request body to make the docs

32-- query parameters and request body to make the docs

25-- really helpful.

33-- really helpful.

@@ -70,12 +78,12 @@ intro2 = DocIntro "This title is below the last"

71-- API specification

79-- API specification

72type TestApi =

80type TestApi =

73− -- GET /hello/:name?capital={true, false} returns a Greet as JSON

81+ -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText

74− "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet

82+ "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet

76 -- POST /greet with a Greet as JSON in the request body,

84 -- POST /greet with a Greet as JSON in the request body,

77 -- returns a Greet as JSON

85 -- returns a Greet as JSON

78− :<|> "greet" :> ReqBody Greet :> Post Greet

86+ :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet

80 -- DELETE /greet/:greetid

88 -- DELETE /greet/:greetid

81 :<|> "greet" :> Capture "greetid" Text :> Delete

89 :<|> "greet" :> Capture "greetid" Text :> Delete

example/greet.md+46−16

@@ -10,24 +10,35 @@ You'll also note that multiple intros are possible.

11## POST /greet

13−#### Request Body:

13+#### Request:

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```

19#### Response:

25#### Response:

21− - Status code 201

27+- Status code 201

22− - If you use ?capital=true

28+

29+- Supported content types are:

30+

31+ - `application/json`

33+- If you use ?capital=true

34+

24−``` javascript

35+```javascript

25"HELLO, HASKELLER"

36"HELLO, HASKELLER"

26```

37```

28− - If you use ?capital=false

39+- If you use ?capital=false

30−``` javascript

41+```javascript

31"Hello, haskeller"

42"Hello, haskeller"

32```

43```

@@ -41,7 +52,7 @@ You'll also note that multiple intros are possible.

42**hello**:

53**hello**:

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.

@@ -49,23 +60,41 @@ You'll also note that multiple intros are possible.

50#### GET Parameters:

61#### GET Parameters:

52− - capital

63+- capital

53 - **Values**: *true, false*

64 - **Values**: *true, false*

54 - **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.

57#### Response:

68#### Response:

59− - Status code 200

70+- Status code 200

71+

72+- Supported content types are:

73+

74+ - `application/json`

75+ - `text/plain;charset=utf-8`

76+

77+- If you use ?capital=true

78+

79+```javascript

80+"HELLO, HASKELLER"

81+```

82+

60− - If you use ?capital=true

83+- If you use ?capital=true

62−``` javascript

85+```

63"HELLO, HASKELLER"

86"HELLO, HASKELLER"

64```

87```

89+- If you use ?capital=false

90+

91+```javascript

92+"Hello, haskeller"

93+```

94+

66− - If you use ?capital=false

95+- If you use ?capital=false

68−``` javascript

97+```

69"Hello, haskeller"

98"Hello, haskeller"

70```

99```

100

@@ -88,7 +117,8 @@ And some more

117

89#### Response:

118#### Response:

119

91− - Status code 200

120+- Status code 200

121+

92− - No response body

122+- No response body

123

124

servant-docs.cabal+2−3

@@ -29,13 +29,12 @@ library

29 build-depends:

30 base >=4.7 && <5

31 , aeson

32− , aeson-pretty < 0.8

33 , bytestring

32 , bytestring

34 , hashable

33 , hashable

34+ , http-media

35 , lens

36 , servant >= 0.2.1

37 , string-conversions

38− , system-filepath

39 , text

38 , text

40 , unordered-containers

39 , unordered-containers

41 hs-source-dirs: src

40 hs-source-dirs: src

@@ -46,5 +45,5 @@ executable greet-docs

46 main-is: greet.hs

45 main-is: greet.hs

47 hs-source-dirs: example

46 hs-source-dirs: example

48 ghc-options: -Wall

47 ghc-options: -Wall

49− build-depends: base, aeson, servant, servant-docs, text

48+ build-depends: base, aeson, servant, servant-docs, string-conversions, text

50 default-language: Haskell2010

49 default-language: Haskell2010

src/Servant/Docs.hs+149−77

@@ -37,15 +37,17 @@

37-- Here's a little (but complete) example that you can run to see the

38-- markdown pretty printer in action:

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.

@@ -109,12 +117,12 @@

109-- >

117-- >

110-- > -- API specification

118-- > -- API specification

111-- > type TestApi =

119-- > type TestApi =

112−-- > -- 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

113−-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet

121+-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet

114-- >

122-- >

115-- > -- POST /greet with a Greet as JSON in the request body,

123-- > -- POST /greet with a Greet as JSON in the request body,

116-- > -- returns a Greet as JSON

124-- > -- returns a Greet as JSON

117−-- > :<|> "greet" :> ReqBody Greet :> Post Greet

125+-- > :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet

118-- >

126-- >

119-- > -- DELETE /greet/:greetid

127-- > -- DELETE /greet/:greetid

120-- > :<|> "greet" :> Capture "greetid" Text :> Delete

128-- > :<|> "greet" :> Capture "greetid" Text :> Delete

@@ -166,8 +174,8 @@ module Servant.Docs

166 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind

174 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind

167 , DocNote(..), noteTitle, noteBody

175 , DocNote(..), noteTitle, noteBody

168 , DocIntro(..)

176 , DocIntro(..)

169− , Response, respStatus, respBody, defResponse

177+ , Response, respStatus, respTypes, respBody, defResponse

170− , Action, captures, headers, notes, params, rqbody, response, defAction

178+ , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction

171 , single

179 , single

172

180

173 , -- * Useful modules when defining your doc printers

181 , -- * Useful modules when defining your doc printers

@@ -175,27 +183,29 @@ module Servant.Docs

175 , module Data.Monoid

183 , module Data.Monoid

176 ) where

184 ) where

177

185

186+import Control.Applicative

178import Control.Lens hiding (Action)

187import Control.Lens hiding (Action)

179import Data.Aeson

188import Data.Aeson

180−import Data.Aeson.Encode.Pretty (encodePretty)

181−import Data.Ord(comparing)

182import Data.ByteString.Lazy.Char8 (ByteString)

189import Data.ByteString.Lazy.Char8 (ByteString)

183import Data.Hashable

190import Data.Hashable

184import Data.HashMap.Strict (HashMap)

191import Data.HashMap.Strict (HashMap)

185import Data.List

192import Data.List

186−import Data.Maybe (listToMaybe)

193+import Data.Maybe

187import Data.Monoid

194import Data.Monoid

195+import Data.Ord (comparing)

188import Data.Proxy

196import Data.Proxy

189−import Data.Text (Text, pack, unpack)

190import Data.String.Conversions

197import Data.String.Conversions

198+import Data.Text (Text, pack, unpack)

191import GHC.Generics

199import GHC.Generics

192import GHC.TypeLits

200import GHC.TypeLits

193import GHC.Exts(Constraint)

201import GHC.Exts(Constraint)

194import Servant.API

202import Servant.API

195import Servant.Utils.Links

203import Servant.Utils.Links

204+import Servant.API.ContentTypes

196

205

197import qualified Data.HashMap.Strict as HM

206import qualified Data.HashMap.Strict as HM

198−import qualified Data.Text as T

207+import qualified Data.Text as T

208+import qualified Network.HTTP.Media as M

199

209

200-- | Supported HTTP request methods

210-- | Supported HTTP request methods

201data Method = DocDELETE -- ^ the DELETE method

211data Method = DocDELETE -- ^ the DELETE method

@@ -333,23 +343,25 @@ instance Monoid (ExtraInfo a) where

333data ParamKind = Normal | List | Flag

343data ParamKind = Normal | List | Flag

334 deriving (Eq, Show)

344 deriving (Eq, Show)

335

345

336−-- | A type to represent an HTTP response. Has an 'Int' status and

346+-- | A type to represent an HTTP response. Has an 'Int' status, a list of

347+-- possible 'MediaType's, and a list of example 'ByteString' response bodies.

337−-- a 'Maybe ByteString' response body. Tweak 'defResponse' using

348+-- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'

338−-- the 'respStatus' and 'respBody' lenses if you want.

349+-- lenses if you want.

339--

350--

340-- If you want to respond with a non-empty response body, you'll most likely

351-- If you want to respond with a non-empty response body, you'll most likely

341-- want to write a 'ToSample' instance for the type that'll be represented

352-- want to write a 'ToSample' instance for the type that'll be represented

342−-- as some JSON in the response.

353+-- as encoded data in the response.

343--

354--

344−-- Can be tweaked with two lenses.

355+-- Can be tweaked with three lenses.

345--

356--

346-- > λ> defResponse

357-- > λ> defResponse

347−-- > Response {_respStatus = 200, _respBody = []}

358+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}

348-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]

359-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]

349−-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}

360+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}

350data Response = Response

361data Response = Response

351 { _respStatus :: Int

362 { _respStatus :: Int

363+ , _respTypes :: [M.MediaType]

352− , _respBody :: [(Text, ByteString)]

364+ , _respBody :: [(Text, M.MediaType, ByteString)]

353 } deriving (Eq, Show)

365 } deriving (Eq, Show)

354

366

355-- | Default response: status code 200, no response body.

367-- | Default response: status code 200, no response body.

@@ -361,7 +373,7 @@ data Response = Response

361-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"

373-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"

362-- > Response {_respStatus = 204, _respBody = Just "[]"}

374-- > Response {_respStatus = 204, _respBody = Just "[]"}

363defResponse :: Response

375defResponse :: Response

364−defResponse = Response 200 []

376+defResponse = Response 200 [] []

365

377

366-- | A datatype that represents everything that can happen

378-- | A datatype that represents everything that can happen

367-- at an endpoint, with its lenses:

379-- at an endpoint, with its lenses:

@@ -374,23 +386,25 @@ defResponse = Response 200 []

374-- You can tweak an 'Action' (like the default 'defAction') with these lenses

386-- You can tweak an 'Action' (like the default 'defAction') with these lenses

375-- to transform an action and add some information to it.

387-- to transform an action and add some information to it.

376data Action = Action

388data Action = Action

377− { _captures :: [DocCapture] -- type collected + user supplied info

389+ { _captures :: [DocCapture] -- type collected + user supplied info

378− , _headers :: [Text] -- type collected

390+ , _headers :: [Text] -- type collected

379− , _params :: [DocQueryParam] -- type collected + user supplied info

380− , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info

391+ , _params :: [DocQueryParam] -- type collected + user supplied info

381− , _notes :: [DocNote] -- user supplied

392+ , _notes :: [DocNote] -- user supplied

393+ , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info

394+ , _rqtypes :: [M.MediaType] -- type collected

382− , _rqbody :: Maybe ByteString -- user supplied

395+ , _rqbody :: [(M.MediaType, ByteString)] -- user supplied

383− , _response :: Response -- user supplied

396+ , _response :: Response -- user supplied

384 } deriving (Eq, Show)

397 } deriving (Eq, Show)

385

398

386-- | Combine two Actions, we can't make a monoid as merging Response breaks the

399-- | Combine two Actions, we can't make a monoid as merging Response breaks the

387-- laws.

400-- laws.

388--

401--

389-- As such, we invent a non-commutative, left associative operation

402-- As such, we invent a non-commutative, left associative operation

390−-- 'combineAction' to mush two together taking the response from the very left.

403+-- 'combineAction' to mush two together taking the response, body and content

404+-- types from the very left.

391combineAction :: Action -> Action -> Action

405combineAction :: Action -> Action -> Action

392−Action c h p m n r resp `combineAction` Action c' h' p' m' n' r' _ =

406+Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =

393− Action (c <> c') (h <> h') (p <> p') (m <> m') (n <> n') (r <> r') resp

407+ Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp

394

408

395-- Default 'Action'. Has no 'captures', no GET 'params', expects

409-- Default 'Action'. Has no 'captures', no GET 'params', expects

396-- no request body ('rqbody') and the typical response is 'defResponse'.

410-- no request body ('rqbody') and the typical response is 'defResponse'.

@@ -408,7 +422,8 @@ defAction =

408 []

422 []

409 []

423 []

410 []

424 []

411− Nothing

425+ []

426+ []

412 defResponse

427 defResponse

413

428

414-- | Create an API that's comprised of a single endpoint.

429-- | Create an API that's comprised of a single endpoint.

@@ -455,7 +470,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where

455-- > ]

470-- > ]

456

471

457extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)

472extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)

458− => Proxy endpoint -> Action -> ExtraInfo layout

473+ => Proxy endpoint -> Action -> ExtraInfo layout

459extraInfo p action =

474extraInfo p action =

460 let api = docsFor p (defEndpoint, defAction)

475 let api = docsFor p (defEndpoint, defAction)

461 -- Assume one endpoint, HasLink constraint means that we should only ever

476 -- Assume one endpoint, HasLink constraint means that we should only ever

@@ -527,20 +542,46 @@ class HasDocs layout where

527class ToJSON a => ToSample a where

542class ToJSON a => ToSample a where

528 {-# MINIMAL (toSample | toSamples) #-}

543 {-# MINIMAL (toSample | toSamples) #-}

529 toSample :: Maybe a

544 toSample :: Maybe a

530− toSample = fmap snd $ listToMaybe samples

545+ toSample = snd <$> listToMaybe samples

531 where samples = toSamples :: [(Text, a)]

546 where samples = toSamples :: [(Text, a)]

532

547

533 toSamples :: [(Text, a)]

548 toSamples :: [(Text, a)]

534 toSamples = maybe [] (return . ("",)) s

549 toSamples = maybe [] (return . ("",)) s

535 where s = toSample :: Maybe a

550 where s = toSample :: Maybe a

536

551

552+-- | Synthesise a sample value of a type, encoded in the specified media types.

537−sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString

553+sampleByteString

554+ :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)

555+ => Proxy ctypes

556+ -> Proxy a

557+ -> [(M.MediaType, ByteString)]

538−sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)

558+sampleByteString ctypes@Proxy Proxy =

539−

559+ maybe [] (allMimeRender ctypes) (toSample :: Maybe a)

560+

561+-- | Synthesise a list of sample values of a particular type, encoded in the

562+-- specified media types.

540−sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)]

563+sampleByteStrings

564+ :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)

565+ => Proxy ctypes

566+ -> Proxy a

567+ -> [(Text, M.MediaType, ByteString)]

541−sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty

568+sampleByteStrings ctypes@Proxy Proxy =

542−

569+ let samples = toSamples :: [(Text, a)]

543− where samples = toSamples :: [(Text, a)]

570+ enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s

571+ in concatMap enc samples

572+

573+-- | Generate a list of 'MediaType' values describing the content types

574+-- accepted by an API component.

575+class SupportedTypes (list :: [*]) where

576+ supportedTypes :: Proxy list -> [M.MediaType]

577+

578+instance SupportedTypes '[] where

579+ supportedTypes Proxy = []

580+

581+instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)

582+ where

583+ supportedTypes Proxy =

584+ contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)

544

585

545-- | The class that helps us automatically get documentation

586-- | The class that helps us automatically get documentation

546-- for GET parameters.

587-- for GET parameters.

@@ -581,7 +622,7 @@ markdown api = unlines $

581 mxParamsStr (action ^. mxParams) ++

622 mxParamsStr (action ^. mxParams) ++

582 headersStr (action ^. headers) ++

623 headersStr (action ^. headers) ++

583 paramsStr (action ^. params) ++

624 paramsStr (action ^. params) ++

584− rqbodyStr (action ^. rqbody) ++

625+ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++

585 responseStr (action ^. response) ++

626 responseStr (action ^. response) ++

586 []

627 []

587

628

@@ -595,7 +636,7 @@ markdown api = unlines $

595 introStr i =

636 introStr i =

596 ("#### " ++ i ^. introTitle) :

637 ("#### " ++ i ^. introTitle) :

597 "" :

638 "" :

598− intersperse "" (i ^. introBody) ++

639+ intersperse "" (i ^. introBody) ++

599 "" :

640 "" :

600 []

641 []

601

642

@@ -618,6 +659,7 @@ markdown api = unlines $

618 map captureStr l ++

659 map captureStr l ++

619 "" :

660 "" :

620 []

661 []

662+

621 captureStr cap =

663 captureStr cap =

622 "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

664 "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

623

665

@@ -650,8 +692,9 @@ markdown api = unlines $

650 map paramStr l ++

692 map paramStr l ++

651 "" :

693 "" :

652 []

694 []

695+

653 paramStr param = unlines $

696 paramStr param = unlines $

654− (" - " ++ param ^. paramName) :

697+ ("- " ++ param ^. paramName) :

655 (if (not (null values) || param ^. paramKind /= Flag)

698 (if (not (null values) || param ^. paramKind /= Flag)

656 then [" - **Values**: *" ++ intercalate ", " values ++ "*"]

699 then [" - **Values**: *" ++ intercalate ", " values ++ "*"]

657 else []) ++

700 else []) ++

@@ -667,16 +710,35 @@ markdown api = unlines $

667

710

668 where values = param ^. paramValues

711 where values = param ^. paramValues

669

712

670− rqbodyStr :: Maybe ByteString -> [String]

713+ rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]

671− rqbodyStr Nothing = []

714+ rqbodyStr [] [] = []

672− rqbodyStr (Just b) =

715+ rqbodyStr types samples =

673− "#### Request Body:" :

716+ ["#### Request:", ""]

674− jsonStr b

717+ <> formatTypes types

675−

718+ <> concatMap formatBody samples

676− jsonStr b =

719+

720+ formatTypes [] = []

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

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

723+ <> [""]

724+

725+ formatBody (m, b) =

726+ "- Example: `" <> cs (show m) <> "`" :

727+ contentStr m b

728+

729+ markdownForType mime_type =

730+ case (M.mainType mime_type, M.subType mime_type) of

731+ ("text", "html") -> "html"

732+ ("application", "xml") -> "xml"

733+ ("application", "json") -> "javascript"

734+ ("application", "javascript") -> "javascript"

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

736+ (_, _) -> ""

737+

738+ contentStr mime_type body =

677 "" :

739 "" :

678− "``` javascript" :

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

679− cs b :

741+ cs body :

680 "```" :

742 "```" :

681 "" :

743 "" :

682 []

744 []

@@ -685,14 +747,16 @@ markdown api = unlines $

685 responseStr resp =

747 responseStr resp =

686 "#### Response:" :

748 "#### Response:" :

687 "" :

749 "" :

688− (" - Status code " ++ show (resp ^. respStatus)) :

750+ ("- Status code " ++ show (resp ^. respStatus)) :

751+ "" :

752+ formatTypes (resp ^. respTypes) ++

689 bodies

753 bodies

690

754

691 where bodies = case resp ^. respBody of

755 where bodies = case resp ^. respBody of

692− [] -> [" - No response body\n"]

756+ [] -> ["- No response body\n"]

693− [("", r)] -> " - Response body as below." : jsonStr r

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

694 xs ->

758 xs ->

695− concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs

759+ concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs

696

760

697-- * Instances

761-- * Instances

698

762

@@ -734,12 +798,15 @@ instance HasDocs Delete where

734 action' = action & response.respBody .~ []

798 action' = action & response.respBody .~ []

735 & response.respStatus .~ 204

799 & response.respStatus .~ 204

736

800

801+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)

737−instance ToSample a => HasDocs (Get a) where

802+ => HasDocs (Get cts a) where

738 docsFor Proxy (endpoint, action) =

803 docsFor Proxy (endpoint, action) =

739 single endpoint' action'

804 single endpoint' action'

740

805

741 where endpoint' = endpoint & method .~ DocGET

806 where endpoint' = endpoint & method .~ DocGET

742− action' = action & response.respBody .~ sampleByteStrings p

807+ action' = action & response.respBody .~ sampleByteStrings t p

808+ & response.respTypes .~ supportedTypes t

809+ t = Proxy :: Proxy cts

743 p = Proxy :: Proxy a

810 p = Proxy :: Proxy a

744

811

745instance (KnownSymbol sym, HasDocs sublayout)

812instance (KnownSymbol sym, HasDocs sublayout)

@@ -751,29 +818,30 @@ instance (KnownSymbol sym, HasDocs sublayout)

751 action' = over headers (|> headername) action

818 action' = over headers (|> headername) action

752 headername = pack $ symbolVal (Proxy :: Proxy sym)

819 headername = pack $ symbolVal (Proxy :: Proxy sym)

753

820

821+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)

754−instance ToSample a => HasDocs (Post a) where

822+ => HasDocs (Post cts a) where

755 docsFor Proxy (endpoint, action) =

823 docsFor Proxy (endpoint, action) =

756 single endpoint' action'

824 single endpoint' action'

757

825

758 where endpoint' = endpoint & method .~ DocPOST

826 where endpoint' = endpoint & method .~ DocPOST

759−

760− action' = action & response.respBody .~ sampleByteStrings p

827+ action' = action & response.respBody .~ sampleByteStrings t p

828+ & response.respTypes .~ supportedTypes t

761 & response.respStatus .~ 201

829 & response.respStatus .~ 201

762−

830+ t = Proxy :: Proxy cts

763 p = Proxy :: Proxy a

831 p = Proxy :: Proxy a

764

832

833+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)

765−instance ToSample a => HasDocs (Put a) where

834+ => HasDocs (Put cts a) where

766 docsFor Proxy (endpoint, action) =

835 docsFor Proxy (endpoint, action) =

767 single endpoint' action'

836 single endpoint' action'

768

837

769 where endpoint' = endpoint & method .~ DocPUT

838 where endpoint' = endpoint & method .~ DocPUT

770−

771− action' = action & response.respBody .~ sampleByteStrings p

839+ action' = action & response.respBody .~ sampleByteStrings t p

840+ & response.respTypes .~ supportedTypes t

772 & response.respStatus .~ 200

841 & response.respStatus .~ 200

773−

842+ t = Proxy :: Proxy cts

774 p = Proxy :: Proxy a

843 p = Proxy :: Proxy a

775

844

776−

777instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)

845instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)

778 => HasDocs (QueryParam sym a :> sublayout) where

846 => HasDocs (QueryParam sym a :> sublayout) where

779

847

@@ -848,20 +916,24 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)

848 endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint

916 endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint

849 symP = Proxy :: Proxy sym

917 symP = Proxy :: Proxy sym

850

918

851−

852instance HasDocs Raw where

919instance HasDocs Raw where

853 docsFor _proxy (endpoint, action) =

920 docsFor _proxy (endpoint, action) =

854 single endpoint action

921 single endpoint action

855

922

923+-- TODO: We use 'AllMimeRender' here because we need to be able to show the

924+-- example data. However, there's no reason to believe that the instances of

925+-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that

926+-- both are even defined) for any particular type.

856−instance (ToSample a, HasDocs sublayout)

927+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)

857− => HasDocs (ReqBody a :> sublayout) where

928+ => HasDocs (ReqBody cts a :> sublayout) where

858

929

859 docsFor Proxy (endpoint, action) =

930 docsFor Proxy (endpoint, action) =

860 docsFor sublayoutP (endpoint, action')

931 docsFor sublayoutP (endpoint, action')

861

932

862 where sublayoutP = Proxy :: Proxy sublayout

933 where sublayoutP = Proxy :: Proxy sublayout

863−

864− action' = action & rqbody .~ sampleByteString p

934+ action' = action & rqbody .~ sampleByteString t p

935+ & rqtypes .~ supportedTypes t

936+ t = Proxy :: Proxy cts

865 p = Proxy :: Proxy a

937 p = Proxy :: Proxy a

866

938

867instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where

939instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where