-- Courtesy of @liyang
{-# LANGUAGE ForeignFunctionInterface #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async.Lifted -- works without Lifted
import Control.Exception.Lifted
import Control.Monad.Reader
import Foreign.C.Types
import System.IO
foreign import ccall safe "sleep" c_sleep :: CInt -> IO CInt
delay :: Int -> IO ()
delay = threadDelay . (*) 1000
main :: IO ()
main = do
a <- async $ do
-- withAsync cancels zombie after the inner "delay 5000"
withAsync zombie (\ _ -> delay 5000) `finally` do
putStrLn "finally"
delay 1000
delay 100
putStrLn "cancelling"
cancel a -- throwTo the inner "delay 15000" a ThreadKilled;
-- withAsync then @throwTo zombie ThreadKilled@, which is
-- synchronous and does not return until it is delivered.
putStrLn "cancelled"
print =<< waitCatch a
threadDelay 1000
zombie :: IO ()
zombie = forever $ do
c_sleep 2 -- exception not deliverable here
ms <- getMaskingState
putStrLn $ "not dead " ++ show ms -- not here either, apparently
-- allowInterrupt -- can be delivered, even in
The following snippet fails to finish.