diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 9b325103..350606b9 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -122,16 +122,15 @@ import Servant.Server.Internal -- > main :: IO () -- > main = Network.Wai.Handler.Warp.run 8080 app -- -serve :: (HasServer api '[]) => Proxy api -> Server api -> Application -serve p = serveWithContext p EmptyContext -type FullyEvaluateResponse = Bool +serve :: (HasServer api '[Bool]) => Proxy api -> Server api -> Application +serve p = serveWithContext p (False :. EmptyContext) serveWithContext :: (HasServer api context) => Proxy api -> Context context -> Server api -> Application serveWithContext p context server = toApplication - False + False -- determins if we should fully evaluate response (runRouter (route p context (emptyDelayed (Route server)))) -- | Hoist server implementation. diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs index a9cc95cc..5ac4b667 100644 --- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs +++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs @@ -86,15 +86,19 @@ instance MonadThrow m => MonadThrow (RouteResultT m) where throwM = lift . throwM toApplication :: Bool -> RoutingApplication -> Application -toApplication fullyEvaluate ra request respond = ra request routingRespond - where - maybeEval :: (RouteResult Response -> IO ResponseReceived) - -> RouteResult Response -> IO ResponseReceived - maybeEval resp = if fullyEvaluate then force resp else resp - routingRespond :: RouteResult Response -> IO ResponseReceived - routingRespond (Fail err) = respond $ responseServantErr err - routingRespond (FailFatal err) = respond $ responseServantErr err - routingRespond (Route v) = respond v +toApplication fullyEvaluate ra request respond = + ra request (maybeEval routingRespond) + where + maybeEval :: (RouteResult Response -> IO ResponseReceived) + -> RouteResult Response -> IO ResponseReceived + maybeEval resp = + if fullyEvaluate + then force resp + else resp + routingRespond :: RouteResult Response -> IO ResponseReceived + routingRespond (Fail err) = respond $ responseServantErr err + routingRespond (FailFatal err) = respond $ responseServantErr err + routingRespond (Route v) = respond v -- | A 'Delayed' is a representation of a handler with scheduled -- delayed checks that can trigger errors.