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

merge documentation from duplicate routes

Browse source 
Servant supports defining the same route multiple times with different
content-types and result-types, but servant-docs was only documenting
the first of copy of such duplicated routes. It now combines the
documentation from all the copies.

Unfortunately, it is not yet possible for the documentation to specify
multiple status codes.
This commit is contained in:
Samuel Gélineau 2019-11-07 18:53:41 -05:00
parent 624a42ebf0
commit 143091eb3f
1 changed files with 15 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -20,6 +20,7 @@
#include "overlapping-compat.h"
module Servant.Docs.Internal where
import Debug.Trace
import Prelude ()
import Prelude.Compat
@ -116,7 +117,8 @@ instance Semigroup API where
(<>) = mappend
instance Monoid API where
API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)
API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
(HM.unionWith combineAction b1 (traceShowId b2))
mempty = API mempty mempty
-- | An empty 'API'
@ -223,6 +225,15 @@ data Response = Response
, _respHeaders :: [HTTP.Header]
} deriving (Eq, Ord, Show)
-- | Combine two Responses, we can't make a monoid because merging Status breaks
-- the laws.
--
-- As such, we invent a non-commutative, left associative operation
-- 'combineResponse' to mush two together taking the status from the very left.
combineResponse :: Response -> Response -> Response
Response s ts bs hs `combineResponse` Response _ ts' bs' hs'
= Response s (ts <> ts') (bs <> bs') (hs <> hs')
-- | Default response: status code 200, no response body.
--
-- Can be tweaked with two lenses.
@ -265,11 +276,10 @@ data Action = Action
-- laws.
--
-- As such, we invent a non-commutative, left associative operation
-- 'combineAction' to mush two together taking the response, body and content
-- types from the very left.
-- 'combineAction' to mush two together taking the response from the very left.
combineAction :: Action -> Action -> Action
Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' ts' body' resp' =
Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') (ts <> ts') (body <> body') (resp `combineResponse` resp')
-- | Default 'Action'. Has no 'captures', no query 'params', expects
-- no request body ('rqbody') and the typical response is 'defResponse'.