remove unsafeAsyncCatch
This commit is contained in:
parent
01ccea46cc
commit
dc4ee0f92c
@ -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.
|
||||||
|
|||||||
@ -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)
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user