Skip to content

Instantly share code, notes, and snippets.

@meteficha
Created Apr 15, 2013
Embed
What would you like to do?
Exceptions that should be caught... aren't
{-# LANGUAGE DeriveDataTypeable #-}
import Prelude hiding (catch)
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable
data PingPong = Ping ThreadId | Pong ThreadId deriving (Show, Typeable)
instance Exception PingPong
throwBack :: PingPong -> IO ()
throwBack (Ping tid) = myThreadId >>= throwTo tid . Pong
throwBack (Pong tid) = myThreadId >>= throwTo tid . Ping
sleeper :: IO ThreadId
sleeper =
mask_ $
forkIOWithUnmask $ \restore ->
forever $
restore sleep `catch` throwBack
sleep :: IO ()
sleep = threadDelay (10^(6::Int))
breaker :: ThreadId -> IO ThreadId
breaker tid = forkIO $ throwBack (Pong tid)
main :: IO ()
main = do
tid <- sleeper
replicateM_ 100 (breaker tid)
sleep
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment