Exception.hs 3.39 KB
Newer Older
1 2 3

module Exception
    (
4 5 6 7 8 9 10 11 12
    module Control.Exception,
    module Exception
    )
    where

import Prelude hiding (catch)
import Control.Exception

#if __GLASGOW_HASKELL__ < 609
13 14
import Data.Typeable ( Typeable )

15 16 17 18 19 20 21 22
type SomeException = Exception

onException :: IO a -> IO () -> IO a
onException io what = io `catch` \e -> do what
                                          throw e
#endif

catchIO :: IO a -> (IOException -> IO a) -> IO a
23
#if __GLASGOW_HASKELL__ >= 609
24
catchIO = catch
25
#else
26 27 28
catchIO io handler = io `catch` handler'
    where handler' (IOException ioe) = handler ioe
          handler' e                 = throw e
29 30
#endif

31 32
handleIO :: (IOException -> IO a) -> IO a -> IO a
handleIO = flip catchIO
33

34
tryIO :: IO a -> IO (Either IOException a)
35
#if __GLASGOW_HASKELL__ >= 609
36
tryIO = try
37
#else
38 39 40 41 42
tryIO io = do ei <- try io
              case ei of
                  Right v -> return (Right v)
                  Left (IOException ioe) -> return (Left ioe)
                  Left e -> throwIO e
43 44
#endif

45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
-- | A monad that can catch exceptions.  A minimal definition
-- requires a definition of 'gcatch'.
--
-- Although, 'gbracket' and 'gfinally' could be modelled on top of 'gcatch',
-- they are included in the type class since GHC needs special implementations
-- of these in order to properly handle asynchronous exceptions.
class Monad m => ExceptionMonad m where
  -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
  -- exception handling monad instead of just 'IO'.
#if __GLASGOW_HASKELL__ >= 609
  gcatch :: Exception e => m a -> (e -> m a) -> m a
#else
  gcatch :: m a -> (Exception -> m a) -> m a
  gcatchDyn :: Typeable e => m a -> (e -> m a) -> m a
#endif

  -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
  -- exception handling monad instead of just 'IO'.
  gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c

  -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
  -- exception handling monad instead of just 'IO'.
  gfinally :: m a -> m b -> m a

  gbracket acquire release in_between = do
      a <- acquire
      r <- in_between a `gonException` release a
      release a
      return r

  gfinally thing cleanup = do
      r <- thing `gonException` cleanup
      cleanup
      return r

instance ExceptionMonad IO where
  gcatch    = catch
#if __GLASGOW_HASKELL__ < 609
  gcatchDyn = catchDyn
#endif
  gbracket  = bracket
  gfinally  = finally


#if __GLASGOW_HASKELL__ >= 609
gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
#else
gtry :: (ExceptionMonad m) => m a -> m (Either Exception a)
#endif
gtry act = gcatch (act >>= \a -> return (Right a))
                  (\e -> return (Left e))

-- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
-- exception handling monad instead of just 'IO'.
#if __GLASGOW_HASKELL__ >= 609
ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
#else
ghandle :: (ExceptionMonad m) => (Exception -> m a) -> m a -> m a
#endif
ghandle = flip gcatch

-- | Always executes the first argument.  If this throws an exception the
-- second argument is executed and the exception is raised again.
gonException :: (ExceptionMonad m) => m a -> m b -> m a
gonException ioA cleanup = ioA `gcatch` \e ->
                             do cleanup
#if __GLASGOW_HASKELL__ >= 609
                                throw (e :: SomeException)
#else
                                throw e
#endif