Generate sample curl request

servant-docs/CHANGELOG.md

@@ -1,6 +1,13 @@
 [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
 [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
 
+0.11.9
+------
+
+### Significant changes
+
+- Add ability to render `curl` requests in `servant-docs`
+
 0.11.8
 ------
 

servant-docs/example/greet.hs

@@ -75,7 +75,7 @@ intro2 = DocIntro "This title is below the last"
 -- API specification
 type TestApi =
        -- GET /hello/:name?capital={true, false}  returns a Greet as JSON or PlainText
-       "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
+       "hello" :> Capture "name" Text :> Header "X-Num-Fairies" Int :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
 
        -- POST /greet with a Greet as JSON in the request body,
        --             returns a Greet as JSON
@@ -93,9 +93,9 @@ testApi = Proxy
 extra :: ExtraInfo TestApi
 extra =
     extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent)) $
-             defAction & headers <>~ ["unicorns"]
+             defAction & headers <>~ ["X-Num-Unicorns"]
                        & notes   <>~ [ DocNote "Title" ["This is some text"]
-                                     , DocNote "Second secton" ["And some more"]
+                                     , DocNote "Second section" ["And some more"]
                                      ]
 
 -- Generate the data that lets us have API docs. This
@@ -109,4 +109,4 @@ docsGreet :: API
 docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi
 
 main :: IO ()
-main = putStrLn $ markdown docsGreet
+main = putStrLn $ markdownWith (defRenderingOptions { _renderCurl = Just "http://localhost:80" }) docsGreet

servant-docs/example/greet.md

@@ -51,6 +51,15 @@ You'll also note that multiple intros are possible.
 "Hello, haskeller"
 ```
 
+### Sample Request:
+
+```bash
+curl -XPOST \
+  -H 'Content-Type: application/json;charset=utf-8 '\
+  -d "HELLO, HASKELLER" \
+  http://localhost:80/greet
+```
+
 ## DELETE /greet/:greetid
 
 ### Title
@@ -67,7 +76,7 @@ And some more
 
 ### Headers:
 
-- This endpoint is sensitive to the value of the **unicorns** HTTP header.
+- This endpoint is sensitive to the value of the **X-Num-Unicorns** HTTP header.
 
 ### Response:
 
@@ -85,12 +94,23 @@ And some more
 
 ```
 
+### Sample Request:
+
+```bash
+curl -XDELETE \
+  http://localhost:80/greet/:greetid
+```
+
 ## GET /hello/:name
 
 ### Captures:
 
 - *name*: name of the person to greet
 
+### Headers:
+
+- This endpoint is sensitive to the value of the **X-Num-Fairies** HTTP header.
+
 ### GET Parameters:
 
 - capital
@@ -120,3 +140,12 @@ And some more
 ```javascript
 "Hello, haskeller"
 ```
+
+### Sample Request:
+
+```bash
+curl -XGET \
+  http://localhost:80/hello/:name
+```
+
+

servant-docs/servant-docs.cabal

@@ -1,6 +1,6 @@
 cabal-version:       >=1.10
 name:                servant-docs
-version:             0.11.8
+version:             0.11.9
 
 synopsis:            generate API docs for your servant webservice
 category:            Servant, Web

servant-docs/src/Servant/Docs/Internal.hs

@@ -362,6 +362,9 @@ data RenderingOptions = RenderingOptions
     -- ^ How many content types to display for response body examples?
   , _notesHeading     :: !(Maybe String)
     -- ^ Optionally group all 'notes' together under a common heading.
+  , _renderCurl       :: !(Maybe String)
+    -- ^ Optionally render example curl requests under a common base path (e.g. `http://localhost:80`).
+    -- @since 0.11.9
   } deriving (Show)
 
 -- | Default API generation options.
@@ -376,6 +379,7 @@ defRenderingOptions = RenderingOptions
   { _requestExamples  = AllContentTypes
   , _responseExamples = AllContentTypes
   , _notesHeading     = Nothing
+  , _renderCurl       = Nothing
   }
 
 -- gimme some lenses
@@ -643,7 +647,7 @@ markdown = markdownWith defRenderingOptions
 --
 --   @since 0.11.1
 markdownWith :: RenderingOptions -> API -> String
-markdownWith RenderingOptions{..}  api = unlines $
+markdownWith RenderingOptions{..} api = unlines $
        introsStr (api ^. apiIntros)
     ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
 
@@ -659,6 +663,7 @@ markdownWith RenderingOptions{..}  api = unlines $
           fragmentStr (action ^. fragment) ++
           rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
           responseStr (action ^. response) ++
+          maybe [] (curlStr endpoint (action ^. rqbody)) _renderCurl ++
           []
 
           where str = "## " ++ BSC.unpack meth
@@ -814,7 +819,6 @@ markdownWith RenderingOptions{..}  api = unlines $
                 ("text", "css") -> "css"
                 (_, _) -> ""
 
-
         contentStr mime_type body =
           "" :
           "```" <> markdownForType mime_type :
@@ -839,6 +843,21 @@ markdownWith RenderingOptions{..}  api = unlines $
                   xs        ->
                     formatBodies _responseExamples xs
 
+        curlStr :: Endpoint -> [(Text, M.MediaType, ByteString)] -> String -> [String]
+        curlStr endpoint bds basePath =
+          let firstBodyMay = NE.head <$> NE.nonEmpty bds
+          in catMaybes $
+            (Just "### Sample Request:") :
+            (Just "") :
+            (Just "```bash") :
+            (Just $ "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\") :
+            ((\(_, media_type, _) -> "  -H 'Content-Type: " ++ show media_type ++ " '\\") <$> firstBodyMay) :
+            ((\(_, _, body) -> "  -d " ++ cs body ++ " \\") <$> firstBodyMay) :
+            (Just $ "  " ++ basePath ++ showPath (endpoint ^. path)) :
+            (Just "```") :
+            (Just "") :
+            []
+
 -- * Instances
 
 -- | The generated docs for @a ':<|>' b@ just appends the docs