47bd252 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Servant docs curl (#1401)

47bd252Dan Fithian5 years ago

.gitignore+1

compare with master

unifiedsplit

@@ -30,6 +30,7 @@ doc/_build

30doc/venv

31doc/tutorial/static/api.js

32doc/tutorial/static/jq.js

33+shell.nix

34# nix

35# nix

35result*

36result*

changelog.d/servant-docs-curlnew file+16

@@ -0,0 +1,16 @@

1+synopsis: Add sample cURL requests to generated documentation

2+prs: #1401

4+description: {

6+Add sample cURL requests to generated documentation.

8+Those supplying changes to the Request `header` field manually using

9+lenses will need to add a sample bytestring value.

10+

11+`headers <>~ ["unicorn"]`

12+

13+becomes

14+

15+`headers <>~ [("unicorn", "sample value")]`

16+}

servant-docs/example/greet.hs+4−4

@@ -75,7 +75,7 @@ intro2 = DocIntro "This title is below the last"

75-- API specification

76type TestApi =

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

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

78+ "hello" :> Capture "name" Text :> Header "X-Num-Fairies" Int :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet

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

81 -- returns a Greet as JSON

@@ -93,9 +93,9 @@ testApi = Proxy

93extra :: ExtraInfo TestApi

94extra =

95 extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent)) $

96− defAction & headers <>~ ["unicorns"]

96+ defAction & headers <>~ [("X-Num-Unicorns", "1")]

97 & notes <>~ [ DocNote "Title" ["This is some text"]

98− , DocNote "Second secton" ["And some more"]

98+ , DocNote "Second section" ["And some more"]

99 ]

100

101-- Generate the data that lets us have API docs. This

@@ -109,4 +109,4 @@ docsGreet :: API

109docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi

110

111main :: IO ()

112−main = putStrLn $ markdown docsGreet

112+main = putStrLn $ markdownWith (defRenderingOptions { _renderCurlBasePath = Just "http://localhost:80" }) docsGreet

servant-docs/example/greet.md+32−1

@@ -51,6 +51,15 @@ You'll also note that multiple intros are possible.

51"Hello, haskeller"

52```

54+### Sample Request:

55+

56+```bash

57+curl -XPOST \

58+ -H "Content-Type: application/json;charset=utf-8" \

59+ -d "\"HELLO, HASKELLER\"" \

60+ http://localhost:80/greet

61+```

62+

54## DELETE /greet/:greetid

63## DELETE /greet/:greetid

56### Title

65### Title

@@ -67,7 +76,7 @@ And some more

68### Headers:

77### Headers:

70−- This endpoint is sensitive to the value of the **unicorns** HTTP header.

79+- This endpoint is sensitive to the value of the **X-Num-Unicorns** HTTP header.

72### Response:

81### Response:

@@ -85,12 +94,24 @@ And some more

86```

95```

97+### Sample Request:

98+

99+```bash

100+curl -XDELETE \

101+ -H "X-Num-Unicorns: 1" \

102+ http://localhost:80/greet/:greetid

103+```

104+

88## GET /hello/:name

105## GET /hello/:name

106

90### Captures:

107### Captures:

108

92- *name*: name of the person to greet

109- *name*: name of the person to greet

110

111+### Headers:

112+

113+- This endpoint is sensitive to the value of the **X-Num-Fairies** HTTP header.

114+

94### GET Parameters:

115### GET Parameters:

116

96- capital

117- capital

@@ -120,3 +141,13 @@ And some more

120```javascript

141```javascript

121"Hello, haskeller"

142"Hello, haskeller"

122```

143```

144+

145+### Sample Request:

146+

147+```bash

148+curl -XGET \

149+ -H "X-Num-Fairies: 1729" \

150+ http://localhost:80/hello/:name

