4.8. Exception

The Exception library provides an interface for raising and catching both built-in and user defined exceptions.

Exceptions are defined by the following (non-abstract) datatype:

-- instance of Eq, Ord, Show, Typeable
data Exception
  = IOException 	IOError		-- IO exceptions (from 'ioError')
  | ArithException  	ArithException	-- Arithmetic exceptions
  | ArrayException	ArrayException  -- Array-related exceptions
  | ErrorCall		String		-- Calls to 'error'
  | NoMethodError       String		-- A non-existent method was invoked
  | PatternMatchFail	String		-- A pattern match failed
  | RecSelError		String		-- Selecting a non-existent field
  | RecConError		String		-- Field missing in record construction
  | RecUpdError		String		-- Record doesn't contain updated field
  | AssertionFailed	String		-- Assertions
  | DynException	Dynamic		-- Dynamic exceptions
  | AsyncException	AsyncException	-- Externally generated errors
  | PutFullMVar 			-- Put on a full MVar
  | BlockedOnDeadMVar			-- Blocking on a dead MVar
  | NonTermination

-- instance of Eq, Ord, Show, Typeable
data ArithException
  = Overflow
  | Underflow
  | LossOfPrecision
  | DivideByZero
  | Denormal

-- instance of Eq, Ord, Show, Typeable
data AsyncException
  = StackOverflow
  | HeapOverflow
  | ThreadKilled

-- instance of Eq, Ord, Show, Typeable
data ArrayException
  = IndexOutOfBounds  	String		-- out-of-range array access
  | UndefinedElement	String		-- evaluating an undefined element

4.8.1. Kinds of exception

An implementation should raise the appropriate exception when once of the following conditions arises:

IOException

These are the standard IO exceptions from Haskell's IO monad. IO Exceptions are raised by IO.ioError.

ArithException

Exceptions raised by arithmetic operations[1]:

Overflow

Underflow

LossOfPrecision

DivisionByZero

Denormal

ArrayException

Exceptions raised by array-related operations[2]:

IndexOutOfBounds

An attempt was made to index an array outside its declared bounds.

UndefinedElement

An attempt was made to evaluate an element of an array that had not been initialized.

ErrorCall

The ErrorCall exception is thrown by error. The String argument of ErrorCall is the string passed to error when it was called.

NoMethodError

An attempt was made to invoke a class method which has no definition in this instance, and there was no default definition given in the class declaration. GHC issues a warning when you compile an instance which has missing methods.

PatternMatchFail

A pattern matching failure. The String argument should contain a descriptive message including the function name, source file and line number.

RecSelError

A field selection was attempted on a constructor that doesn't have the requested field. This can happen with multi-constructor records when one or more fields are missing from some of the constructors. The String argument gives the location of the record selection in the source program.

RecConError

An attempt was made to evaluate a field of a record for which no value was given at construction time. The String argument gives the location of the record construction in the source program.

RecUpdError

An attempt was made to update a field in a record, where the record doesn't have the requested field. This can only occur with multi-constructor records, when one or more fields are missing from some of the constructors. The String argument gives the location of the record update in the source program.

AssertionFailed

This exception is thrown by the assert operation when the condition fails. The String argument contains the location of the assertion in the source program.

DynException

Dynamically typed exceptions, described in Section 4.8.5.

AsyncException

Asynchronous exceptions. These are described in more detail in Section 4.8.7. The types of asynchronous exception are:

StackOverflow

The current thread's stack exceeded its limit. Since an exception has been raised, the thread's stack will certainly be below its limit again, but the programmer should take remedial action immediately.

HeapOverflow

The program's heap is reaching its limit, and the program should take action to reduce the amount of live data it has[3][4].

ThreadKilled

This exception is raised by another thread calling killThread (see Section 2.2), or by the system if it needs to terminate the thread for some reason.

PutFullMVar

A call to putMVar (Section 2.4.3) was passed a full MVar .

BlockedOnDeadMVar

