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