Don't use "deriving Typeable" (for portability reasons)

[ghc-base.git] / Control / Exception.hs

diff --git a/Control/Exception.hs b/Control/Exception.hs
index cd71313..13b6cac 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -1,4 +1,7 @@
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+
+#include "Typeable.h"
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Exception
@@ -46,6 +49,7 @@ module Control.Exception (
         RecConError(..),
         RecSelError(..),
         RecUpdError(..),
+        ErrorCall(..),
 
         -- * Throwing exceptions
         throwIO,        -- :: Exception -> IO a
@@ -76,6 +80,7 @@ module Control.Exception (
         try,       -- :: IO a -> IO (Either Exception a)
         tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
         ignoreExceptions,
+        onException,
 
         -- ** The @evaluate@ function
         evaluate,  -- :: a -> IO a
@@ -348,6 +353,10 @@ tryJust p a = do
 ignoreExceptions :: IO () -> IO ()
 ignoreExceptions io = io `catchAny` \_ -> return ()
 
+onException :: IO a -> IO () -> IO a
+onException io what = io `catch` \e -> do what
+                                          throw (e :: SomeException)
+
 -----------------------------------------------------------------------------
 -- Some Useful Functions
 
@@ -552,7 +561,7 @@ patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive
 -----
 
 data PatternMatchFail = PatternMatchFail String
-    deriving Typeable
+INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
 
 instance Exception PatternMatchFail
 
@@ -562,7 +571,7 @@ instance Show PatternMatchFail where
 -----
 
 data RecSelError = RecSelError String
-    deriving Typeable
+INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
 
 instance Exception RecSelError
 
@@ -572,7 +581,7 @@ instance Show RecSelError where
 -----
 
 data RecConError = RecConError String
-    deriving Typeable
+INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
 
 instance Exception RecConError
 
@@ -582,7 +591,7 @@ instance Show RecConError where
 -----
 
 data RecUpdError = RecUpdError String
-    deriving Typeable
+INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
 
 instance Exception RecUpdError
 
@@ -592,7 +601,7 @@ instance Show RecUpdError where
 -----
 
 data NoMethodError = NoMethodError String
-    deriving Typeable
+INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
 
 instance Exception NoMethodError
 
@@ -602,7 +611,7 @@ instance Show NoMethodError where
 -----
 
 data AssertionFailed = AssertionFailed String
-    deriving Typeable
+INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
 
 instance Exception AssertionFailed
 
@@ -612,7 +621,7 @@ instance Show AssertionFailed where
 -----
 
 data NonTermination = NonTermination
-    deriving Typeable
+INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
 
 instance Exception NonTermination
 
@@ -626,7 +635,7 @@ nonTermination = toException NonTermination
 -----
 
 data Deadlock = Deadlock
-    deriving Typeable
+INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
 
 instance Exception Deadlock
 
@@ -636,7 +645,7 @@ instance Show Deadlock where
 -----
 
 data NestedAtomically = NestedAtomically
-    deriving Typeable
+INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
 
 instance Exception NestedAtomically