remove 'forall's from haddock docs

This commit is contained in:
Sönke Hahn 2016-10-23 23:48:36 -04:00
parent d7587d1df9
commit a4bb467446
2 changed files with 64 additions and 29 deletions

View File

@ -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{

View File

@ -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