eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Don't drop samples in HasDocs ReqBody instance

Browse source 
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.
This commit is contained in:
Ömer Sinan Ağacan 2017-05-16 14:19:52 +03:00
parent 301515210b
commit d8dd1cb90a
1 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -249,7 +249,7 @@ data Action = Action
, _notes :: [DocNote] -- user supplied , _notes :: [DocNote] -- user supplied
, _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
, _rqtypes :: [M.MediaType] -- type collected , _rqtypes :: [M.MediaType] -- type collected
, _rqbody :: [(M.MediaType, ByteString)] -- user supplied , _rqbody :: [(Text, M.MediaType, ByteString)] -- user supplied
, _response :: Response -- user supplied , _response :: Response -- user supplied
} deriving (Eq, Ord, Show) } deriving (Eq, Ord, Show)
@ -618,7 +618,7 @@ markdown api = unlines $
where values = param ^. paramValues where values = param ^. paramValues
rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String] rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
rqbodyStr [] [] = [] rqbodyStr [] [] = []
rqbodyStr types s = rqbodyStr types s =
["#### Request:", ""] ["#### Request:", ""]
@ -630,8 +630,8 @@ markdown api = unlines $
<> map (\t -> " - `" <> show t <> "`") ts <> map (\t -> " - `" <> show t <> "`") ts
<> [""] <> [""]
formatBody (m, b) = formatBody (t, m, b) =
"- Example: `" <> cs (show m) <> "`" : "- Example (" <> cs t <> "): `" <> cs (show m) <> "`" :
contentStr m b contentStr m b
markdownForType mime_type = markdownForType mime_type =
@ -801,11 +801,12 @@ instance HasDocs Raw where
instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api) instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
=> HasDocs (ReqBody (ct ': cts) a :> api) where => HasDocs (ReqBody (ct ': cts) a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) opts@DocOptions{..} =
docsFor subApiP (endpoint, action') docsFor subApiP (endpoint, action') opts
where subApiP = Proxy :: Proxy api where subApiP = Proxy :: Proxy api
action' = action & rqbody .~ sampleByteString t p action' :: Action
action' = action & rqbody .~ take _maxSamples (sampleByteStrings t p)
& rqtypes .~ allMime t & rqtypes .~ allMime t
t = Proxy :: Proxy (ct ': cts) t = Proxy :: Proxy (ct ': cts)
p = Proxy :: Proxy a p = Proxy :: Proxy a