Do not discard exception context

[guibou]

GHc 9.12 introduced rethrowIO as well as catchNoPropagate and tryWithContext. The interesting part of rethrowIO is that:

• It does not introduces a new stack trace as exception annotation
• It does not clean the previous stack trace and exception annotations.

For example, the following code:

{-# LANGUAGE DeriveAnyClass #-}
import Control.Concurrent.Async
import Control.Exception
import Control.Exception.Context
import Control.Exception.Annotation
import Data.Typeable
import Data.Traversable
import GHC.Stack

data Ann = Ann String
  deriving (Show, ExceptionAnnotation)

asyncTask :: HasCallStack => IO ()
asyncTask = annotateIO (Ann "bonjour") $ do
  error "yoto"

asyncTask' :: HasCallStack => IO ()
asyncTask' = annotateIO (Ann "bonjour2") $ do
  error "yutu"

main = do
  -- withAsync asyncTask wait
  concurrently asyncTask asyncTask'
  -- race asyncTask asyncTask'

Results in the following non informative output:

ASyncException.hs: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:

yoto

HasCallStack backtrace:
  throwIO, called at ./Control/Concurrent/Async/Internal.hs:630:24 in async-2.2.5-50rpfAJ7BEc1o5OswtTMUN:Control.Concurrent.Async.Internal

Especially:

• The backtrace points to the internal of async, completly losing the "real" and relevant backtrace
• The exception annoattion is lost

If run without the async "wrapping", we get instead:

ASyncException.hs: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:

yoto

Ann "bonjour"
HasCallStack backtrace:
  error, called at ASyncException.hs:15:3 in main:Main
  asyncTask, called at ASyncException.hs:24:3 in main:Main

With annotation and backtrace.

This could be fixed by using rethrowIO instead of throw everywhere an exception is rethrown in async. See the attached MR which can be used as a proof of concept. A bit of discussion may be necessary to know if we want to add a WhileHandling context before rethrowing.