The current thread was executing a call to takeMVar (Section 2.4.3) that could never return, because there are no other references to this MVar.

NonTermination

The current thread is stuck in an infinite loop. This exception may or may not be thrown when the program is non-terminating.

4.8.2. Throwing exceptions

Exceptions may be thrown explicitly from anywhere:

throw :: Exception -> a

4.8.3. The try functions

There are several functions for catching and examining exceptions; all of them may only be used from within the IO monad. Firstly the try family of functions:

tryAll    :: a    -> IO (Either Exception a)
tryAllIO  :: IO a -> IO (Either Exception a)
try	  :: (Exception -> Maybe b) -> a    -> IO (Either b a)
tryIO	  :: (Exception -> Maybe b) -> IO a -> IO (Either b a)

The simplest version is tryAll. It takes a single argument, evaluates it (as if you'd applied seq to it), and returns either Right a if the evaluation succeeded with result a, or Left e if an exception was raised, where e is the exception. Note that due to Haskell's unspecified evaluation order, an expression may return one of several possible exceptions: consider the expression error "urk" + 1 `div` 0. Does tryAll return Just (ErrorCall "urk") or Just (ArithError DivideByZero)? The answer is "either": tryAll makes a non-deterministic choice about which exception to return. If you call it again, you might get a different exception back. This is ok, because tryAll is an IO computation.

tryAllIO is the same as tryAll except that the argument to evaluate is an IO computation. Don't try to use tryAll to catch exceptions in IO computations: in GHC an expression of type IO a is in fact a function, so evaluating it does nothing at all (and therefore raises no exceptions). Hence the need for tryAllIO, which runs IO computations properly.

The functions try and tryIO take an extra argument which is an exception predicate, a function which selects which type of exceptions we're interested in. The full set of exception predicates is given below:

justIoErrors		:: Exception -> Maybe IOError
justArithExceptions 	:: Exception -> Maybe ArithException
justErrors		:: Exception -> Maybe String
justDynExceptions	:: Exception -> Maybe Dynamic
justAssertions		:: Exception -> Maybe String
justAsyncExceptions 	:: Exception -> Maybe AsyncException

For example, to catch just calls to 'error' we could use something like

    result <- try justErrors thing_to_try

Any other exceptions which aren't matched by the predicate are re-raised, and may be caught by an enclosing try or catch.

4.8.4. The catch functions

The catch family is similar to the try family:

catchAll   :: a    -> (Exception -> IO a) -> IO a
catchAllIO :: IO a -> (Exception -> IO a) -> IO a
catch      :: (Exception -> Maybe b) -> a    -> (b -> IO a) -> IO a
catchIO    :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a

The difference is that instead of returning an Either type as the result, the catch functions take a handler argument which is invoked in the case that an exception was raised while evaluating the first argument.

catch and catchIO take exception predicate arguments in the same way as try and tryIO.

Note that catchIO justIoErrors is identical to IO.catch. In fact, the implementation of IO errors in GHC uses exceptions "under the hood".

Also, don't forget to import Prelude hiding (catch) when using this library, to avoid the name clash between Exception.catch and IO.catch.

4.8.5. Dynamic Exceptions

Because the Exception datatype isn't extensible, we added an interface for throwing and catching exceptions of type Dynamic (see Section 4.7), which allows exception values of any type in the Typeable class to be thrown and caught.

throwDyn :: Typeable exception => exception -> b
catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a

The catchDyn function only catches exceptions of the required type; all other exceptions are re-thrown as with catchIO and friends above.

4.8.6. Other Utilities

The bracket functions are useful for making sure that resources are released properly by code that may raise exceptions:

	bracket  	:: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
	bracket_ 	:: IO a -> IO b -> IO c -> IO c
	finally		:: IO a -> IO b -> IO b

For example, to open a file, do some work on it and then close it again, we might use something like:

process_file =
  bracket
     (openFile "filename" ReadMode)
     (closeFile)
     (do { ... })

bracket works as follows: it executes its first argument ("open"), then its third argument, followed finally by its second argument ("close"). If the third argument happened to raise an exception, then the close operation will still be performed, and the exception will be re-raised.

This means that in the example above the file will always be closed, even if an error occurs during processing.

The arguments to bracket are in this order so that we can partially apply it, like:

withFile name = bracket (openFile name) closeFile

The bracket_ function is a variant of bracket that throws away the result of the open, and finally is an even simpler version where we just want some closing code.

4.8.7. Asynchronous exceptions

Asynchronous exceptions are so-called because they arise due to external influences, and can be raised at any point during execution. StackOverflow and HeapOverflow are two examples of system-generated asynchronous exceptions.

The primary source of asynchronous exceptions, however, is raiseInThread, from the Concurrent library (see Section 2.2):

   raiseInThread :: ThreadId -> Exception -> IO ()

raiseInThread allows one running thread to raise an arbitrary exception in another thread. The exception is therefore asynchronous with respect to the target thread, which could be doing anything at the time it receives the exception. Great care should be taken with asynchronous exceptions; it is all too easy to introduce race conditions by the over zealous use of raiseInThread.

There are two functions which allow a thread to control the delivery of asynchronous exceptions during critical sections:

   blockAsyncExceptions   :: IO () -> IO ()
   unblockAsyncExceptions :: IO () -> IO ()

Applying blockAsyncExceptions to a computation will execute that computation with asynchronous exceptions blocked. That is, any thread which attempts to raise an exception in the current thread will be blocked until asynchronous exceptions are enabled again. There's no need to worry about re-enabling asynchronous exceptions; that's done automatically on exiting the scope of blockAsyncExceptions.

To re-enable asynchronous exceptions inside the scope of blockAsyncExceptions, unblockAsyncExceptions can be used. It scopes in exactly the same way, so on exit from unblockAsyncExceptions asynchronous exception delivery will be disabled again.

For some examples of the use of these functions, see the definitions of finally and bracket in the sources to the Exception module.

4.8.7.1. Applying blockAsyncExceptions to an exception handler

There's an implied blockAsyncExceptions around every exception handler in a call to one of the catch family of functions. This is because that's what you want most of the time - it eliminates a common race condition in starting an exception handler, because there may be no exception handler on the stack to handle another exception if one arrives immediately. If asynchronous exceptions are blocked on entering the handler, though, we have time to install a new exception handler before being interrupted. If this weren't the default, you'd have to write something like

      blockAsyncExceptions (
           catchAllIO (unblockAsyncExceptions (...))
                      (\e -> handler)
      )

If you need to unblock asynchronous exceptions again in the exceptions handler, just use unblockAsyncExceptions as normal.

Note that try and friends don't have a similar default, because there is no exception handler in this case. If you want to use try in an asynchronous-exception-safe way, you'll need to use blockAsyncExceptions.

4.8.7.2. Interruptible operations

Some operations are interruptible, which means that they can receive asynchronous exceptions even in the scope of a blockAsyncExceptions. Any function which may itself block is defined as interruptible; this includes takeMVar, and most I/O-performing operations. The reason for having interruptible operations is so that we can write things like

      blockAsyncExceptions (
         a <- takeMVar m
         catch (unblockAsyncExceptions (...))
               (\e -> ...)
      )

if the takeMVar wasn't interruptible, then this particular combination could lead to deadlock, because the thread itself would be blocked in a state where it can't receive any asynchronous exceptions. With takeMVar interruptible, however, we can be safe in the knowledge that the thread can receive exceptions right up until the point when the takeMVar succeeds. Similar arguments apply for other interruptible operations like IO.openFile.

Notes

[1]

GHC currently does not throw ArithExceptions.

[2]

GHC currently does not throw ArrayExceptions.

[3]

Which thread receives this exception is currently undefined.

[4]

GHC currently does not throw HeapOverflow exceptions.