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.7 2002/04/24 16:31:37 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         throwTo,        -- :: ThreadId -> Exception -> a
  51
  52         -- Dynamic exceptions
  53
  54         throwDyn,       -- :: Typeable ex => ex -> b
  55         throwDynTo,     -- :: Typeable ex => ThreadId -> ex -> b
  56         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  57
  58         -- Async exception control
  59
  60         block,          -- :: IO a -> IO a
  61         unblock,        -- :: IO a -> IO a
  62
  63         -- Assertions
  64
  65         -- for now
  66         assert,         -- :: Bool -> a -> a
  67
  68         -- Utilities
  69
  70         finally,        -- :: IO a -> IO b -> IO b
  71
  72         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
  73         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
  74
  75   ) where
  76
  77 #ifdef __GLASGOW_HASKELL__
  78 import Prelude          hiding (catch)
  79 import System.IO.Error
  80 import GHC.Base         ( assert )
  81 import GHC.Exception    hiding (try, catch, bracket, bracket_)
  82 import GHC.Conc         ( throwTo, ThreadId )
  83 import GHC.IOBase       ( IO(..) )
  84 #endif
  85
  86 #ifdef __HUGS__
  87 import Prelude hiding ( catch )
  88 import PrelPrim ( catchException
  89                 , Exception(..)
  90                 , throw
  91                 , ArithException(..)
  92                 , AsyncException(..)
  93                 , assert
  94                 )
  95 #endif
  96
  97 import Data.Dynamic
  98
  99 #include "Dynamic.h"
 100 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
 101 INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
 102 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
 103 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
 104 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
 105
 106 -----------------------------------------------------------------------------
 107 -- Catching exceptions
 108
 109 -- GHC.Exception defines 'catchException' for us.
 110
 111 catch     :: IO a -> (Exception -> IO a) -> IO a
 112 catch     =  catchException
 113
 114 catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
 115 catchJust p a handler = catch a handler'
 116   where handler' e = case p e of
 117                         Nothing -> throw e
 118                         Just b  -> handler b
 119
 120 handle     :: (Exception -> IO a) -> IO a -> IO a
 121 handle     =  flip catch
 122
 123 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 124 handleJust p =  flip (catchJust p)
 125
 126 -----------------------------------------------------------------------------
 127 -- evaluate
 128
 129 evaluate :: a -> IO a
 130 evaluate a = a `seq` return a
 131
 132 -----------------------------------------------------------------------------
 133 -- 'try' and variations.
 134
 135 try :: IO a -> IO (Either Exception a)
 136 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 137
 138 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 139 tryJust p a = do
 140   r <- try a
 141   case r of
 142         Right v -> return (Right v)
 143         Left  e -> case p e of
 144                         Nothing -> throw e
 145                         Just b  -> return (Left b)
 146
 147 -----------------------------------------------------------------------------
 148 -- Dynamic exception types.  Since one of the possible kinds of exception
 149 -- is a dynamically typed value, we can effectively have polymorphic
 150 -- exceptions.
 151
 152 -- throwDyn will raise any value as an exception, provided it is in the
 153 -- Typeable class (see Dynamic.lhs).
 154
 155 -- catchDyn will catch any exception of a given type (determined by the
 156 -- handler function).  Any raised exceptions that don't match are
 157 -- re-raised.
 158
 159 throwDyn :: Typeable exception => exception -> b
 160 throwDyn exception = throw (DynException (toDyn exception))
 161
 162 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
 163 throwDynTo t exception = throwTo t (DynException (toDyn exception))
 164
 165 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 166 catchDyn m k = catchException m handle
 167   where handle ex = case ex of
 168                            (DynException dyn) ->
 169                                 case fromDynamic dyn of
 170                                     Just exception  -> k exception
 171                                     Nothing -> throw ex
 172                            _ -> throw ex
 173
 174 -----------------------------------------------------------------------------
 175 -- Exception Predicates
 176
 177 ioErrors                :: Exception -> Maybe IOError
 178 arithExceptions         :: Exception -> Maybe ArithException
 179 errorCalls              :: Exception -> Maybe String
 180 dynExceptions           :: Exception -> Maybe Dynamic
 181 assertions              :: Exception -> Maybe String
 182 asyncExceptions         :: Exception -> Maybe AsyncException
 183 userErrors              :: Exception -> Maybe String
 184
 185 ioErrors e@(IOException _) = Just e
 186 ioErrors _ = Nothing
 187
 188 arithExceptions (ArithException e) = Just e
 189 arithExceptions _ = Nothing
 190
 191 errorCalls (ErrorCall e) = Just e
 192 errorCalls _ = Nothing
 193
 194 assertions (AssertionFailed e) = Just e
 195 assertions _ = Nothing
 196
 197 dynExceptions (DynException e) = Just e
 198 dynExceptions _ = Nothing
 199
 200 asyncExceptions (AsyncException e) = Just e
 201 asyncExceptions _ = Nothing
 202
 203 userErrors e | isUserError e = Just (ioeGetErrorString e)
 204 userErrors _ = Nothing
 205
 206 -----------------------------------------------------------------------------
 207 -- Some Useful Functions
 208
 209 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 210 bracket before after thing =
 211   block (do
 212     a <- before
 213     r <- catch
 214            (unblock (thing a))
 215            (\e -> do { after a; throw e })
 216     after a
 217     return r
 218  )
 219
 220 -- finally is an instance of bracket, but it's quite common
 221 -- so we give the specialised version for efficiency.
 222 finally :: IO a -> IO b -> IO a
 223 a `finally` sequel =
 224   block (do
 225     r <- catch
 226              (unblock a)
 227              (\e -> do { sequel; throw e })
 228     sequel
 229     return r
 230   )
 231
 232 bracket_ :: IO a -> IO b -> IO c -> IO c
 233 bracket_ before after thing = bracket before (const after) (const thing)