monad-exception-0.1: Exstensible monadic exceptions

Safe HaskellSafe-Infered

Control.Exception.Monadic

Contents

Description

This module is intended as a drop-in replacement for Control.Exception.

Synopsis

Documentation

class Monad m => MonadException m whereSource

The MonadException type class. Minimal complete definition: throw, catch.

Methods

throw :: Exception e => e -> m aSource

Generalized version of throwIO.

catch :: Exception e => m a -> (e -> m a) -> m aSource

Generalized version of catch.

bracket :: m a -> (a -> m b) -> (a -> m c) -> m cSource

Generalized version of bracket.

Catching exceptions

The catch functions

catches :: MonadException m => m a -> [Handler m a] -> m aSource

Generalized version of catches.

data Handler m a Source

Generalized version of Handler. You need this when using catches.

Constructors

forall e . Exception e => Handler (e -> m a) 

catchJust :: (MonadException m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m aSource

Generalized version of catchJust.

The handle functions

handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m aSource

A version of catch with the arguments swapped around. See handle.

handleJust :: (MonadException m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m aSource

A version of catchJust with the arguments swapped around. See handleJust.

The try functions

try :: (MonadException m, Exception e) => m a -> m (Either e a)Source

A generalized version of try.

tryJust :: (MonadException m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)Source

A generalized version of tryJust.

Utilities

bracket_ :: MonadException m => m a -> m b -> m c -> m cSource

Generalized version of bracket_.

bracketOnError :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m cSource

Generalized version of bracketOnError.

finally :: MonadException m => m a -> m b -> m aSource

Generalized version of finally.

onException :: MonadException m => m a -> m b -> m aSource

Generalized version of onException.

The evaluate functions

evaluate :: MonadBase IO m => a -> m aSource

Generalized version of evaluate. This only works on IO-like monads. See unsafeEvaluate for a version that works on every MonadException.

unsafeEvaluate :: MonadException m => a -> m aSource

Generalized version of evaluate. This uses unsafePerformIO behind the scenes to do something kind of similar to what the spoon package does.

The mapException function

mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a

This function maps one exception into another as proposed in the paper "A semantics for imprecise exceptions".

Asynchronous exceptions

throwTo :: (MonadBase IO m, Exception e) => ThreadId -> e -> m ()Source

Generalized version of throwTo.

mask :: MonadBaseControl IO m => ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a) -> m aSource

Generalized version of mask.

mask_ :: MonadBaseControl IO m => m a -> m aSource

Generalized version of mask.

uninterruptibleMask :: MonadBaseControl IO m => ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a) -> m aSource

Generalized version of mask.

uninterruptibleMask_ :: MonadBaseControl IO m => m a -> m aSource

Generalized version of mask.

data MaskingState

Describes the behaviour of a thread when an asynchronous exception is received.

Constructors

Unmasked

asynchronous exceptions are unmasked (the normal state)

MaskedInterruptible

the state during mask: asynchronous exceptions are masked, but blocking operations may still be interrupted

MaskedUninterruptible

the state during uninterruptibleMask: asynchronous exceptions are masked, and blocking operations may not be interrupted

allowInterrupt :: MonadBase IO m => m ()Source

Generalized version of allowInterrupt.

Exceptions (re-exported from Control.Exception)

data SomeException where

The SomeException type is the root of the exception type hierarchy. When an exception of type e is thrown, behind the scenes it is encapsulated in a SomeException.

Constructors

SomeException :: Exception e => e -> SomeException 

class (Typeable e, Show e) => Exception e where

Any type that you wish to throw or catch as an exception must be an instance of the Exception class. The simplest case is a new exception type directly below the root:

 data MyException = ThisException | ThatException
     deriving (Show, Typeable)

 instance Exception MyException

The default method definitions in the Exception class do what we need in this case. You can now throw and catch ThisException and ThatException as exceptions:

*Main> throw ThisException `catch` \e -> putStrLn ("Caught " ++ show (e :: MyException))
Caught ThisException

