Use Evaluate instead of Bool

servant-server/src/Servant/Server.hs

@@ -132,7 +132,7 @@ serve p = serveWithContext p EmptyContext
 serveWithContext :: (HasServer api context)
     => Proxy api -> Context context -> Server api -> Application
 serveWithContext p context server =
-  toApplication True (runRouter (route p context (emptyDelayed (Route server))))
+  toApplication Force (runRouter (route p context (emptyDelayed (Route server))))
 
 -- | Hoist server implementation.
 --

servant-server/src/Servant/Server/Internal/Handler.hs

@@ -46,3 +46,10 @@ instance MonadBaseControl IO Handler where
 
 runHandler :: Handler a -> IO (Either ServantErr a)
 runHandler = runExceptT . runHandler'
+
+-- determins if response should be reduced to NF
+data Evaluate =
+    Force
+  | Lazy
+  deriving (Show)
+

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

@@ -95,16 +95,16 @@ instance MonadTransControl RouteResultT where
 instance MonadThrow m => MonadThrow (RouteResultT m) where
     throwM = lift . throwM
 
-toApplication :: Bool -> RoutingApplication -> Application
+toApplication :: Evaluate -> RoutingApplication -> Application
 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
+      case fullyEvaluate of
+        Force -> force resp
+        Lazy  -> resp
     routingRespond :: RouteResult Response -> IO ResponseReceived
     routingRespond (Fail err)      = respond $ responseServantErr err
     routingRespond (FailFatal err) = respond $ responseServantErr err

servant-server/test/Servant/Server/RouterSpec.hs

@@ -31,7 +31,7 @@ spec = describe "Servant.Server.Internal.Router" $ do
 routerSpec :: Spec
 routerSpec = do
   let app' :: Application
-      app' = toApplication $ runRouter router'
+      app' = toApplication Force $ runRouter router'
 
       router', router :: Router ()
       router' = tweakResponse (fmap twk) router