From a90b6716072c9b2b1cdc87f1c8c2022cd8267711 Mon Sep 17 00:00:00 2001
From: Sasa Bogicevic <t4nt0r@protonmail.com>
Date: Thu, 26 Apr 2018 15:51:37 +0200
Subject: [PATCH] Fix all errors

---
 servant-server/src/Servant/Server.hs          |  7 +++---
 .../Server/Internal/RoutingApplication.hs     | 22 +++++++++++--------
 2 files changed, 16 insertions(+), 13 deletions(-)

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.