diff --git a/yesod-core/src/Yesod/Core/Class/Yesod.hs b/yesod-core/src/Yesod/Core/Class/Yesod.hs index 21914468..18ab351c 100644 --- a/yesod-core/src/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/src/Yesod/Core/Class/Yesod.hs @@ -57,7 +57,7 @@ import Data.CaseInsensitive (CI) import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Request import Data.IORef -import UnliftIO (SomeException, catch) +import UnliftIO (SomeException, catch, MonadUnliftIO) -- | Define settings for a Yesod applications. All methods have intelligent -- defaults, and therefore no implementation is required. @@ -81,7 +81,7 @@ class RenderRoute site => Yesod site where -- One could override this for example to catch all exceptions -- aside connection closed by peer to let yesod do more 500 page -- rendering (instead of warp). - catchHandlerExceptions :: site -> IO a -> (SomeException -> IO a) -> IO a + catchHandlerExceptions :: MonadUnliftIO m => site -> m a -> (SomeException -> m a) -> m a catchHandlerExceptions _ = catch -- | Output error response pages. diff --git a/yesod-core/src/Yesod/Core/Internal/Run.hs b/yesod-core/src/Yesod/Core/Internal/Run.hs index c090ba4c..897966f0 100644 --- a/yesod-core/src/Yesod/Core/Internal/Run.hs +++ b/yesod-core/src/Yesod/Core/Internal/Run.hs @@ -57,17 +57,6 @@ import UnliftIO.Exception import UnliftIO(MonadUnliftIO, withRunInIO) import Data.Proxy(Proxy(..)) --- | wraps the provided catch fun in a unliftIO -unsafeAsyncCatch - :: (MonadUnliftIO m) - => (IO a -> (SomeException -> IO a) -> IO a) - -> m a -- ^ action - -> (SomeException -> m a) -- ^ handler - -> m a -unsafeAsyncCatch catchFun f g = withRunInIO $ \run -> - run f `catchFun` \e -> run (g e) - - -- | Convert a synchronous exception into an ErrorResponse toErrorHandler :: SomeException -> IO ErrorResponse toErrorHandler e0 = handleAny errFromShow $ @@ -99,7 +88,7 @@ basicRunHandler rhe handler yreq resState = do -- Run the handler itself, capturing any runtime exceptions and -- converting them into a @HandlerContents@ - contents' <- unsafeAsyncCatch (rheCatchHandlerExceptions rhe) + contents' <- rheCatchHandlerExceptions rhe (do res <- unHandlerFor handler (hd istate) tc <- evaluate (toTypedContent res) @@ -207,7 +196,7 @@ evalFallback :: (Monoid w, NFData w) -> HandlerContents -> w -> IO (w, HandlerContents) -evalFallback shouldCatch contents val = unsafeAsyncCatch shouldCatch +evalFallback catcher contents val = catcher (fmap (, contents) (evaluate $!! val)) (fmap ((mempty, ) . HCError) . toErrorHandler) diff --git a/yesod-core/src/Yesod/Core/Types.hs b/yesod-core/src/Yesod/Core/Types.hs index 508f4ad5..88f01e35 100644 --- a/yesod-core/src/Yesod/Core/Types.hs +++ b/yesod-core/src/Yesod/Core/Types.hs @@ -187,7 +187,7 @@ data RunHandlerEnv child site = RunHandlerEnv -- | @since 1.6.24.0 -- catch function for rendering 500 pages on exceptions. -- by default this is catch from unliftio (rethrows all async exceptions). - , rheCatchHandlerExceptions :: !(forall a. IO a -> (SomeException -> IO a) -> IO a) + , rheCatchHandlerExceptions :: !(forall a m . MonadUnliftIO m => m a -> (SomeException -> m a) -> m a) } data HandlerData child site = HandlerData