In more complicated examples, you may wish to define a whole hierarchy of exceptions:

 ---------------------------------------------------------------------
 -- Make the root exception type for all the exceptions in a compiler

 data SomeCompilerException = forall e . Exception e => SomeCompilerException e
     deriving Typeable

 instance Show SomeCompilerException where
     show (SomeCompilerException e) = show e

 instance Exception SomeCompilerException

 compilerExceptionToException :: Exception e => e -> SomeException
 compilerExceptionToException = toException . SomeCompilerException

 compilerExceptionFromException :: Exception e => SomeException -> Maybe e
 compilerExceptionFromException x = do
     SomeCompilerException a <- fromException x
     cast a

 ---------------------------------------------------------------------
 -- Make a subhierarchy for exceptions in the frontend of the compiler

 data SomeFrontendException = forall e . Exception e => SomeFrontendException e
     deriving Typeable

 instance Show SomeFrontendException where
     show (SomeFrontendException e) = show e

 instance Exception SomeFrontendException where
     toException = compilerExceptionToException
     fromException = compilerExceptionFromException

 frontendExceptionToException :: Exception e => e -> SomeException
 frontendExceptionToException = toException . SomeFrontendException

 frontendExceptionFromException :: Exception e => SomeException -> Maybe e
 frontendExceptionFromException x = do
     SomeFrontendException a <- fromException x
     cast a

 ---------------------------------------------------------------------
 -- Make an exception type for a particular frontend compiler exception

 data MismatchedParentheses = MismatchedParentheses
     deriving (Typeable, Show)

 instance Exception MismatchedParentheses where
     toException   = frontendExceptionToException
     fromException = frontendExceptionFromException

We can now catch a MismatchedParentheses exception as MismatchedParentheses, SomeFrontendException or SomeCompilerException, but not other types, e.g. IOException:

*Main> throw MismatchedParentheses catch e -> putStrLn ("Caught " ++ show (e :: MismatchedParentheses))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses catch e -> putStrLn ("Caught " ++ show (e :: SomeFrontendException))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses catch e -> putStrLn ("Caught " ++ show (e :: SomeCompilerException))
Caught MismatchedParentheses
*Main> throw MismatchedParentheses catch e -> putStrLn ("Caught " ++ show (e :: IOException))
*** Exception: MismatchedParentheses

data IOException

Exceptions that occur in the IO monad. An IOException records a more specific error type, a descriptive string and maybe the handle that was used when the error was flagged.

data ArrayException

Exceptions generated by array operations

Constructors

IndexOutOfBounds String

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

UndefinedElement String

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

data AsyncException

Asynchronous exceptions.

Constructors

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. Notes:

  • It is undefined which thread receives this exception.
  • GHC currently does not throw HeapOverflow exceptions.
ThreadKilled

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

UserInterrupt

This exception is raised by default in the main thread of the program when the user requests to terminate the program via the usual mechanism(s) (e.g. Control-C in the console).

data NonTermination

Thrown when the runtime system detects that the computation is guaranteed not to terminate. Note that there is no guarantee that the runtime system will notice whether any given computation is guaranteed to terminate or not.

Constructors

NonTermination 

data NestedAtomically

Thrown when the program attempts to call atomically, from the stm package, inside another call to atomically.

Constructors

NestedAtomically 

data BlockedIndefinitelyOnMVar

The thread is blocked on an MVar, but there are no other references to the MVar so it can't ever continue.

data BlockedIndefinitelyOnSTM

The thread is waiting to retry an STM transaction, but there are no other references to any TVars involved, so it can't ever continue.

data Deadlock

There are no runnable threads, so the program is deadlocked. The Deadlock exception is raised in the main thread only.

Constructors

Deadlock 

data NoMethodError

A class method without a definition (neither a default definition, nor a definition in the appropriate instance) was called. The String gives information about which method it was.

Constructors

NoMethodError String 

data PatternMatchFail

A pattern match failed. The String gives information about the source location of the pattern.

Constructors

PatternMatchFail String 

data RecConError

An uninitialised record field was used. The String gives information about the source location where the record was constructed.

Constructors

RecConError String 

data RecSelError

A record selector was applied to a constructor without the appropriate field. This can only happen with a datatype with multiple constructors, where some fields are in one constructor but not another. The String gives information about the source location of the record selector.

Constructors

RecSelError String 

data RecUpdError

A record update was performed on a constructor without the appropriate field. This can only happen with a datatype with multiple constructors, where some fields are in one constructor but not another. The String gives information about the source location of the record update.

Constructors

RecUpdError String 

data ErrorCall

This is thrown when the user calls error. The String is the argument given to error.

Constructors

ErrorCall String