- data GhcException
- showGhcException :: GhcException -> String -> String
- throwGhcException :: GhcException -> a
- handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
- ghcError :: GhcException -> a
- progName :: String
- pgmError :: String -> a
- panic :: String -> a
- panicFastInt :: String -> FastInt
- assertPanic :: String -> Int -> a
- trace :: String -> a -> a
- class (Typeable e, Show e) => Exception e where
- toException :: e -> SomeException
- fromException :: SomeException -> Maybe e
- showException :: Exception e => e -> String
- try :: Exception e => IO a -> IO (Either e a)
- tryMost :: IO a -> IO (Either SomeException a)
- throwTo :: Exception e => ThreadId -> e -> IO ()
- installSignalHandlers :: IO ()
- interruptTargetThread :: MVar [ThreadId]
Documentation
data GhcException Source
showGhcException :: GhcException -> String -> StringSource
throwGhcException :: GhcException -> aSource
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m aSource
ghcError :: GhcException -> aSource
panicFastInt :: String -> FastIntSource
assertPanic :: String -> Int -> aSource
trace :: String -> a -> aSource
When called, trace
outputs the string in its first argument, before
returning the second argument as its result. The trace
function is not
referentially transparent, and should only be used for debugging, or for
monitoring execution. Some implementations of trace
may decorate the string
that's output to indicate that you're tracing. The function is implemented on
top of putTraceMsg
.
class (Typeable e, Show e) => Exception e whereSource
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 MismatchedParenthesescatch
e -> putStrLn ("Caught " ++ show (e :: MismatchedParentheses)) Caught MismatchedParentheses *Main> throw MismatchedParenthesescatch
e -> putStrLn ("Caught " ++ show (e :: SomeFrontendException)) Caught MismatchedParentheses *Main> throw MismatchedParenthesescatch
e -> putStrLn ("Caught " ++ show (e :: SomeCompilerException)) Caught MismatchedParentheses *Main> throw MismatchedParenthesescatch
e -> putStrLn ("Caught " ++ show (e :: IOException)) *** Exception: MismatchedParentheses
toException :: e -> SomeExceptionSource
fromException :: SomeException -> Maybe eSource
showException :: Exception e => e -> StringSource
try :: Exception e => IO a -> IO (Either e a)Source
Similar to catch
, but returns an Either
result which is
(
if no exception of type Right
a)e
was raised, or (
if an exception of type Left
ex)e
was raised and its value is ex
.
If any other type of exception is raised than it will be propogated
up to the next enclosing exception handler.
try a = catch (Right `liftM` a) (return . Left)
Note that System.IO.Error also exports a function called
System.IO.Error.try
with a similar type to Control.Exception.try
,
except that it catches only the IO and user families of exceptions
(as required by the Haskell 98 IO
module).
tryMost :: IO a -> IO (Either SomeException a)Source
tryMost is like try, but passes through UserInterrupt and Panic exceptions. Used when we want soft failures when reading interface files, for example.
throwTo :: Exception e => ThreadId -> e -> IO ()Source
throwTo
raises an arbitrary exception in the target thread (GHC only).
throwTo
does not return until the exception has been raised in the
target thread.
The calling thread can thus be certain that the target
thread has received the exception. This is a useful property to know
when dealing with race conditions: eg. if there are two threads that
can kill each other, it is guaranteed that only one of the threads
will get to kill the other.
Whatever work the target thread was doing when the exception was raised is not lost: the computation is suspended until required by another thread.
If the target thread is currently making a foreign call, then the
exception will not be raised (and hence throwTo
will not return)
until the call has completed. This is the case regardless of whether
the call is inside a mask
or not.
Important note: the behaviour of throwTo
differs from that described in
the paper "Asynchronous exceptions in Haskell"
(http://research.microsoft.com/~simonpj/Papers/asynch-exns.htm).
In the paper, throwTo
is non-blocking; but the library implementation adopts
a more synchronous design in which throwTo
does not return until the exception
is received by the target thread. The trade-off is discussed in Section 9 of the paper.
Like any blocking operation, throwTo
is therefore interruptible (see Section 5.3 of
the paper). Unlike other interruptible operations, however, throwTo
is always interruptible, even if it does not actually block.
There is no guarantee that the exception will be delivered promptly,
although the runtime will endeavour to ensure that arbitrary
delays don't occur. In GHC, an exception can only be raised when a
thread reaches a safe point, where a safe point is where memory
allocation occurs. Some loops do not perform any memory allocation
inside the loop and therefore cannot be interrupted by a throwTo
.
Blocked throwTo
is fair: if multiple threads are trying to throw an
exception to the same target thread, they will succeed in FIFO order.