Test case and fix for notCaught3 in #658

yesod-core/Yesod/Core/Internal/Run.hs

@@ -10,7 +10,8 @@ module Yesod.Core.Internal.Run where
 import Yesod.Core.Internal.Response
 import           Blaze.ByteString.Builder     (toByteString)
 import           Control.Applicative          ((<$>))
-import           Control.Exception            (fromException, bracketOnError)
+import           Control.Exception            (fromException, bracketOnError, evaluate)
+import qualified Control.Exception            as E
 import           Control.Exception.Lifted     (catch)
 import           Control.Monad.IO.Class       (MonadIO)
 import           Control.Monad.IO.Class       (liftIO)
@@ -94,7 +95,9 @@ runHandler rhe@RunHandlerEnv {..} handler yreq = withInternalState $ \resState -
                 YRWai _ -> return yar
     let sendFile' ct fp p =
             return $ YRPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession
-    case contents of
+    contents1 <- evaluate contents `E.catch` \e -> return
+        (HCError $! InternalError $! T.pack $! show (e :: E.SomeException))
+    case contents1 of
         HCContent status (TypedContent ct c) -> do
             ec' <- liftIO $ evaluateContent c
             case ec' of

yesod-core/test/YesodCoreTest/ErrorHandling.hs

@@ -24,6 +24,9 @@ mkYesod "App" [parseRoutes|
 /error-in-body ErrorInBodyR GET
 /error-in-body-noeval ErrorInBodyNoEvalR GET
 /override-status OverrideStatusR GET
+
+-- https://github.com/yesodweb/yesod/issues/658
+/builder BuilderR GET
 |]
 
 overrideStatus = mkStatus 15 "OVERRIDE"
@@ -74,6 +77,9 @@ getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR
 getOverrideStatusR :: Handler ()
 getOverrideStatusR = invalidArgs ["OVERRIDE"]
 
+getBuilderR :: Handler TypedContent
+getBuilderR = return $ TypedContent "ignored" $ ContentBuilder (error "builder-3.14159") Nothing
+
 errorHandlingTest :: Spec
 errorHandlingTest = describe "Test.ErrorHandling" $ do
       it "says not found" caseNotFound
@@ -82,6 +88,7 @@ errorHandlingTest = describe "Test.ErrorHandling" $ do
       it "error in body == 500" caseErrorInBody
       it "error in body, no eval == 200" caseErrorInBodyNoEval
       it "can override status code" caseOverrideStatus
+      it "builder" caseBuilder
 
 runner :: Session () -> IO ()
 runner f = toWaiApp App >>= runSession f
@@ -140,3 +147,9 @@ caseOverrideStatus :: IO ()
 caseOverrideStatus = runner $ do
     res <- request defaultRequest { pathInfo = ["override-status"] }
     assertStatus 15 res
+
+caseBuilder :: IO ()
+caseBuilder = runner $ do
+    res <- request defaultRequest { pathInfo = ["builder"] }
+    assertStatus 500 res
+    assertBodyContains "builder-3.14159" res