compiler/utils/Exception.hs

   1
   2 module Exception
   3     (
   4     module Control.Exception,
   5     module Exception
   6     )
   7     where
   8
   9 import Prelude hiding (catch)
  10 import Control.Exception
  11
  12 #if __GLASGOW_HASKELL__ < 609
  13 import Data.Typeable ( Typeable )
  14
  15 type SomeException = Exception
  16
  17 onException :: IO a -> IO () -> IO a
  18 onException io what = io `catch` \e -> do what
  19                                           throw e
  20 #endif
  21
  22 catchIO :: IO a -> (IOException -> IO a) -> IO a
  23 #if __GLASGOW_HASKELL__ >= 609
  24 catchIO = catch
  25 #else
  26 catchIO io handler = io `catch` handler'
  27     where handler' (IOException ioe) = handler ioe
  28           handler' e                 = throw e
  29 #endif
  30
  31 handleIO :: (IOException -> IO a) -> IO a -> IO a
  32 handleIO = flip catchIO
  33
  34 tryIO :: IO a -> IO (Either IOException a)
  35 #if __GLASGOW_HASKELL__ >= 609
  36 tryIO = try
  37 #else
  38 tryIO io = do ei <- try io
  39               case ei of
  40                   Right v -> return (Right v)
  41                   Left (IOException ioe) -> return (Left ioe)
  42                   Left e -> throwIO e
  43 #endif
  44
  45 -- | A monad that can catch exceptions.  A minimal definition
  46 -- requires a definition of 'gcatch'.
  47 --
  48 -- Although, 'gbracket' and 'gfinally' could be modelled on top of 'gcatch',
  49 -- they are included in the type class since GHC needs special implementations
  50 -- of these in order to properly handle asynchronous exceptions.
  51 class Monad m => ExceptionMonad m where
  52   -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
  53   -- exception handling monad instead of just 'IO'.
  54 #if __GLASGOW_HASKELL__ >= 609
  55   gcatch :: Exception e => m a -> (e -> m a) -> m a
  56 #else
  57   gcatch :: m a -> (Exception -> m a) -> m a
  58   gcatchDyn :: Typeable e => m a -> (e -> m a) -> m a
  59 #endif
  60
  61   -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
  62   -- exception handling monad instead of just 'IO'.
  63   gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
  64
  65   -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
  66   -- exception handling monad instead of just 'IO'.
  67   gfinally :: m a -> m b -> m a
  68
  69   gbracket acquire release in_between = do
  70       a <- acquire
  71       r <- in_between a `gonException` release a
  72       release a
  73       return r
  74
  75   gfinally thing cleanup = do
  76       r <- thing `gonException` cleanup
  77       cleanup
  78       return r
  79
  80 instance ExceptionMonad IO where
  81   gcatch    = catch
  82 #if __GLASGOW_HASKELL__ < 609
  83   gcatchDyn = catchDyn
  84 #endif
  85   gbracket  = bracket
  86   gfinally  = finally
  87
  88
  89 #if __GLASGOW_HASKELL__ >= 609
  90 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
  91 #else
  92 gtry :: (ExceptionMonad m) => m a -> m (Either Exception a)
  93 #endif
  94 gtry act = gcatch (act >>= \a -> return (Right a))
  95                   (\e -> return (Left e))
  96
  97 -- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
  98 -- exception handling monad instead of just 'IO'.
  99 #if __GLASGOW_HASKELL__ >= 609
 100 ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
 101 #else
 102 ghandle :: (ExceptionMonad m) => (Exception -> m a) -> m a -> m a
 103 #endif
 104 ghandle = flip gcatch
 105
 106 -- | Always executes the first argument.  If this throws an exception the
 107 -- second argument is executed and the exception is raised again.
 108 gonException :: (ExceptionMonad m) => m a -> m b -> m a
 109 gonException ioA cleanup = ioA `gcatch` \e ->
 110                              do cleanup
 111 #if __GLASGOW_HASKELL__ >= 609
 112                                 throw (e :: SomeException)
 113 #else
 114                                 throw e
 115 #endif