on master help sign in
Don't drop samples in `HasDocs ReqBody` instance

As reported in #754, `HasDocs` instance of `ReqBody` was dropping samples other than the first one. With this patch we show at most `_maxSamples` samples for `ReqBody`, and also include the sample title in the docs.

commitd8dd1cb90a887e2a235179a03069c9552f6ba8e0 authorÖmer Sinan Ağacan <omeragacan@gmail.com> dateTue 16 May 2017, 14:19 (9 years ago) parent3015152
1 file changed+8−7
servant-docs/src/Servant/Docs/Internal.hs+8−7
servant-docs/src/Servant/Docs/Internal.hs+8−7
@@ -249,7 +249,7 @@ data Action = Action
249249 , _notes :: [DocNote] -- user supplied
250250 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
251251 , _rqtypes :: [M.MediaType] -- type collected
252− , _rqbody :: [(M.MediaType, ByteString)] -- user supplied
252+ , _rqbody :: [(Text, M.MediaType, ByteString)] -- user supplied
253253 , _response :: Response -- user supplied
254254 } deriving (Eq, Ord, Show)
255255
@@ -618,7 +618,7 @@ markdown api = unlines $
618618
619619 where values = param ^. paramValues
620620
621− rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
621+ rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
622622 rqbodyStr [] [] = []
623623 rqbodyStr types s =
624624 ["#### Request:", ""]
@@ -630,8 +630,8 @@ markdown api = unlines $
630630 <> map (\t -> " - `" <> show t <> "`") ts
631631 <> [""]
632632
633− formatBody (m, b) =
634− "- Example: `" <> cs (show m) <> "`" :
633+ formatBody (t, m, b) =
634+ "- Example (" <> cs t <> "): `" <> cs (show m) <> "`" :
635635 contentStr m b
636636
637637 markdownForType mime_type =
@@ -801,11 +801,12 @@ instance HasDocs Raw where
801801instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
802802 => HasDocs (ReqBody (ct ': cts) a :> api) where
803803
804− docsFor Proxy (endpoint, action) =
805− docsFor subApiP (endpoint, action')
804+ docsFor Proxy (endpoint, action) opts@DocOptions{..} =
805+ docsFor subApiP (endpoint, action') opts
806806
807807 where subApiP = Proxy :: Proxy api
808− action' = action & rqbody .~ sampleByteString t p
808+ action' :: Action
809+ action' = action & rqbody .~ take _maxSamples (sampleByteStrings t p)
809810 & rqtypes .~ allMime t
810811 t = Proxy :: Proxy (ct ': cts)
811812 p = Proxy :: Proxy a