remove 'forall's from haddock docs
This commit is contained in:
parent
d7587d1df9
commit
a4bb467446
2 changed files with 64 additions and 29 deletions
|
@ -55,63 +55,100 @@ runCI :: CombinatorImplementation combinator arg api context
|
|||
runCI (CI i) = i
|
||||
|
||||
makeCaptureCombinator ::
|
||||
forall api combinator arg context .
|
||||
(HasServer api context,
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) =>
|
||||
(Context context -> Text -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
makeCaptureCombinator getArg = CI $ \ Proxy context delayed ->
|
||||
CaptureRouter $
|
||||
route (Proxy :: Proxy api) context $ addCapture delayed $ \ captured ->
|
||||
(liftRouteResult =<< liftIO (getArg context captured))
|
||||
makeCaptureCombinator = inner -- we use 'inner' to avoid having 'forall' show up in haddock docs
|
||||
where
|
||||
inner ::
|
||||
forall api combinator arg context .
|
||||
(HasServer api context,
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) =>
|
||||
(Context context -> Text -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
inner getArg = CI $ \ Proxy context delayed ->
|
||||
CaptureRouter $
|
||||
route (Proxy :: Proxy api) context $ addCapture delayed $ \ captured ->
|
||||
(liftRouteResult =<< liftIO (getArg context captured))
|
||||
|
||||
makeRequestCheckCombinator ::
|
||||
forall api combinator context .
|
||||
(HasServer api context,
|
||||
WithArg () (ServerT api Handler) ~ ServerT api Handler) =>
|
||||
(Context context -> Request -> IO (RouteResult ()))
|
||||
-> CombinatorImplementation combinator () api context
|
||||
makeRequestCheckCombinator check = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addMethodCheck delayed $
|
||||
withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (check context (protectBody "makeRequestCheckCombinator" request))
|
||||
makeRequestCheckCombinator = inner
|
||||
where
|
||||
inner ::
|
||||
forall api combinator context .
|
||||
(HasServer api context,
|
||||
WithArg () (ServerT api Handler) ~ ServerT api Handler) =>
|
||||
(Context context -> Request -> IO (RouteResult ()))
|
||||
-> CombinatorImplementation combinator () api context
|
||||
inner check = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addMethodCheck delayed $
|
||||
withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (check context (protectBody "makeRequestCheckCombinator" request))
|
||||
|
||||
makeAuthCombinator ::
|
||||
forall api combinator arg context .
|
||||
(HasServer api context,
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) =>
|
||||
(Context context -> Request -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
makeAuthCombinator authCheck = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addAuthCheck delayed $
|
||||
withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (authCheck context (protectBody "makeAuthCombinator" request))
|
||||
makeAuthCombinator = inner
|
||||
where
|
||||
inner ::
|
||||
forall api combinator arg context .
|
||||
(HasServer api context,
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) =>
|
||||
(Context context -> Request -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
inner authCheck = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addAuthCheck delayed $
|
||||
withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (authCheck context (protectBody "makeAuthCombinator" request))
|
||||
|
||||
makeReqBodyCombinator ::
|
||||
forall api combinator arg context .
|
||||
(ServerT (combinator :> api) Handler ~ (arg -> ServerT api Handler),
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler),
|
||||
HasServer api context) =>
|
||||
(Context context -> IO ByteString -> arg)
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
makeReqBodyCombinator getArg = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
||||
(return ())
|
||||
(\ () -> withRequest $ \ request ->
|
||||
liftRouteResult $ Route $ getArg context $ requestBody request)
|
||||
makeReqBodyCombinator = inner
|
||||
where
|
||||
inner ::
|
||||
forall api combinator arg context .
|
||||
(ServerT (combinator :> api) Handler ~ (arg -> ServerT api Handler),
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler),
|
||||
HasServer api context) =>
|
||||
(Context context -> IO ByteString -> arg)
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
inner getArg = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
||||
(return ())
|
||||
(\ () -> withRequest $ \ request ->
|
||||
liftRouteResult $ Route $ getArg context $ requestBody request)
|
||||
|
||||
makeCombinator ::
|
||||
forall api combinator arg context .
|
||||
(ServerT (combinator :> api) Handler ~ (arg -> ServerT api Handler),
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler),
|
||||
HasServer api context) =>
|
||||
(Context context -> Request -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
makeCombinator getArg = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
||||
(return ())
|
||||
(\ () -> withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (getArg context (protectBody "makeCombinator" request)))
|
||||
makeCombinator = inner
|
||||
where
|
||||
inner ::
|
||||
forall api combinator arg context .
|
||||
(ServerT (combinator :> api) Handler ~ (arg -> ServerT api Handler),
|
||||
WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler),
|
||||
HasServer api context) =>
|
||||
(Context context -> Request -> IO (RouteResult arg))
|
||||
-> CombinatorImplementation combinator arg api context
|
||||
inner getArg = CI $ \ Proxy context delayed ->
|
||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
||||
(return ())
|
||||
(\ () -> withRequest $ \ request ->
|
||||
liftRouteResult =<< liftIO (getArg context (protectBody "makeCombinator" request)))
|
||||
|
||||
protectBody :: String -> Request -> Request
|
||||
protectBody name request = request{
|
||||
|
|
|
@ -255,8 +255,6 @@ instance (HasContextEntry context [(SBS.ByteString, User)], HasServer api contex
|
|||
type ServerT (AuthWithContext :> api) m = User -> ServerT api m
|
||||
route = runCI $ makeAuthCombinator authWithContext
|
||||
|
||||
-- fixme: remove foralls from haddock
|
||||
|
||||
authWithContext :: (HasContextEntry context [(SBS.ByteString, User)]) =>
|
||||
Context context -> Request -> IO (RouteResult User)
|
||||
authWithContext context request = return $ case lookup "Auth" (requestHeaders request) of
|
||||
|
|
Loading…
Reference in a new issue