Proposal: Add exception info
Carter Schonwald
carter.schonwald at gmail.com
Tue Apr 21 22:06:17 UTC 2015
On a more important note: assuming ghc 7.12 has support for informative
stack traces via dwarf by default, wouldn't that eliminate the need for
this proposal? Namely : there perhaps should be some reasonable way to talk
about concatting stack traces perhaps?
Phrased differently: how is the info that should perhaps be in informative
stack traces not subsuming the info of this proposal?
On Tuesday, April 21, 2015, Michael Sloan <mgsloan at gmail.com> wrote:
> Ah, but it looks like Niklas does have a patch which adds implicit
> locations to such functions: https://phabricator.haskell.org/D861
>
> However, there are some issues with changing the API of these functions:
> https://phabricator.haskell.org/D861#23250
>
> (as mentioned in the "Backporting srcLoc to the GHC 7.10 branch" thread)
>
> On Tue, Apr 21, 2015 at 2:04 PM, Michael Sloan <mgsloan at gmail.com
> <javascript:_e(%7B%7D,'cvml','mgsloan at gmail.com');>> wrote:
>
>> Hmm, that patch doesn't appear to add stack traces to 'Prelude.error',
>> which is what Carter wants here. Also, I think it would be done with
>> profiling callstacks rather than implicit callstacks. But it's certainly
>> also useful to have functions which do the same with implicit callstacks!
>>
>>
>> On Tue, Apr 21, 2015 at 1:55 PM, Evan Laforge <qdunkan at gmail.com
>> <javascript:_e(%7B%7D,'cvml','qdunkan at gmail.com');>> wrote:
>>
>>> Maybe I'm missing something, but isn't this already implemented?
>>>
>>> https://phabricator.haskell.org/D578
>>>
>>> On Tue, Apr 21, 2015 at 1:37 PM, Michael Sloan <mgsloan at gmail.com
>>> <javascript:_e(%7B%7D,'cvml','mgsloan at gmail.com');>> wrote:
>>> > On Thu, Apr 16, 2015 at 8:08 PM, Carter Schonwald
>>> > <carter.schonwald at gmail.com
>>> <javascript:_e(%7B%7D,'cvml','carter.schonwald at gmail.com');>> wrote:
>>> >>
>>> >> if you can patch prelude error to include stack traces, i will owe
>>> you a
>>> >> >=1 beer each at the next two icfps. Thats all i want for christmas.
>>> :)
>>> >
>>> >
>>> > Sounds good! No promises, but I'll be giving this a try soon. Looking
>>> > forward to ICFP beers either way :D
>>> >
>>> >> i can't speak for how a different patch might work out, because thats
>>> not
>>> >> what I'd tried at the time. If you have a go, please share the
>>> results!
>>> >> -Carter
>>> >>
>>> >> On Wed, Apr 15, 2015 at 12:22 AM, Michael Sloan <mgsloan at gmail.com
>>> <javascript:_e(%7B%7D,'cvml','mgsloan at gmail.com');>> wrote:
>>> >>>
>>> >>> Hi Carter!
>>> >>>
>>> >>> Interesting! This thread, right?
>>> >>>
>>> https://mail.haskell.org/pipermail/libraries/2014-December/024429.html
>>> >>>
>>> >>> I haven't tried this as a patch to base, but I'm certain that the
>>> core of
>>> >>> the proposal has no extra dependencies. Note that the proposal
>>> isn't about
>>> >>> stack traces in particular - that's just one application of being
>>> able to
>>> >>> throw exceptions with extra information.
>>> >>>
>>> >>> Even if `throwTo` isn't modified to throw exceptions with stack
>>> traces,
>>> >>> this functionality could be provided outside of `Control.Exception`
>>> (though,
>>> >>> that does seem like the right place to put it). I'm surprised that
>>> the
>>> >>> circularity was so problematic, though. Why isn't it sufficient to
>>> have an
>>> >>> hs-boot file for `GHC.Stack`, which exports `currentCallStack`?
>>> >>>
>>> >>> -Michael
>>> >>>
>>> >>> On Tue, Apr 14, 2015 at 7:55 PM, Carter Schonwald
>>> >>> <carter.schonwald at gmail.com
>>> <javascript:_e(%7B%7D,'cvml','carter.schonwald at gmail.com');>> wrote:
>>> >>>>
>>> >>>> Hey Michael,
>>> >>>> I actually proposed something along these lines that got OK'd by
>>> >>>> libraries early this past fall, the main challenge we hit was
>>> actually doing
>>> >>>> the enginering to add the stack traces to exceptions! theres some
>>> nasty
>>> >>>> module cycles in base that happen when you try to weave things
>>> around so
>>> >>>> that the standard error "message here" call includes some stack
>>> trace info.
>>> >>>> Have you tried to do that simple starter patch to base?
>>> >>>>
>>> >>>> Chris Allen and I spent like 2 days trying to get it to work and
>>> just
>>> >>>> gave up because of the cycles. We (and others) would probably love
>>> some
>>> >>>> headway on that front.
>>> >>>>
>>> >>>> Theres also some in progress work to use the dwarf debugging info
>>> data
>>> >>>> in >7.10 to provide useful stack traces in the default builds for
>>> GHC afaik,
>>> >>>> 'cause the stack trace functionality you're pointing at currenlty
>>> only work
>>> >>>> on profiled builds
>>> >>>>
>>> >>>> cheers
>>> >>>> -Carter
>>> >>>>
>>> >>>> On Tue, Apr 14, 2015 at 2:38 PM, Michael Sloan <mgsloan at gmail.com
>>> <javascript:_e(%7B%7D,'cvml','mgsloan at gmail.com');>>
>>> >>>> wrote:
>>> >>>>>
>>> >>>>> Control.Exception currently lacks a good way to supply extra
>>> >>>>> information along with exceptions. For example, exceptions could
>>> be
>>> >>>>> thrown along with their callstack[1] or implicit stack[2], but we
>>> have
>>> >>>>> no generic way to include this information with exceptions.
>>> >>>>>
>>> >>>>> Proposed Solution
>>> >>>>> =================
>>> >>>>>
>>> >>>>> The proposed solution is to add a list of `SomeExceptionInfo` to
>>> the
>>> >>>>> `SomeException` datatype. This list stores additional information
>>> >>>>> about the exception. These `ExceptionInfo` instances use a
>>> mechanism
>>> >>>>> which is pretty much identical to the dynamic way the `Exception`
>>> type
>>> >>>>> works:
>>> >>>>>
>>> >>>>> data SomeException = forall e . Exception e =>
>>> >>>>> SomeExceptionWithInfo e [SomeExceptionInfo]
>>> >>>>>
>>> >>>>> data SomeExceptionInfo = forall a . ExceptionInfo a =>
>>> >>>>> SomeExceptionInfo a
>>> >>>>>
>>> >>>>> class Typeable a => ExceptionInfo a where
>>> >>>>> displayExceptionInfo :: a -> String
>>> >>>>>
>>> >>>>> addExceptionInfo
>>> >>>>> :: (ExceptionInfo a, Exception e)
>>> >>>>> => a -> e -> SomeException
>>> >>>>> addExceptionInfo x (toException -> SomeExceptionWithInfo e xs)
>>> =
>>> >>>>> SomeExceptionWithInfo e (SomeExceptionInfo x : xs)
>>> >>>>>
>>> >>>>> `ExceptionInfo` lacks the to / from functions that `Exception` has,
>>> >>>>> because I don't see much point in supporting a hierarchy for
>>> exception
>>> >>>>> info. The `Typeable` superclass constraint supplies the necessary
>>> >>>>> casting.
>>> >>>>>
>>> >>>>> `SomeExceptionInfo` could validly instead just use the constraint
>>> >>>>> `(Typeable a, Show a)`. However, I believe it's good to have a new
>>> >>>>> class for this so that:
>>> >>>>>
>>> >>>>> * The user can specify a custom `displayExceptionInfo`
>>> >>>>> implementation, for when this extra info is presented to the
>>> user.
>>> >>>>> This function would be invoked by the `show` implementation for
>>> >>>>> `SomeException`.
>>> >>>>>
>>> >>>>> * Types need to opt-in to be usable with `SomeExceptionInfo`.
>>> >>>>> Similarly to exceptions, I imagine that a type with a
>>> >>>>> `ExceptionInfo` instance won't be used for anything but acting as
>>> >>>>> such an annotation. Having a class for this allows you to ask
>>> GHCI
>>> >>>>> about all in-scope exception info types via `:info
>>> ExceptionInfo`.
>>> >>>>>
>>> >>>>> Backwards Compatibility
>>> >>>>> =======================
>>> >>>>>
>>> >>>>> GHC 7.10 adds support for bidirectional pattern synonyms. This
>>> means
>>> >>>>> that this change could be made without breaking code:
>>> >>>>>
>>> >>>>> pattern SomeException x <- SomeExceptionWithInfo x _ where
>>> >>>>> SomeException x = SomeExceptionWithInfo x []
>>> >>>>>
>>> >>>>> Note that consumers of this do not need to enable
>>> `-XPatternSynonyms`.
>>> >>>>>
>>> >>>>> Applications
>>> >>>>> ============
>>> >>>>>
>>> >>>>> Callstacks
>>> >>>>> ----------
>>> >>>>>
>>> >>>>> As mentioned at the beginning, this can be used to add callstacks
>>> to
>>> >>>>> exceptions:
>>> >>>>>
>>> >>>>> newtype ExceptionCallStack =
>>> >>>>> ExceptionCallStack { unExceptionCallStack :: [String] }
>>> >>>>> deriving Typeable
>>> >>>>>
>>> >>>>> instance ExceptionInfo ExceptionCallStack where
>>> >>>>> displayExceptionInfo = unlines . unExceptionCallStack
>>> >>>>>
>>> >>>>> throwIOWithStack :: Exception e => e -> IO a
>>> >>>>> throwIOWithStack e = do
>>> >>>>> stack <- currentCallStack
>>> >>>>> if null stack
>>> >>>>> then throwIO e
>>> >>>>> else throwIO (addExceptionInfo (ExceptionCallStack
>>> stack)
>>> >>>>> e)
>>> >>>>>
>>> >>>>> I see little downside for making something like this the default
>>> >>>>> implementation `throwIO`. Each rethrowing of the `SomeException`
>>> >>>>> would add an additional stacktrace to its annotation, much like the
>>> >>>>> output of `+RTS -xc`. Unlike this debug output, though, the
>>> >>>>> stacktraces would be associated with the exception, rather than
>>> just
>>> >>>>> listing locations that exceptions were thrown. This makes it
>>> >>>>> tractable to debug exceptions that occur in concurrent programs,
>>> or in
>>> >>>>> programs which frequently throw exceptions during normal
>>> functioning.
>>> >>>>>
>>> >>>>> Throwing Exceptions in Handlers
>>> >>>>> -------------------------------
>>> >>>>>
>>> >>>>> Example:
>>> >>>>>
>>> >>>>> main =
>>> >>>>> throwIO InformativeErrorMessage `finally`
>>> >>>>> throwIO ObscureCleanupIssue
>>> >>>>>
>>> >>>>> While `InformativeErrorMessage` got thrown, the user doesn't see
>>> it,
>>> >>>>> since `ObscureCleanupIssue` is thrown instead. This causes a few
>>> >>>>> issues:
>>> >>>>>
>>> >>>>> 1. If the exception is handled by the default handler and yielded
>>> to
>>> >>>>> the user, then the more informative error is lost.
>>> >>>>>
>>> >>>>> 2. Callers who expect to catch the "Informative error message"
>>> won't
>>> >>>>> run their handlers for this exception type.
>>> >>>>>
>>> >>>>> Problem 1 can now easily be resolved by adding some info to the
>>> >>>>> exception:
>>> >>>>>
>>> >>>>> data ExceptionCause = ExceptionCause
>>> >>>>> { unExceptionCause :: SomeException }
>>> >>>>> deriving Typeable
>>> >>>>>
>>> >>>>> instance ExceptionInfo ExceptionCause where
>>> >>>>> displayExceptionInfo fe =
>>> >>>>> "thrown while handling " ++
>>> >>>>> displayException (unExceptionCause fe)
>>> >>>>>
>>> >>>>> catch :: Exception e => IO a -> (e -> IO a) -> IO a
>>> >>>>> catch f g = f `oldCatch` handler
>>> >>>>> where
>>> >>>>> handler ex = g ex `oldCatch` \(ex' :: SomeException) ->
>>> >>>>> throwIO (addExceptionInfo info ex')
>>> >>>>> where
>>> >>>>> info = ExceptionCause (toException ex)
>>> >>>>>
>>> >>>>> This implementation of `catch` is written in a backwards-compatible
>>> >>>>> way, such that the exception thrown during finalization is still
>>> the
>>> >>>>> one that gets rethrown. The "original" exception is recorded in
>>> the
>>> >>>>> added info. This is the same approach used by Python 3's
>>> >>>>> `__context__` attribute[3]. This was brought to my attention in a
>>> >>>>> post by Mike Meyer[4], in a thread about having bracket not
>>> suppress
>>> >>>>> the original exception[5].
>>> >>>>>
>>> >>>>> This doesn't directly resolve issue #2, due to this backwards
>>> >>>>> compatibility. With the earlier example, a `catch` handler for
>>> >>>>> `InformativeErrorMessage` won't be invoked, because it isn't the
>>> >>>>> exception being rethrown. This can be resolved by having a
>>> variant of
>>> >>>>> catch which instead throws the original exception. This might be a
>>> >>>>> good default for finalization handlers like `bracket` and
>>> `finally`.
>>> >>>>>
>>> >>>>> Asynchronous Exceptions
>>> >>>>> -----------------------
>>> >>>>>
>>> >>>>> Currently, the only reliable way to catch exceptions, ignoring
>>> async
>>> >>>>> exceptions, is to fork a new thread. This is the approach used by
>>> the
>>> >>>>> enclosed-exceptions[6] package. I think it's quite ugly that we
>>> need
>>> >>>>> to go to such lengths due to the lack of one bit of information
>>> about
>>> >>>>> the exception! This would resolve ghc trac #5902[7].
>>> >>>>>
>>> >>>>> base-4.7 added the `SomeAsyncException` type, but this doesn't
>>> enforce
>>> >>>>> anything. Any exception can be thrown as a sync or async
>>> exception.
>>> >>>>> Instead, we ought to have a reliable way to know if an exception is
>>> >>>>> synchronous or asynchronous. Here's what this would look like:
>>> >>>>>
>>> >>>>> data IsAsync = IsAsync
>>> >>>>> deriving (Typeable, Show)
>>> >>>>>
>>> >>>>> instance ExceptionInfo IsAsync where
>>> >>>>> displayExceptionInfo IsAsync = "thrown asynchronously"
>>> >>>>>
>>> >>>>> throwTo :: Exception e => ThreadId -> e -> IO ()
>>> >>>>> throwTo tid = oldThrowTo tid . addExceptionInfo IsAsync
>>> >>>>>
>>> >>>>> The details of this get a bit tricky: What happens if `throwIO` is
>>> >>>>> used to rethrow a `SomeException` which has this `IsAsync` flag
>>> set?
>>> >>>>> I'm going to leave out my thoughts on this for now as the
>>> interactions
>>> >>>>> between unsafePerformIO and the concept of "rethrowing" async
>>> >>>>> exceptions. Such details are explained in a post by Edsko de
>>> Vries[8]
>>> >>>>> and ghc trac #2558[9].
>>> >>>>>
>>> >>>>> Issue: fromException loses info
>>> >>>>> ===============================
>>> >>>>>
>>> >>>>> I can think of one main non-ideal aspect of this proposal:
>>> >>>>>
>>> >>>>> Currently, the `toException` and `fromException` methods usually
>>> form
>>> >>>>> a prism. In other words, when `fromException` yields a `Just`, you
>>> >>>>> should get the same `SomeException` when using `toException` on
>>> that
>>> >>>>> value.
>>> >>>>>
>>> >>>>> For example,
>>> >>>>>
>>> >>>>> fail "testing 1 2 3" `catch` \(ex :: SomeException) -> throwIO
>>> ex
>>> >>>>>
>>> >>>>> is equivalent to
>>> >>>>>
>>> >>>>> fail "testing 3 4 5" `catch` \(ex :: IOError) -> throwIO ex
>>> >>>>>
>>> >>>>> However, with exception info added to just `SomeException`, and no
>>> >>>>> changes to existing `Exception` instances, this
>>> >>>>> doesn't hold. Exceptions caught as a specific exception type get
>>> >>>>> rethrown with less information.
>>> >>>>>
>>> >>>>> One resolution to this is be to add `[SomeExceptionInfo]` as a
>>> field
>>> >>>>> to existing `Exception` instances. This would require the use of
>>> >>>>> non-default implementations of the `toException` and
>>> `fromException`
>>> >>>>> instances.
>>> >>>>>
>>> >>>>> Another approach is to have variants of `catch` and `throw` which
>>> also
>>> >>>>> pass around the `[SomeExceptionInfo]`.
>>> >>>>>
>>> >>>>> [1]
>>> >>>>>
>>> https://hackage.haskell.org/package/base-4.8.0.0/docs/GHC-Stack.html#currentCallStack
>>> >>>>> [2]
>>> >>>>>
>>> https://ghc.haskell.org/trac/ghc/wiki/ExplicitCallStack/ImplicitLocations
>>> >>>>> [3] https://www.python.org/dev/peps/pep-3134/
>>> >>>>> [4]
>>> >>>>>
>>> https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114987.html
>>> >>>>> [5]
>>> >>>>>
>>> https://mail.haskell.org/pipermail/haskell-cafe/2014-July/114986.html
>>> >>>>> [6] https://hackage.haskell.org/package/enclosed-exceptions
>>> >>>>> [7] https://ghc.haskell.org/trac/ghc/ticket/5902
>>> >>>>> [8] http://www.edsko.net/2013/06/11/throwTo/
>>> >>>>> [9] https://ghc.haskell.org/trac/ghc/ticket/2558
>>> >>>>>
>>> >>>>> _______________________________________________
>>> >>>>> Libraries mailing list
>>> >>>>> Libraries at haskell.org
>>> <javascript:_e(%7B%7D,'cvml','Libraries at haskell.org');>
>>> >>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>>> >>>>>
>>> >>>>
>>> >>>
>>> >>
>>> >
>>> >
>>> > _______________________________________________
>>> > Libraries mailing list
>>> > Libraries at haskell.org
>>> <javascript:_e(%7B%7D,'cvml','Libraries at haskell.org');>
>>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>>> >
>>>
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20150421/b478f38f/attachment-0001.html>
More information about the Libraries
mailing list