151+```

152+

153+

servant-docs/src/Servant/Docs/Internal.hs+56−17

@@ -25,8 +25,8 @@ import Control.Applicative

25import Control.Arrow

26 (second)

27import Control.Lens

28− (makeLenses, mapped, over, set, traversed, view, (%~), (&),

28+ (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,

29− (.~), (<>~), (^.), (|>))

29+ _1, (%~), (&), (.~), (<>~), (^.), (|>))

30import qualified Data.ByteString.Char8 as BSC

31import Data.ByteString.Lazy.Char8

32 (ByteString)

@@ -59,6 +59,9 @@ import Data.String.Conversions

59import Data.Text

60 (Text, unpack)

61import GHC.Generics

62+ (Generic, Rep, K1(K1), M1(M1), U1(U1), V1,

63+ (:*:)((:*:)), (:+:)(L1, R1))

64+import qualified GHC.Generics as G

62import GHC.TypeLits

65import GHC.TypeLits

63import Servant.API

66import Servant.API

64import Servant.API.ContentTypes

67import Servant.API.ContentTypes

@@ -295,7 +298,7 @@ defResponse = Response

295data Action = Action

298data Action = Action

296 { _authInfo :: [DocAuthentication] -- user supplied info

299 { _authInfo :: [DocAuthentication] -- user supplied info

297 , _captures :: [DocCapture] -- type collected + user supplied info

300 , _captures :: [DocCapture] -- type collected + user supplied info

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

301+ , _headers :: [HTTP.Header] -- type collected

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

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

300 , _fragment :: Maybe DocFragment -- type collected + user supplied info

303 , _fragment :: Maybe DocFragment -- type collected + user supplied info

301 , _notes :: [DocNote] -- user supplied

304 , _notes :: [DocNote] -- user supplied

@@ -356,12 +359,14 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten

356--

359--

357-- @since 0.11.1

360-- @since 0.11.1

358data RenderingOptions = RenderingOptions

361data RenderingOptions = RenderingOptions

359− { _requestExamples :: !ShowContentTypes

362+ { _requestExamples :: !ShowContentTypes

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

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

361− , _responseExamples :: !ShowContentTypes

364+ , _responseExamples :: !ShowContentTypes

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

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

363− , _notesHeading :: !(Maybe String)

366+ , _notesHeading :: !(Maybe String)

364 -- ^ Optionally group all 'notes' together under a common heading.

367 -- ^ Optionally group all 'notes' together under a common heading.

368+ , _renderCurlBasePath :: !(Maybe String)

369+ -- ^ Optionally render example curl requests under a common base path (e.g. `http://localhost:80`).

365 } deriving (Show)

370 } deriving (Show)

366

371

367-- | Default API generation options.

372-- | Default API generation options.

@@ -373,9 +378,10 @@ data RenderingOptions = RenderingOptions

373-- @since 0.11.1

378-- @since 0.11.1

374defRenderingOptions :: RenderingOptions

379defRenderingOptions :: RenderingOptions

375defRenderingOptions = RenderingOptions

380defRenderingOptions = RenderingOptions

376− { _requestExamples = AllContentTypes

381+ { _requestExamples = AllContentTypes

377− , _responseExamples = AllContentTypes

382+ , _responseExamples = AllContentTypes

378− , _notesHeading = Nothing

383+ , _notesHeading = Nothing

384+ , _renderCurlBasePath = Nothing

379 }

385 }

380

386

381-- gimme some lenses

387-- gimme some lenses

@@ -412,7 +418,7 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)

412-- > extra :: ExtraInfo TestApi

418-- > extra :: ExtraInfo TestApi

413-- > extra =

419-- > extra =

414-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $

420-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $

415−-- > defAction & headers <>~ ["unicorns"]

421+-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]

416-- > & notes <>~ [ DocNote "Title" ["This is some text"]

422-- > & notes <>~ [ DocNote "Title" ["This is some text"]

417-- > , DocNote "Second section" ["And some more"]

423-- > , DocNote "Second section" ["And some more"]

418-- > ]

424-- > ]

@@ -507,7 +513,7 @@ samples = map ("",)

507

513

508-- | Default sample Generic-based inputs/outputs.

514-- | Default sample Generic-based inputs/outputs.

509defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]

515defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]

510−defaultSamples _ = second to <$> gtoSamples (Proxy :: Proxy (Rep a))

516+defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))

511

517

512-- | @'ToSample'@ for Generics.

518-- | @'ToSample'@ for Generics.

513--

519--

@@ -643,7 +649,7 @@ markdown = markdownWith defRenderingOptions

643--

649--

644-- @since 0.11.1

650-- @since 0.11.1

645markdownWith :: RenderingOptions -> API -> String

651markdownWith :: RenderingOptions -> API -> String

646−markdownWith RenderingOptions{..} api = unlines $

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

647 introsStr (api ^. apiIntros)

653 introsStr (api ^. apiIntros)

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

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

649

655

@@ -654,11 +660,12 @@ markdownWith RenderingOptions{..} api = unlines $

654 notesStr (action ^. notes) ++

660 notesStr (action ^. notes) ++

655 authStr (action ^. authInfo) ++

661 authStr (action ^. authInfo) ++

656 capturesStr (action ^. captures) ++

662 capturesStr (action ^. captures) ++

657− headersStr (action ^. headers) ++

663+ headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++

658 paramsStr meth (action ^. params) ++

