ghc/lib/exts/Exception.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: Exception.lhs,v 1.4 1999/01/14 18:15:29 sof Exp $
   3 %
   4 % (c) The GRAP/AQUA Project, Glasgow University, 1998
   5 %
   6
   7 The External API for exceptions.  The functions provided in this
   8 module allow catching of exceptions in the IO monad.
   9
  10 \begin{code}
  11 module Exception (
  12
  13         Exception(..),          -- instance Show
  14         ArithException(..),     -- instance Show
  15         AsyncException(..),     -- instance Show
  16
  17         tryAll,    -- :: a    -> IO (Either Exception a)
  18         tryAllIO,  -- :: IO a -> IO (Either Exception a)
  19         try,       -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
  20         tryIO,     -- :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
  21
  22         catchAll,  -- :: a    -> (Exception -> IO a) -> IO a
  23         catchAllIO,-- :: IO a -> (Exception -> IO a) -> IO a
  24         catch,     -- :: (Exception -> Maybe b) -> a    -> (b -> IO a) -> IO a
  25         catchIO,   -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  26
  27         -- Exception predicates
  28
  29         justIoErrors,           -- :: Exception -> Maybe IOError
  30         justArithExceptions,    -- :: Exception -> Maybe ArithException
  31         justErrors,             -- :: Exception -> Maybe String
  32         justDynExceptions,      -- :: Exception -> Maybe Dynamic
  33         justAssertions,         -- :: Exception -> Maybe String
  34         justAsyncExceptions,    -- :: Exception -> Maybe AsyncException
  35
  36         -- Throwing exceptions
  37
  38         throw,          -- :: Exception -> a
  39
  40         -- Dynamic exceptions
  41
  42         throwDyn,       -- :: Typeable ex => ex -> b
  43         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  44
  45         -- Utilities
  46
  47         finally,        -- :: IO a -> IO b -> IO b
  48
  49         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
  50         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
  51
  52   ) where
  53
  54 #ifdef __HUGS__
  55 import PreludeBuiltin hiding (catch)
  56 import Prelude        hiding (catch)
  57 #else
  58 import Prelude hiding (catch)
  59 import PrelGHC (catch#)
  60 import PrelException hiding (catch)
  61 #endif
  62
  63 import Dynamic
  64 \end{code}
  65
  66 -----------------------------------------------------------------------------
  67 Catching exceptions
  68
  69 PrelException defines 'catchException' for us.
  70
  71 \begin{code}
  72 catchAll  :: a    -> (Exception -> IO a) -> IO a
  73 #ifdef __HUGS__
  74 catchAll a handler = primCatch' (case primForce a of () -> return a) handler
  75 #else
  76 catchAll a handler = catch# (a `seq` return a) handler
  77 #endif
  78
  79 catchAllIO :: IO a -> (Exception -> IO a) -> IO a
  80 catchAllIO =  catchException
  81
  82 catch :: (Exception -> Maybe b) -> a -> (b -> IO a) -> IO a
  83 catch p a handler = catchAll a handler'
  84   where handler' e = case p e of
  85                         Nothing -> throw e
  86                         Just b  -> handler b
  87
  88 catchIO :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  89 catchIO p a handler = catchAllIO a handler'
  90   where handler' e = case p e of
  91                         Nothing -> throw e
  92                         Just b  -> handler b
  93 \end{code}
  94
  95 -----------------------------------------------------------------------------
  96 'try' and variations.
  97
  98 \begin{code}
  99 tryAll :: a    -> IO (Either Exception a)
 100 #ifdef __HUGS__
 101 tryAll a = primCatch' (case primForce a of { () -> return Nothing})
 102                             (\e -> return (Just e))
 103 #else
 104 tryAll a = catch# (a `seq` return (Right a)) (\e -> return (Left e))
 105 #endif
 106
 107 tryAllIO :: IO a -> IO (Either Exception a)
 108 tryAllIO a = catchAllIO (a >>= \ v -> return (Right v))
 109                         (\e -> return (Left e))
 110
 111 try :: (Exception -> Maybe b) -> a -> IO (Either b a)
 112 try p a = do
 113   r <- tryAll a
 114   case r of
 115         Right v -> return (Right v)
 116         Left  e -> case p e of
 117                         Nothing -> throw e
 118                         Just b  -> return (Left b)
 119
 120 tryIO :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 121 tryIO p a = do
 122   r <- tryAllIO a
 123   case r of
 124         Right v -> return (Right v)
 125         Left  e -> case p e of
 126                         Nothing -> throw e
 127                         Just b  -> return (Left b)
 128 \end{code}
 129
 130 -----------------------------------------------------------------------------
 131 Dynamic exception types.  Since one of the possible kinds of exception
 132 is a dynamically typed value, we can effectively have polymorphic
 133 exceptions.
 134
 135 throwDyn will raise any value as an exception, provided it is in the
 136 Typeable class (see Dynamic.lhs).
 137
 138 catchDyn will catch any exception of a given type (determined by the
 139 handler function).  Any raised exceptions that don't match are
 140 re-raised.
 141
 142 \begin{code}
 143 throwDyn :: Typeable exception => exception -> b
 144 throwDyn exception = throw (DynException (toDyn exception))
 145
 146 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 147 catchDyn m k = catchException m handle
 148   where handle ex = case ex of
 149                            (DynException dyn) ->
 150                                 case fromDynamic dyn of
 151                                     Just exception  -> k exception
 152                                     Nothing -> throw ex
 153                            _ -> throw ex
 154 \end{code}
 155
 156 -----------------------------------------------------------------------------
 157 Exception Predicates
 158
 159 \begin{code}
 160 justIoErrors            :: Exception -> Maybe IOError
 161 justArithExceptions     :: Exception -> Maybe ArithException
 162 justErrors              :: Exception -> Maybe String
 163 justDynExceptions       :: Exception -> Maybe Dynamic
 164 justAssertions          :: Exception -> Maybe String
 165 justAsyncExceptions     :: Exception -> Maybe AsyncException
 166
 167 justIoErrors (IOException e) = Just e
 168 justIoErrors _ = Nothing
 169
 170 justArithExceptions (ArithException e) = Just e
 171 justArithExceptions _ = Nothing
 172
 173 justErrors (ErrorCall e) = Just e
 174 justErrors _ = Nothing
 175
 176 justAssertions (AssertionFailed e) = Just e
 177 justAssertions _ = Nothing
 178
 179 justDynExceptions (DynException e) = Just e
 180 justDynExceptions _ = Nothing
 181
 182 justAsyncExceptions (AsyncException e) = Just e
 183 justAsyncExceptions _ = Nothing
 184 \end{code}
 185
 186 -----------------------------------------------------------------------------
 187 Some Useful Functions
 188
 189 \begin{code}
 190 finally :: IO a -> IO b -> IO b
 191 a `finally` sequel = do
 192    tryAllIO a
 193    sequel
 194
 195 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
 196 bracket before after thing = do
 197   a <- before
 198   c <- tryAllIO (thing a)
 199   after a
 200   return ()
 201
 202 bracket_ :: IO a -> IO b -> IO c -> IO ()
 203 bracket_ before after thing = do
 204   before
 205   c <- tryAllIO thing
 206   after
 207   return ()
 208 \end{code}