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

Fix all errors

Browse source
This commit is contained in:
Sasa Bogicevic 2018-04-26 15:51:37 +02:00
parent 547adabfe3
commit a90b671607
2 changed files with 16 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
servant-server/src/Servant/Server.hs
View file

@ -122,16 +122,15 @@ import Servant.Server.Internal
-- > main :: IO () -- > main :: IO ()
-- > main = Network.Wai.Handler.Warp.run 8080 app -- > 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) serveWithContext :: (HasServer api context)
=> Proxy api -> Context context -> Server api -> Application => Proxy api -> Context context -> Server api -> Application
serveWithContext p context server = serveWithContext p context server =
toApplication toApplication
False False -- determins if we should fully evaluate response
(runRouter (route p context (emptyDelayed (Route server)))) (runRouter (route p context (emptyDelayed (Route server))))
-- | Hoist server implementation. -- | Hoist server implementation.

22
servant-server/src/Servant/Server/Internal/RoutingApplication.hs
View file

@ -86,15 +86,19 @@ instance MonadThrow m => MonadThrow (RouteResultT m) where
throwM = lift . throwM throwM = lift . throwM
toApplication :: Bool -> RoutingApplication -> Application toApplication :: Bool -> RoutingApplication -> Application
toApplication fullyEvaluate ra request respond = ra request routingRespond toApplication fullyEvaluate ra request respond =
where ra request (maybeEval routingRespond)
maybeEval :: (RouteResult Response -> IO ResponseReceived) where
-> RouteResult Response -> IO ResponseReceived maybeEval :: (RouteResult Response -> IO ResponseReceived)
maybeEval resp = if fullyEvaluate then force resp else resp -> RouteResult Response -> IO ResponseReceived
routingRespond :: RouteResult Response -> IO ResponseReceived maybeEval resp =
routingRespond (Fail err) = respond $ responseServantErr err if fullyEvaluate
routingRespond (FailFatal err) = respond $ responseServantErr err then force resp
routingRespond (Route v) = respond v 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 -- | A 'Delayed' is a representation of a handler with scheduled
-- delayed checks that can trigger errors. -- delayed checks that can trigger errors.