Fix all errors
This commit is contained in:
parent
547adabfe3
commit
a90b671607
2 changed files with 16 additions and 13 deletions
|
@ -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.
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in a new issue