diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 25f51f12..10871a27 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/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 diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index 883f2900..3d802692 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/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