664 paramsStr meth (action ^. params) ++

659 fragmentStr (action ^. fragment) ++

665 fragmentStr (action ^. fragment) ++

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

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

661 responseStr (action ^. response) ++

667 responseStr (action ^. response) ++

668+ maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++

662 []

669 []

663

670

664 where str = "## " ++ BSC.unpack meth

671 where str = "## " ++ BSC.unpack meth

@@ -814,7 +821,6 @@ markdownWith RenderingOptions{..} api = unlines $

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

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

815 (_, _) -> ""

822 (_, _) -> ""

816

823

817−

818 contentStr mime_type body =

824 contentStr mime_type body =

819 "" :

825 "" :

820 "```" <> markdownForType mime_type :

826 "```" <> markdownForType mime_type :

@@ -839,6 +845,36 @@ markdownWith RenderingOptions{..} api = unlines $

839 xs ->

845 xs ->

840 formatBodies _responseExamples xs

846 formatBodies _responseExamples xs

841

847

848+ curlStr :: Endpoint -> [HTTP.Header] -> [(Text, M.MediaType, ByteString)] -> String -> [String]

849+ curlStr endpoint hdrs reqBodies basePath =

850+ [ "### Sample Request:"

851+ , ""

852+ , "```bash"

853+ , "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\"

854+ ] <>

855+ maybe [] pure mbMediaTypeStr <>

856+ headersStrs <>

857+ maybe [] pure mbReqBodyStr <>

858+ [ " " ++ basePath ++ showPath (endpoint ^. path)

859+ , "```"

860+ , ""

861+ ]

862+

863+ where escapeQuotes :: String -> String

864+ escapeQuotes = concatMap $ \c -> case c of

865+ '\"' -> "\\\""

866+ _ -> [c]

867+ mbReqBody = listToMaybe reqBodies

868+ mbMediaTypeStr = mkMediaTypeStr <$> mbReqBody

869+ headersStrs = mkHeaderStr <$> hdrs

870+ mbReqBodyStr = mkReqBodyStr <$> mbReqBody

871+ mkMediaTypeStr (_, media_type, _) =

872+ " -H \"Content-Type: " ++ show media_type ++ "\" \\"

873+ mkHeaderStr (hdrName, hdrVal) =

874+ " -H \"" ++ escapeQuotes (cs (CI.original hdrName)) ++ ": " ++

875+ escapeQuotes (cs hdrVal) ++ "\" \\"

876+ mkReqBodyStr (_, _, body) = " -d \"" ++ escapeQuotes (cs body) ++ "\" \\"

877+

842-- * Instances

878-- * Instances

843

879

844-- | The generated docs for @a ':<|>' b@ just appends the docs

880-- | The generated docs for @a ':<|>' b@ just appends the docs

@@ -977,14 +1013,17 @@ instance {-# OVERLAPPING #-}

977 status = fromInteger $ natVal (Proxy :: Proxy status)

1013 status = fromInteger $ natVal (Proxy :: Proxy status)

978 p = Proxy :: Proxy a

1014 p = Proxy :: Proxy a

979

1015

980−instance (KnownSymbol sym, HasDocs api)

1016+instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)

981 => HasDocs (Header' mods sym a :> api) where

1017 => HasDocs (Header' mods sym a :> api) where

982 docsFor Proxy (endpoint, action) =

1018 docsFor Proxy (endpoint, action) =

983 docsFor subApiP (endpoint, action')

1019 docsFor subApiP (endpoint, action')

984

1020

985 where subApiP = Proxy :: Proxy api

1021 where subApiP = Proxy :: Proxy api

986− action' = over headers (|> headername) action

1022+ action' = over headers (|> (headerName, headerVal)) action

987− headername = T.pack $ symbolVal (Proxy :: Proxy sym)

1023+ headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)

1024+ headerVal = case toSample (Proxy :: Proxy a) of

1025+ Just x -> cs $ toHeader x

1026+ Nothing -> "<no header sample provided>"

988

1027

989instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)

1028instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)

990 => HasDocs (QueryParam' mods sym a :> api) where

1029 => HasDocs (QueryParam' mods sym a :> api) where

servant-docs/test/Servant/DocsSpec.hs−1

@@ -130,7 +130,6 @@ spec = describe "Servant.Docs" $ do

130 md `shouldContain` "\"dt1field1\":\"field 1\""

131 it "contains response samples - dt1field2" $

132 md `shouldContain` "\"dt1field2\":13"

133−

134 it "contains request body samples" $

133 it "contains request body samples" $

135 md `shouldContain` "17"

134 md `shouldContain` "17"

136

135