From 6509bb40de4bebd8915266d1d9963ea4bf29cb3f Mon Sep 17 00:00:00 2001
From: Andrzej Rybczak <andrzej@rybczak.net>
Date: Fri, 18 Oct 2024 16:35:30 +0200
Subject: [PATCH] Adjust catches to properly rethrow exceptions
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13302 implemented exception
rethrowing proposal, but it didn't adjust `catches`. This fixes it.
(cherry picked from commit 148059fea534aced44649c739cd0fad4c25a99f0)
---
.../src/GHC/Internal/Control/Exception.hs | 17 ++++++++++-------
1 file changed, 10 insertions(+), 7 deletions(-)
diff --git a/libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs b/libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
index 4f97ee0c5f3..9cb6005a8c3 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
@@ -119,6 +119,7 @@ module GHC.Internal.Control.Exception (
) where
import GHC.Internal.Control.Exception.Base
+import GHC.Internal.Exception.Type (ExceptionWithContext(..), whileHandling)
import GHC.Internal.Base
import GHC.Internal.IO (interruptible)
@@ -149,13 +150,15 @@ Instead, we provide a function 'catches', which would be used thus:
> Handler (\ (ex :: IOException) -> handleIO ex)]
-}
catches :: IO a -> [Handler a] -> IO a
-catches io handlers = io `catch` catchesHandler handlers
-
-catchesHandler :: [Handler a] -> SomeException -> IO a
-catchesHandler handlers e = foldr tryHandler (throw e) handlers
- where tryHandler (Handler handler) res
- = case fromException e of
- Just e' -> handler e'
+catches io handlers = io `catchNoPropagate` catchesHandler handlers
+
+catchesHandler :: [Handler a] -> ExceptionWithContext SomeException -> IO a
+catchesHandler handlers ec@(ExceptionWithContext _ e) =
+ foldr tryHandler (rethrowIO ec) handlers
+ where
+ tryHandler (Handler handler) res =
+ case fromException e of
+ Just e' -> annotateIO (whileHandling ec) (handler e')
Nothing -> res
-- -----------------------------------------------------------------------------
--
GitLab