Control/Exception.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Control.Exception
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: Exception.hs,v 1.2 2001/07/31 14:34:23 simonmar Exp $
  12 --
  13 -- The External API for exceptions.  The functions provided in this
  14 -- module allow catching of exceptions in the IO monad.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module Control.Exception (
  19
  20         Exception(..),          -- instance Eq, Ord, Show, Typeable
  21         IOException,            -- instance Eq, Ord, Show, Typeable
  22         ArithException(..),     -- instance Eq, Ord, Show, Typeable
  23         ArrayException(..),     -- instance Eq, Ord, Show, Typeable
  24         AsyncException(..),     -- instance Eq, Ord, Show, Typeable
  25
  26         try,       -- :: IO a -> IO (Either Exception a)
  27         tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
  28
  29         catch,     -- :: IO a -> (Exception -> IO a) -> IO a
  30         catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  31
  32         handle,    -- :: (Exception -> IO a) -> IO a -> IO a
  33         handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
  34
  35         evaluate,  -- :: a -> IO a
  36
  37         -- Exception predicates (for tryJust, catchJust, handleJust)
  38
  39         ioErrors,               -- :: Exception -> Maybe IOError
  40         arithExceptions,        -- :: Exception -> Maybe ArithException
  41         errorCalls,             -- :: Exception -> Maybe String
  42         dynExceptions,          -- :: Exception -> Maybe Dynamic
  43         assertions,             -- :: Exception -> Maybe String
  44         asyncExceptions,        -- :: Exception -> Maybe AsyncException
  45         userErrors,             -- :: Exception -> Maybe String
  46
  47         -- Throwing exceptions
  48
  49         throw,          -- :: Exception -> a
  50 #ifndef __STGHUGS__
  51         -- for now
  52         throwTo,        -- :: ThreadId -> Exception -> a
  53 #endif
  54
  55         -- Dynamic exceptions
  56
  57         throwDyn,       -- :: Typeable ex => ex -> b
  58         throwDynTo,     -- :: Typeable ex => ThreadId -> ex -> b
  59         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  60
  61         -- Async exception control
  62
  63         block,          -- :: IO a -> IO a
  64         unblock,        -- :: IO a -> IO a
  65
  66         -- Assertions
  67
  68         -- for now
  69         assert,         -- :: Bool -> a -> a
  70
  71         -- Utilities
  72
  73         finally,        -- :: IO a -> IO b -> IO b
  74
  75         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
  76         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
  77
  78   ) where
  79
  80 #ifdef __GLASGOW_HASKELL__
  81 import Prelude          hiding (catch)
  82 import GHC.Prim         ( assert )
  83 import GHC.Exception    hiding (try, catch, bracket, bracket_)
  84 import GHC.Conc         ( throwTo, ThreadId )
  85 import GHC.IOBase       ( IO(..) )
  86 #endif
  87
  88 #ifdef __HUGS__
  89 import Prelude hiding ( catch )
  90 import PrelPrim ( catchException
  91                 , Exception(..)
  92                 , throw
  93                 , ArithException(..)
  94                 , AsyncException(..)
  95                 , assert
  96                 )
  97 #endif
  98
  99 import Data.Dynamic
 100
 101 #include "Dynamic.h"
 102 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
 103 INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
 104 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
 105 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
 106 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
 107
 108 -----------------------------------------------------------------------------
 109 -- Catching exceptions
 110
 111 -- GHC.Exception defines 'catchException' for us.
 112
 113 catch     :: IO a -> (Exception -> IO a) -> IO a
 114 catch     =  catchException
 115
 116 catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
 117 catchJust p a handler = catch a handler'
 118   where handler' e = case p e of
 119                         Nothing -> throw e
 120                         Just b  -> handler b
 121
 122 handle     :: (Exception -> IO a) -> IO a -> IO a
 123 handle     =  flip catch
 124
 125 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 126 handleJust p =  flip (catchJust p)
 127
 128 -----------------------------------------------------------------------------
 129 -- evaluate
 130
 131 evaluate :: a -> IO a
 132 evaluate a = a `seq` return a
 133
 134 -----------------------------------------------------------------------------
 135 -- 'try' and variations.
 136
 137 try :: IO a -> IO (Either Exception a)
 138 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 139
 140 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 141 tryJust p a = do
 142   r <- try a
 143   case r of
 144         Right v -> return (Right v)
 145         Left  e -> case p e of
 146                         Nothing -> throw e
 147                         Just b  -> return (Left b)
 148
 149 -----------------------------------------------------------------------------
 150 -- Dynamic exception types.  Since one of the possible kinds of exception
 151 -- is a dynamically typed value, we can effectively have polymorphic
 152 -- exceptions.
 153
 154 -- throwDyn will raise any value as an exception, provided it is in the
 155 -- Typeable class (see Dynamic.lhs).
 156
 157 -- catchDyn will catch any exception of a given type (determined by the
 158 -- handler function).  Any raised exceptions that don't match are
 159 -- re-raised.
 160
 161 throwDyn :: Typeable exception => exception -> b
 162 throwDyn exception = throw (DynException (toDyn exception))
 163
 164 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
 165 throwDynTo t exception = throwTo t (DynException (toDyn exception))
 166
 167 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 168 catchDyn m k = catchException m handle
 169   where handle ex = case ex of
 170                            (DynException dyn) ->
 171                                 case fromDynamic dyn of
 172                                     Just exception  -> k exception
 173                                     Nothing -> throw ex
 174                            _ -> throw ex
 175
 176 -----------------------------------------------------------------------------
 177 -- Exception Predicates
 178
 179 ioErrors                :: Exception -> Maybe IOError
 180 arithExceptions         :: Exception -> Maybe ArithException
 181 errorCalls              :: Exception -> Maybe String
 182 dynExceptions           :: Exception -> Maybe Dynamic
 183 assertions              :: Exception -> Maybe String
 184 asyncExceptions         :: Exception -> Maybe AsyncException
 185 userErrors              :: Exception -> Maybe String
 186
 187 ioErrors e@(IOException _) = Just e
 188 ioErrors _ = Nothing
 189
 190 arithExceptions (ArithException e) = Just e
 191 arithExceptions _ = Nothing
 192
 193 errorCalls (ErrorCall e) = Just e
 194 errorCalls _ = Nothing
 195
 196 assertions (AssertionFailed e) = Just e
 197 assertions _ = Nothing
 198
 199 dynExceptions (DynException e) = Just e
 200 dynExceptions _ = Nothing
 201
 202 asyncExceptions (AsyncException e) = Just e
 203 asyncExceptions _ = Nothing
 204
 205 userErrors (UserError e) = Just e
 206 userErrors _ = Nothing
 207
 208 -----------------------------------------------------------------------------
 209 -- Some Useful Functions
 210
 211 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 212 bracket before after thing =
 213   block (do
 214     a <- before
 215     r <- catch
 216            (unblock (thing a))
 217            (\e -> do { after a; throw e })
 218     after a
 219     return r
 220  )
 221
 222 -- finally is an instance of bracket, but it's quite common
 223 -- so we give the specialised version for efficiency.
 224 finally :: IO a -> IO b -> IO a
 225 a `finally` sequel =
 226   block (do
 227     r <- catch
 228              (unblock a)
 229              (\e -> do { sequel; throw e })
 230     sequel
 231     return r
 232   )
 233
 234 bracket_ :: IO a -> IO b -> IO c -> IO c
 235 bracket_ before after thing = bracket before (const after) (const thing)