I'm generally in favor of adding CallStacks to exceptions (I've often cursed myself for using exceptions and having no clue where they were thrown).
I'm not sure this is the best API though. A few thoughts:
I would prefer to not serialize the CallStack, i.e. get rid of prettyCallStack. Clients might want to inspect the CallStack when they catch an exception.
I wonder if adding the CallStack to SomeException is the best move. If we do this, we're kinda limited to adding the stack to SomeExceptions Show instance. People (AFAIK) don't usually operate directly on SomeException, they use catch and co. to unwrap the exception, which means giving up the CallStack. On the other hand, expecting users to add CallStacks to each exception type is not practical, nor is it clear how we'd wire that into throw.
Perhaps (2) can be solved by keeping the CallStack in SomeException and adding a few helper functions, e.g.
The third is more complicated. For example we can skip stacktrace information for asynchronous exceptions. But in general, we can't determine this exception synchronous or asynchronous. Perhaps throwTo can add to exception extra information. But I do not understand how.
UserException can't kill forked thread because it try catch all (synchronous) exception. If try (processCmd cmd) >>= putMVar ret will be masked timeout will be broken.
I don't think there is any way to attach a stack trace directly to the SomeException data type without breaking code that catches and rethrows exceptions of type e (with the constraint Exception e). So the not-very-nice conclusion is that we in fact *have* to embed the call stack in every exception type. This doesn't mean that throw can't also know how to attach call stacks: for example, the Exception type class could be extended with methods for getting and putting the call stack (and the exception instance can even make decisions like whether or not to keep all call stacks around, or just keep the first one, etc).
Originally I reached the same conclusion: we have to embed call stacks in every exception type. But now I am not so sure: can't we take advantage of the exception hierarchy to "inherit" the stack traces around ?
We cannot touch SomeException without breaking all the existing Exception instances, so we introduce a new primitive ancestor SomeExceptionWithCallStack in the hierarchy:
data SomeExceptionWithCallStack = SomeExceptionWithCallStack Exception [CallStack]data IOError = IOError { ... callStack : [CallStack], ...}class ExceptionWithCallStack e where toExceptionWithCallStack :: e -> SomeExceptionWithCallStack fromExceptionWithCallStack :: SomeExceptionWithCallStack -> Maybe einstance ExceptionWithCallStack SomeException where toExceptionWithCallStack e = SomeExceptionWithCallStack e [] ...instance ExceptionWithCallStack IOError ...
SomeExceptionWithCallStack replaces SomeException as the representation of exceptions.
IOError and others can be an instance of ExceptionWithCallStack if interested in accessing the call stack, e.g. to include it in showException. The IOError constructors should leave the call stack empty, it will be filled in by throw after calling toExceptionWithCallStack.
Existing instances of Exception will not be broken by this change, and perhaps we even can find a way to print the stack trace for them on an uncaught exception. The main issue is that the call stack will be lost on rethrows for them. It could be recovered by means of two auxiliary functions catchWithCallStack and throwWithCallStack
EDIT: no need for special auxiliary functions, one can simply throw the unwrapped SomeExceptionWithCallStack value, as below:
foo `catch` \RecoverableException -> recover `catch` \e@UnrecoverableException -> throw e
So, in my head, I want to minimize the amount of changes to code necessary to take advantage of call stacks. Adding CallStacks to each of the exception types individually means that you have to modify each exception type to contain a CallStack (so, linear in the number of exception types.) Creating a new SomeExceptionWithCallStack means that we have to modify all occurrences of catch-rethrow to preserve call stacks (so, linear in the number of catch-rethrows in code everywhere.)
I admit that there is a tradeoff here, but the benefits of SomeExceptionWithCallStack don't make sense to me. I imagine there are a lot more catch-rethrows than there are exception types, and you will have to go through and fix each one of them. Admittedly, if you get a call stack that is missing info you need, it shouldn't be hard to track down (since the error will have the call stack of the bad rethrow attached :) Perhaps I am not seeing some other hidden costs?
Sounds like you are comparing the costs of 1) adding CallStacks to individual exception types vs 2) fixing call-rethrow occurrences to use the ...WithCallStack variants. And concluding that the cost of 2) is higher, therefore SomeExceptionWithCallStack is a more expensive solution.
The benefit of SomeExceptionWithCallStack is that *all* exceptions carry call stacks. Library code could print call stacks on uncaught exception errors regardless of whether the exception type is an instance of ExceptionWithCallStack.
After thinking a bit more about it, I've realised why the SomeExceptionWithCallStack approach doesn't work well with the per-Exception type CallStacks: we end up with two CalltStacks stored in the same exception. Now I understand why C# and F# have a special keyword for rethrow ....
@ezyang are you sure that there are that many explicit catch-rethrows in Haskell code? We certainly have tools (e.g. catches and catchJust) to avoid having to explicitly rethrow exceptions. And it would be much less work to add the CallStack to SomeException and update Control.ExceptionifcatchJust and co are actually used.
Seems like something we could investigate on Hackage before making a decision :)
I know that catchIO and then throwIO if the IOError does not match a predicate is a common idiom. It's somewhat difficult to regex for them but if you grep for throwIO with a reference to a variable, there are tons and tons of them. Here are three random ones I picked out:
-- system-fileioremoveTree root = do items <- listDirectory root forM_ items $ \item -> Exc.catch (removeFile item) (\exc -> do isDir <- isRealDir item if isDir then removeTree item else Exc.throwIO (exc :: IOError))-- HsSVN do err <- wrapSvnError =<< _fs_commit_txn conflictPathPtrPtr reposPtr newRevPtr txnPtr poolPtr case err of Nothing -> liftM (Right . fromIntegral) (peek newRevPtr) Just e -> if svnErrCode e == FsConflict then return . Left =<< peekCString =<< peek conflictPathPtrPtr else throwIO e-- DPM (Darcs.Lock.withLock fname (writeIORef ref True >> io)) `catch` (\ (e::SomeException) -> do b <- readIORef ref if b then throwIO e else failIO ("Could not obtain lock " ++ show fname ++ ", aborting."))
I just grepped for throwIO and picked out three random examples that looked like they were rethrowing.
Thanks for the pointer bgamari. It looks like your proposal is essentially the same initially specified in this ticket.
Your wiki page does comment that call stacks are preserved if you rethrow SomeException. But this often doesn't happen in practice. For example, the system-fileio example above rethrows an IOError: oops, call stack lost.