remove unsafeAsyncCatch

This commit is contained in:
Jappie Klooster 2022-07-20 14:07:30 +02:00
parent 01ccea46cc
commit dc4ee0f92c
3 changed files with 5 additions and 16 deletions

View File

@ -57,7 +57,7 @@ import Data.CaseInsensitive (CI)
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Request import qualified Network.Wai.Request
import Data.IORef import Data.IORef
import UnliftIO (SomeException, catch) import UnliftIO (SomeException, catch, MonadUnliftIO)
-- | Define settings for a Yesod applications. All methods have intelligent -- | Define settings for a Yesod applications. All methods have intelligent
-- defaults, and therefore no implementation is required. -- 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 -- One could override this for example to catch all exceptions
-- aside connection closed by peer to let yesod do more 500 page -- aside connection closed by peer to let yesod do more 500 page
-- rendering (instead of warp). -- 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 catchHandlerExceptions _ = catch
-- | Output error response pages. -- | Output error response pages.

View File

@ -57,17 +57,6 @@ import UnliftIO.Exception
import UnliftIO(MonadUnliftIO, withRunInIO) import UnliftIO(MonadUnliftIO, withRunInIO)
import Data.Proxy(Proxy(..)) 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 -- | Convert a synchronous exception into an ErrorResponse
toErrorHandler :: SomeException -> IO ErrorResponse toErrorHandler :: SomeException -> IO ErrorResponse
toErrorHandler e0 = handleAny errFromShow $ toErrorHandler e0 = handleAny errFromShow $
@ -99,7 +88,7 @@ basicRunHandler rhe handler yreq resState = do
-- Run the handler itself, capturing any runtime exceptions and -- Run the handler itself, capturing any runtime exceptions and
-- converting them into a @HandlerContents@ -- converting them into a @HandlerContents@
contents' <- unsafeAsyncCatch (rheCatchHandlerExceptions rhe) contents' <- rheCatchHandlerExceptions rhe
(do (do
res <- unHandlerFor handler (hd istate) res <- unHandlerFor handler (hd istate)
tc <- evaluate (toTypedContent res) tc <- evaluate (toTypedContent res)
@ -207,7 +196,7 @@ evalFallback :: (Monoid w, NFData w)
-> HandlerContents -> HandlerContents
-> w -> w
-> IO (w, HandlerContents) -> IO (w, HandlerContents)
evalFallback shouldCatch contents val = unsafeAsyncCatch shouldCatch evalFallback catcher contents val = catcher
(fmap (, contents) (evaluate $!! val)) (fmap (, contents) (evaluate $!! val))
(fmap ((mempty, ) . HCError) . toErrorHandler) (fmap ((mempty, ) . HCError) . toErrorHandler)

View File

@ -187,7 +187,7 @@ data RunHandlerEnv child site = RunHandlerEnv
-- | @since 1.6.24.0 -- | @since 1.6.24.0
-- catch function for rendering 500 pages on exceptions. -- catch function for rendering 500 pages on exceptions.
-- by default this is catch from unliftio (rethrows all async 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 data HandlerData child site = HandlerData