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
  11 #if __GLASGOW_HASKELL__ < 609
  12 import Control.Exception.Extensible as Control.Exception
  13 #else
  14 import Control.Exception
  15 #endif
  16
  17 catchIO :: IO a -> (IOException -> IO a) -> IO a
  18 catchIO = catch
  19
  20 handleIO :: (IOException -> IO a) -> IO a -> IO a
  21 handleIO = flip catchIO
  22
  23 tryIO :: IO a -> IO (Either IOException a)
  24 tryIO = try
  25
  26 -- | A monad that can catch exceptions.  A minimal definition
  27 -- requires a definition of 'gcatch'.
  28 --
  29 -- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
  30 -- eventually call the primitives 'Control.Exception.block' and
  31 -- 'Control.Exception.unblock' respectively.  These are used for
  32 -- implementations that support asynchronous exceptions.  The default
  33 -- implementations of 'gbracket' and 'gfinally' use 'gblock' and 'gunblock'
  34 -- thus rarely require overriding.
  35 --
  36 class Monad m => ExceptionMonad m where
  37
  38   -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
  39   -- exception handling monad instead of just 'IO'.
  40   gcatch :: Exception e => m a -> (e -> m a) -> m a
  41
  42   -- | Generalised version of 'Control.Exception.block', allowing an arbitrary
  43   -- exception handling monad instead of just 'IO'.
  44   gblock :: m a -> m a
  45
  46   -- | Generalised version of 'Control.Exception.unblock', allowing an
  47   -- arbitrary exception handling monad instead of just 'IO'.
  48   gunblock :: m a -> m a
  49
  50   -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
  51   -- exception handling monad instead of just 'IO'.
  52   gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
  53
  54   -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
  55   -- exception handling monad instead of just 'IO'.
  56   gfinally :: m a -> m b -> m a
  57
  58   gblock = id
  59   gunblock = id
  60
  61   gbracket before after thing =
  62     gblock (do
  63       a <- before
  64       r <- gunblock (thing a) `gonException` after a
  65       _ <- after a
  66       return r)
  67
  68   a `gfinally` sequel =
  69     gblock (do
  70       r <- gunblock a `gonException` sequel
  71       _ <- sequel
  72       return r)
  73
  74 instance ExceptionMonad IO where
  75   gcatch    = catch
  76   gblock    = block
  77   gunblock  = unblock
  78
  79 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
  80 gtry act = gcatch (act >>= \a -> return (Right a))
  81                   (\e -> return (Left e))
  82
  83 -- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
  84 -- exception handling monad instead of just 'IO'.
  85 ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
  86 ghandle = flip gcatch
  87
  88 -- | Always executes the first argument.  If this throws an exception the
  89 -- second argument is executed and the exception is raised again.
  90 gonException :: (ExceptionMonad m) => m a -> m b -> m a
  91 gonException ioA cleanup = ioA `gcatch` \e ->
  92                              do _ <- cleanup
  93                                 throw (e :: SomeException)
  94