From 688c6ae2997c57d8b90c4ba49791e3c47eed3e0b Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Fri, 12 Dec 2008 11:53:07 +0000
Subject: [PATCH] Fix a bug in catch when the handler has type (SomeException
-> IO a) This was causing certain exceptions in GHC to not get caught
correctly, in particular the "mismatched interface file versions" error when
reading the old interface file.
---
Control/Exception/Extensible.hs | 41 ++++++++++++++++++---------------
1 file changed, 23 insertions(+), 18 deletions(-)
diff --git a/Control/Exception/Extensible.hs b/Control/Exception/Extensible.hs
index 988b07b..1526096 100644
--- a/Control/Exception/Extensible.hs
+++ b/Control/Exception/Extensible.hs
@@ -201,26 +201,31 @@ catch :: Exception e
=> IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
-catch io handler = io `E.catch` handler'
- where handler' e = case fromException (toException e) of
- Just e' ->
- -- Handle the case where e == E.Exception,
- -- or one of the types that make up E.Exception
- handler e'
- Nothing ->
- case e of
+catch io poly_handler = io `E.catch` handler'
+ where
+ -- First look for "new style" exceptions, which are thrown
+ -- as E.DynException (SomeException e)
+
+ -- needs scoped TVs: handler' :: E.Exception -> IO a
+ handler' e = case e of
E.DynException dyn ->
case fromDynamic dyn of
- Just (SomeException exc) ->
- case cast exc of
- Just e' ->
- -- Handle the case where we have
- -- a new exception type encoded
- -- as a Dynamic
- handler e'
- Nothing -> E.throw e
- Nothing -> E.throw e
- _ -> E.throw e
+ Just se@(SomeException _) ->
+ case fromException se of
+ Just e' -> poly_handler e'
+ Nothing -> E.throw e
+ Nothing -> try_old e
+ _ -> try_old e
+
+ -- If it's a legacy exception (E.Exception or one of the
+ -- types that make up E.Exception), check for a handler than
+ -- can handle them:
+
+ -- needs scoped TVs: try_old :: E.Exception -> IO a
+ try_old e = case fromException (toException e) of
+ Just e' -> poly_handler e'
+ Nothing -> E.throw e
+
-- | When you want to acquire a resource, do some work with it, and
-- then release the resource, it is a good idea to use 'bracket',
--
GitLab