So you're saying that it's expected behavior for the shim library you're providing to have drastically different behavior between different versions of GHC? I don't think that's a good idea at all.
In any event, this approach is still predicated on the idea that you can identify an asynchronous event from its type. There are multiple problems with this:
* As demonstrated with my previous example, not all asynchronous exceptions identify themselves as such.
* There is no requirement that only asynchronous-type exceptions be thrown asynchronously. throwTo works with any instance of Exception.
* If an asynchronous-type exception is caught and then rethrown as a synchronous exception, the type-based approach will still treat it as asynchronous, though it should be recognized as synchronous at that point.
To demonstrate that last point, consider the example code below, which uses your asynchronous type machinery and the async package. The usage of `trySync` in `main` *should* catch that exception, since it is no longer asynchronous, but a type-only approach cannot handle that situation. ClassyPrelude's tryAny, on the other hand, gives the correct output.
{-# LANGUAGE DeriveDataTypeable #-}
import Control.Exception.Async
import Control.Concurrent.Async
import Control.Concurrent
import Control.Exception
import Data.Unique
import Data.Typeable
data Timeout = Timeout
deriving (Typeable, Eq)
instance Show Timeout where
show _ = "Async Timeout"
instance Exception Timeout where
fromException = asyncExceptionFromException
toException = asyncExceptionToException
asyncTimeout n f = do
pid <- myThreadId
killer <- forkIO $ do
threadDelay n
throwTo pid Timeout
res <- f
killThread pid
return res
main :: IO ()
main = do
res <- trySync f
print res
f :: IO String
f = do
x <- async $ asyncTimeout 1000000 $ do
threadDelay 2000000
return "Finished"
wait x