<div dir="ltr">Control.Exception currently lacks a good way to supply extra<br>information along with exceptions.  For example, exceptions could be<br>thrown along with their callstack[1] or implicit stack[2], but we have<br>no generic way to include this information with exceptions.<br><font face="arial, helvetica, sans-serif"><br>Proposed Solution<br>=================<br><br></font>The proposed solution is to add a list of `SomeExceptionInfo` to the<br>`SomeException` datatype.  This list stores additional information<br>about the exception.  These `ExceptionInfo` instances use a mechanism<br>which is pretty much identical to the dynamic way the `Exception` type<br>works:<br><br><font face="arial, helvetica, sans-serif">    data SomeException = forall e . Exception e =><br>        SomeExceptionWithInfo e [SomeExceptionInfo]<br><br>    data SomeExceptionInfo = forall a . ExceptionInfo a =><br>        SomeExceptionInfo a<br><br>    class Typeable a => ExceptionInfo a where<br>        displayExceptionInfo :: a -> String<br><br>    addExceptionInfo<br>        :: (ExceptionInfo a, Exception e)<br>        => a -> e -> SomeException<br>    addExceptionInfo x (toException -> SomeExceptionWithInfo e xs) =<br>        SomeExceptionWithInfo e (SomeExceptionInfo x : xs)<br></font><br>`ExceptionInfo` lacks the to / from functions that `Exception` has,<br>because I don't see much point in supporting a hierarchy for exception<br>info.  The `Typeable` superclass constraint supplies the necessary<br>casting.<br><br>`SomeExceptionInfo` could validly instead just use the constraint<br>`(Typeable a, Show a)`.  However, I believe it's good to have a new<br>class for this so that:<br><br>  * The user can specify a custom `displayExceptionInfo`<br>  implementation, for when this extra info is presented to the user.<br>  This function would be invoked by the `show` implementation for<br>  `SomeException`.<br><br>  * Types need to opt-in to be usable with `SomeExceptionInfo`.<br>  Similarly to exceptions, I imagine that a type with a<br>  `ExceptionInfo` instance won't be used for anything but acting as<br>  such an annotation.  Having a class for this allows you to ask GHCI<br>  about all in-scope exception info types via `:info ExceptionInfo`.<br><br>Backwards Compatibility<br>=======================<br><br>GHC 7.10 adds support for bidirectional pattern synonyms.  This means<br>that this change could be made without breaking code:<br><br>    pattern SomeException x <- SomeExceptionWithInfo x _ where<br>        SomeException x = SomeExceptionWithInfo x []<br><br>Note that consumers of this do not need to enable `-XPatternSynonyms`.<br><br>Applications<br>============<br><br>Callstacks<br>----------<br><br>As mentioned at the beginning, this can be used to add callstacks to<br>exceptions:<br><br>    newtype ExceptionCallStack =<br>        ExceptionCallStack { unExceptionCallStack :: [String] }<br>        deriving Typeable<br><br>    instance ExceptionInfo ExceptionCallStack where<br>        displayExceptionInfo = unlines . unExceptionCallStack<br><br>    throwIOWithStack :: Exception e => e -> IO a<br>    throwIOWithStack e = do<br>        stack <- currentCallStack<br>        if null stack<br>            then throwIO e<br>            else throwIO (addExceptionInfo (ExceptionCallStack stack) e)<br><br>I see little downside for making something like this the default<br>implementation `throwIO`.  Each rethrowing of the `SomeException`<br>would add an additional stacktrace to its annotation, much like the<br>output of `+RTS -xc`.  Unlike this debug output, though, the<br>stacktraces would be associated with the exception, rather than just<br>listing locations that exceptions were thrown.  This makes it<br>tractable to debug exceptions that occur in concurrent programs, or in<br>programs which frequently throw exceptions during normal functioning.<br><br>Throwing Exceptions in Handlers<br>-------------------------------<br><br>Example:<br><br>    main =<br>        throwIO InformativeErrorMessage `finally`<br>        throwIO ObscureCleanupIssue<br><br>While `InformativeErrorMessage` got thrown, the user doesn't see it,<br>since `ObscureCleanupIssue` is thrown instead.  This causes a few<br>issues:<br><br>1. If the exception is handled by the default handler and yielded to<br>   the user, then the more informative error is lost.<br><br>2. Callers who expect to catch the "Informative error message" won't<br>   run their handlers for this exception type.<br><br>Problem 1 can now easily be resolved by adding some info to the<br>exception:<br><br>    data ExceptionCause = ExceptionCause<br>        { unExceptionCause :: SomeException }<br>        deriving Typeable<br><br>    instance ExceptionInfo ExceptionCause where<br>        displayExceptionInfo fe =<br>            "thrown while handling " ++<br>            displayException (unExceptionCause fe)<br><br>    catch :: Exception e => IO a -> (e -> IO a) -> IO a<br>    catch f g = f `oldCatch` handler<br>      where<br>        handler ex = g ex `oldCatch` \(ex' :: SomeException) -><br>            throwIO (addExceptionInfo info ex')<br>          where<br>            info = ExceptionCause (toException ex)<br><br>This implementation of `catch` is written in a backwards-compatible<br>way, such that the exception thrown during finalization is still the<br>one that gets rethrown.  The "original" exception is recorded in the<br>added info.  This is the same approach used by Python 3's<br>`__context__` attribute[3].  This was brought to my attention in a<br>post by Mike Meyer[4], in a thread about having bracket not suppress<br>the original exception[5].<br><br>This doesn't directly resolve issue #2, due to this backwards<br>compatibility.  With the earlier example, a `catch` handler for<br>`InformativeErrorMessage` won't be invoked, because it isn't the<br>exception being rethrown.  This can be resolved by having a variant of<br>catch which instead throws the original exception.  This might be a<br>good default for finalization handlers like `bracket` and `finally`.<br><br>Asynchronous Exceptions<br>-----------------------<br><br>Currently, the only reliable way to catch exceptions, ignoring async<br>exceptions, is to fork a new thread.  This is the approach used by the<br>enclosed-exceptions[6] package.  I think it's quite ugly that we need<br>to go to such lengths due to the lack of one bit of information about<br>the exception!  This would resolve ghc trac #5902[7].<br><br>base-4.7 added the `SomeAsyncException` type, but this doesn't enforce<br>anything.  Any exception can be thrown as a sync or async exception.<br>Instead, we ought to have a reliable way to know if an exception is<br>synchronous or asynchronous.  Here's what this would look like:<br><br>    data IsAsync = IsAsync<br>        deriving (Typeable, Show)<br><br>    instance ExceptionInfo IsAsync where<br>        displayExceptionInfo IsAsync = "thrown asynchronously"<br><br>    throwTo :: Exception e => ThreadId -> e -> IO ()<br>    throwTo tid = oldThrowTo tid . addExceptionInfo IsAsync<br><br>The details of this get a bit tricky: What happens if `throwIO` is<br>used to rethrow a `SomeException` which has this `IsAsync` flag set?<br>I'm going to leave out my thoughts on this for now as the interactions<br>between unsafePerformIO and the concept of "rethrowing" async<br>exceptions.  Such details are explained in a post by Edsko de Vries[8]<br>and ghc trac #2558[9].<br><br>Issue: fromException loses info<br>===============================<br><br>I can think of one main non-ideal aspect of this proposal:<br><br>Currently, the `toException` and `fromException` methods usually form<br>a prism.  In other words, when `fromException` yields a `Just`, you<br>should get the same `SomeException` when using `toException` on that<br>value.<br><br>For example,<br><br>    fail "testing 1 2 3" `catch` \(ex :: SomeException) -> throwIO ex<br><br>is equivalent to<br><br>    fail "testing 3 4 5" `catch` \(ex :: IOError) -> throwIO ex<br><br>However, with exception info added to just `SomeException`, and no<br>changes to existing `Exception` instances, this<br>doesn't hold.  Exceptions caught as a specific exception type get<br>rethrown with less information.<br><br>One resolution to this is be to add `[SomeExceptionInfo]` as a field<br>to existing `Exception` instances.  This would require the use of<br>non-default implementations of the `toException` and `fromException`<br>instances.<br><br>Another approach is to have variants of `catch` and `throw` which also<br>pass around the `[SomeExceptionInfo]`.<br><br>[1] <a href="https://hackage.haskell.org/package/base-4.8.0.0/docs/GHC-Stack.html#currentCallStack">https://hackage.haskell.org/package/base-4.8.0.0/docs/GHC-Stack.html#currentCallStack</a><br>[2] <a href="https://ghc.haskell.org/trac/ghc/wiki/ExplicitCallStack/ImplicitLocations">https://ghc.haskell.org/trac/ghc/wiki/ExplicitCallStack/ImplicitLocations</a><br>[3] <a href="https://www.python.org/dev/peps/pep-3134/">https://www.python.org/dev/peps/pep-3134/</a><br>[4] <a href="https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114987.html">https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114987.html</a><br>[5] <a href="https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114986.html">https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114986.html</a><br>[6] <a href="https://hackage.haskell.org/package/enclosed-exceptions">https://hackage.haskell.org/package/enclosed-exceptions</a><br>[7] <a href="https://ghc.haskell.org/trac/ghc/ticket/5902">https://ghc.haskell.org/trac/ghc/ticket/5902</a><br>[8] <a href="http://www.edsko.net/2013/06/11/throwTo/">http://www.edsko.net/2013/06/11/throwTo/</a><br>[9] <a href="https://ghc.haskell.org/trac/ghc/ticket/2558">https://ghc.haskell.org/trac/ghc/ticket/2558</a><br></div>