[GHC] #12096: Attach stacktrace information to SomeException

[GHC]

#12096: Attach stacktrace information to SomeException
-------------------------------------+-------------------------------------
        Reporter:  ndtimofeev        |                Owner:
            Type:  feature request   |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Core Libraries    |              Version:  8.0.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by ndtimofeev):

 1. I just copy `ErrorCall` API and implementation. Also I would like to
 see both stacktrace (`CallStack` and `CostCentreStack`, not only
 `CallStack`).

 2. Yep, stacktrace information is lost when we catch unwraped exception.

 It looks like a problem. First:
 {{{#!hs
 f = throw (CustomException False)

 g = f `catch` \err@(CustomException fixable) ->
     if fixable
         then makeGood
         else throw err
 }}}
 We only rethrow exception and… change it stacktrace. Now it start from
 `throw` in `g`, not in `f`.

 Second:
 {{{#!hs
 onException eval handler = eval `catch` (\e@(SomeException _) -> handler
 >> throw e)

 f = throw (CustomException False)

 g = f `onException` makeGood
 }}}
 Now exception has to stacktrace.

 Third:
 {{{#!hs

 loop = forever $ threadDelay maxBound

 main = do
     tid <- forkIO $ loop `onException` putStrLn "Bang!"
     threadDelay 1000000
     throwTo tid UserException
 }}}
 Now `UserException` has absolutely irrelevant stacktrace.

 I don't know how fix first problem. The second can be fixed something like
 that:
 {{{#!hs
 throw :: (HasCallStack, Exception e) => e -> a
 throw e
     | Just (SomeException _) <- cast e = raise# e
     | otherwise                        = unsafeDupablePerformIO $ do
         stack <- currentCallStack
         raise# (CallStackException e $ if stack /= []
             then prettyCallStack ?callStack ++ "\n" ++ renderStack stack
             else prettyCallStack ?callStack)
 }}}
 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.
 {{{#!hs
 throwTo' :: Exception e => ThreadId -> e -> IO a
 throwTo' tid = throwTo tid . SomeAsyncException

 catch' :: Exception e => IO a -> (e -> IO a) -> IO a
 catch' eval handler = eval `catch` \err@(SomeException _) -> go err
 handler err
     where
         go :: (Exception e, Exception a) => e -> (a -> IO b) ->
 SomeException -> IO b
         go ex f origErr
             | Just v                          <- cast ex = f v
             | Just (SomeException inner)      <- cast ex = go inner f
 origErr
             | Just (SomeAsyncException inner) <- cast ex = go inner f
 origErr
             | otherwise                             = throw origErr
 }}}
 Also it will be useful in situation like that:
 {{{#!hs
 processCmd = timeout 20000 . postDataAndWaitResponce

 main = do
     tasks <- newChan :: IO (Chan (String, MVar (Either SomeEception (Maybe
 String))))
     tid   <- forkIO $ forever $ do
         (cmd, ret) <- readChan tasks
         try (processCmd cmd) >>= putMVar ret
     threadDelay 1000000
     throwTo tid UserException
 }}}
 `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.

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12096#comment:3>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler