diff --git a/doc/tutorial/Docs.lhs b/doc/tutorial/Docs.lhs index 1d428698..91c93c71 100644 --- a/doc/tutorial/Docs.lhs +++ b/doc/tutorial/Docs.lhs @@ -23,6 +23,7 @@ import Network.Wai import Servant.API import Servant.Docs import Servant.Server +import Web.FormUrlEncoded(FromForm(..), ToForm(..)) ``` And we'll import some things from one of our earlier modules @@ -110,12 +111,6 @@ markdown :: API -> String That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`. ````````` text -## Welcome - -This is our super webservice's API. - -Enjoy! - ## GET /hello #### GET Parameters: @@ -132,19 +127,20 @@ Enjoy! - Supported content types are: + - `application/json;charset=utf-8` - `application/json` -- When a value is provided for 'name' +- When a value is provided for 'name' (`application/json;charset=utf-8`, `application/json`): - ```javascript - {"msg":"Hello, Alp"} - ``` + ```javascript +{"msg":"Hello, Alp"} + ``` -- When 'name' is not specified +- When 'name' is not specified (`application/json;charset=utf-8`, `application/json`): - ```javascript - {"msg":"Hello, anonymous coward"} - ``` + ```javascript +{"msg":"Hello, anonymous coward"} + ``` ## POST /marketing @@ -152,28 +148,30 @@ Enjoy! - Supported content types are: + - `application/json;charset=utf-8` - `application/json` -- Example: `application/json` +- Example (`application/json;charset=utf-8`, `application/json`): - ```javascript - {"email":"alp@foo.com","interested_in":["haskell","mathematics"],"age":26,"name":"Alp"} - ``` + ```javascript +{"clientAge":26,"clientEmail":"alp@foo.com","clientName":"Alp","clientInterestedIn":["haskell","mathematics"]} + ``` #### Response: -- Status code 201 +- Status code 200 - Headers: [] - Supported content types are: + - `application/json;charset=utf-8` - `application/json` -- Response body as below. +- Example (`application/json;charset=utf-8`, `application/json`): - ```javascript - {"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"} - ``` + ```javascript +{"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"} + ``` ## GET /position/:x/:y @@ -189,13 +187,14 @@ Enjoy! - Supported content types are: + - `application/json;charset=utf-8` - `application/json` -- Response body as below. +- Example (`application/json;charset=utf-8`, `application/json`): - ```javascript - {"x":3,"y":14} - ``` + ```javascript +{"yCoord":14,"xCoord":3} + ```` ````````` @@ -213,6 +212,49 @@ docsBS = encodeUtf8 `docsWithIntros` just takes an additional parameter, a list of `DocIntro`s that must be displayed before any endpoint docs. +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: + +``` haskell +type ExampleAPI2 = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position + :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage + :<|> "marketing" :> ReqBody '[JSON, FormUrlEncoded] ClientInfo :> Post '[JSON] Email + +instance ToForm ClientInfo +instance FromForm ClientInfo + +exampleAPI2 :: Proxy ExampleAPI2 +exampleAPI2 = Proxy + +api2Docs :: API +api2Docs = docs exampleAPI2 +``` + +The relevant output of `markdown api2Docs` is now: + +```````` text +#### Request: + +- Supported content types are: + + - `application/json;charset=utf-8` + - `application/json` + - `application/x-www-form-urlencoded` + +- Example (`application/json;charset=utf-8`, `application/json`): + + ```javascript +{"clientAge":26,"clientEmail":"alp@foo.com","clientName":"Alp","clientInterestedIn":["haskell","mathematics"]} + ``` + +- Example (`application/x-www-form-urlencoded`): + + ``` +clientAge=26&clientEmail=alp%40foo.com&clientName=Alp&clientInterestedIn=haskell&clientInterestedIn=mathematics + ``` +```````` + +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`. + We can now serve the API *and* the API docs with a simple server. ``` haskell diff --git a/doc/tutorial/tutorial.cabal b/doc/tutorial/tutorial.cabal index 69d0b0bf..8c23a49d 100644 --- a/doc/tutorial/tutorial.cabal +++ b/doc/tutorial/tutorial.cabal @@ -31,6 +31,7 @@ library , servant-docs == 0.11.* , servant-js >= 0.9 && <0.10 , warp + , http-api-data , http-media , lucid , time diff --git a/servant-docs/CHANGELOG.md b/servant-docs/CHANGELOG.md index 1573e31f..c77af0a9 100644 --- a/servant-docs/CHANGELOG.md +++ b/servant-docs/CHANGELOG.md @@ -7,6 +7,8 @@ * Document the HTTP Method the parameters of an endpoint belong to (rather than assuming `GET` for all of them). * Content type of sample response body is also displayed. +* Can now control how many content-types for each example are shown + with `markdownWith` and `RenderingOptions`. 0.11 ---- diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index 4498be5e..56515712 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -49,7 +49,7 @@ library , control-monad-omega == 0.3.* if !impl(ghc >= 8.0) build-depends: - semigroups >=0.16.2.2 && <0.19 + semigroups >=0.17 && <0.19 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index 7209e258..5d7661fe 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -24,6 +24,9 @@ module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, pretty, markdown + -- ** Customising generated documentation + , markdownWith, RenderingOptions(..), defRenderingOptions + , requestExamples, responseExamples, ShowContentTypes(..) -- * Generating docs with extra information , docsWith, docsWithIntros, docsWithOptions , ExtraInfo(..), extraInfo diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index fdf1b855..e4bae223 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -20,24 +20,31 @@ #include "overlapping-compat.h" module Servant.Docs.Internal where -import Prelude () +import Prelude () import Prelude.Compat + import Control.Applicative import Control.Arrow (second) -import Control.Lens (makeLenses, mapped, over, traversed, view, (%~), - (&), (.~), (<>~), (^.), (|>)) +import Control.Lens (makeLenses, mapped, over, + traversed, view, (%~), (&), (.~), + (<>~), (^.), (|>)) import qualified Control.Monad.Omega as Omega -import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.ByteString.Char8 as BSC +import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.CaseInsensitive as CI +import Data.Foldable (fold) import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.List.Compat (intercalate, intersperse, sort) +import Data.List.NonEmpty (NonEmpty ((:|)), groupWith) +import qualified Data.List.NonEmpty as NE import Data.Maybe -import Data.Monoid (All (..), Any (..), Sum (..), Product (..), First (..), Last (..), Dual (..)) -import Data.Semigroup (Semigroup (..)) +import Data.Monoid (All (..), Any (..), Dual (..), + First (..), Last (..), + Product (..), Sum (..)) import Data.Ord (comparing) -import Data.Proxy (Proxy(Proxy)) +import Data.Proxy (Proxy (Proxy)) +import Data.Semigroup (Semigroup (..)) import Data.String.Conversions (cs) import Data.Text (Text, unpack) import GHC.Generics @@ -291,6 +298,35 @@ defAction = single :: Endpoint -> Action -> API single e a = API mempty (HM.singleton e a) +-- | How many content-types for each example should be shown? +-- +-- @since 0.11.1 +data ShowContentTypes = AllContentTypes -- ^ For each example, show each content type. + | FirstContentType -- ^ For each example, show only one content type. + deriving (Eq, Ord, Show, Read, Bounded, Enum) + +-- | Customise how an 'API' is converted into documentation. +-- +-- @since 0.11.1 +data RenderingOptions = RenderingOptions + { _requestExamples :: !ShowContentTypes + -- ^ How many content types to display for request body examples? + , _responseExamples :: !ShowContentTypes + -- ^ How many content types to display for response body examples? + } deriving (Show) + +-- | Default API generation options. +-- +-- All content types are shown for both 'requestExamples' and +-- 'responseExamples'. +-- +-- @since 0.11.1 +defRenderingOptions :: RenderingOptions +defRenderingOptions = RenderingOptions + { _requestExamples = AllContentTypes + , _responseExamples = AllContentTypes + } + -- gimme some lenses makeLenses ''DocAuthentication makeLenses ''DocOptions @@ -302,6 +338,7 @@ makeLenses ''DocIntro makeLenses ''DocNote makeLenses ''Response makeLenses ''Action +makeLenses ''RenderingOptions -- | Generate the docs for a given API that implements 'HasDocs'. This is the -- default way to create documentation. @@ -517,8 +554,34 @@ class ToAuthInfo a where -- | Generate documentation in Markdown format for -- the given 'API'. +-- +-- This is equivalent to @'markdownWith' 'defRenderingOptions'@. markdown :: API -> String -markdown api = unlines $ +markdown = markdownWith defRenderingOptions + +-- | Generate documentation in Markdown format for +-- the given 'API' using the specified options. +-- +-- These options allow you to customise aspects such as: +-- +-- * Choose how many content-types for each request body example are +-- shown with 'requestExamples'. +-- +-- * Choose how many content-types for each response body example +-- are shown with 'responseExamples'. +-- +-- For example, to only show the first content-type of each example: +-- +-- @ +-- markdownWith ('defRenderingOptions' +-- & 'requestExamples' '.~' 'FirstContentType' +-- & 'responseExamples' '.~' 'FirstContentType' ) +-- myAPI +-- @ +-- +-- @since 0.11.1 +markdownWith :: RenderingOptions -> API -> String +markdownWith RenderingOptions{..} api = unlines $ introsStr (api ^. apiIntros) ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints) @@ -632,31 +695,55 @@ markdown api = unlines $ rqbodyStr types s = ["#### Request:", ""] <> formatTypes types - <> concatMap formatBody s + <> formatBodies _requestExamples s formatTypes [] = [] formatTypes ts = ["- Supported content types are:", ""] <> map (\t -> " - `" <> show t <> "`") ts <> [""] - formatBody (t, m, b) = - "- Example (" <> cs t <> "): `" <> cs (show m) <> "`" : - contentStr m b + -- This assumes that when the bodies are created, identical + -- labels and representations are located next to each other. + formatBodies :: ShowContentTypes -> [(Text, M.MediaType, ByteString)] -> [String] + formatBodies ex bds = concatMap formatBody (select bodyGroups) + where + bodyGroups :: [(Text, NonEmpty M.MediaType, ByteString)] + bodyGroups = + map (\grps -> let (t,_,b) = NE.head grps in (t, fmap (\(_,m,_) -> m) grps, b)) + . groupWith (\(t,_,b) -> (t,b)) + $ bds + + select = case ex of + AllContentTypes -> id + FirstContentType -> map (\(t,ms,b) -> (t, NE.head ms :| [], b)) + + formatBody :: (Text, NonEmpty M.MediaType, ByteString) -> [String] + formatBody (t, ms, b) = + "- " <> title <> " (" <> mediaList ms <> "):" : + contentStr (NE.head ms) b + where + mediaList = fold . NE.intersperse ", " . fmap (\m -> "`" ++ show m ++ "`") + + title + | T.null t = "Example" + | otherwise = cs t markdownForType mime_type = case (M.mainType mime_type, M.subType mime_type) of ("text", "html") -> "html" ("application", "xml") -> "xml" + ("text", "xml") -> "xml" ("application", "json") -> "javascript" ("application", "javascript") -> "javascript" ("text", "css") -> "css" (_, _) -> "" + contentStr mime_type body = "" : - "```" <> markdownForType mime_type : + " ```" <> markdownForType mime_type : cs body : - "```" : + " ```" : "" : [] @@ -674,7 +761,7 @@ markdown api = unlines $ [] -> ["- No response body\n"] [("", t, r)] -> "- Response body as below." : contentStr t r xs -> - concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx <> " (`" <> cs (show t) <> "`)") : contentStr t r) xs + formatBodies _responseExamples xs -- * Instances diff --git a/stack-ghc-7.8.4.yaml b/stack-ghc-7.8.4.yaml index 97049725..b3b66e88 100644 --- a/stack-ghc-7.8.4.yaml +++ b/stack-ghc-7.8.4.yaml @@ -23,9 +23,11 @@ extra-deps: - http-client-0.4.30 - natural-transformation-0.4 - primitive-0.6.1.0 +- semigroups-0.17 - servant-js-0.9.3 - should-not-typecheck-2.1.0 - time-locale-compat-0.1.1.1 - uri-bytestring-0.2.2.0 +- void-0.7.1 - wai-app-static-3.1.5 resolver: lts-2.22