content: module Main where
  
  import Control.Concurrent
  import qualified Control.Exception as E
  
  trapHandler :: MVar Int -> MVar () -> IO ()
  trapHandler inVar caughtVar =
    (do E.mask_ $ do
            trapMsg <- takeMVar inVar
            putStrLn ("Handler got: " ++ show trapMsg)
        trapHandler inVar caughtVar
    )
    `E.catch`
    (trapExc inVar caughtVar)
  
  trapExc :: MVar Int -> MVar () -> E.SomeException -> IO ()
  -- If we have been killed then we are done
  trapExc inVar caughtVar  e
    | Just E.ThreadKilled <- E.fromException e  = return ()
  -- Otherwise...
  trapExc inVar caughtVar e =
    do putStrLn ("Exception: " ++ show e)
       putMVar caughtVar ()
       trapHandler inVar caughtVar
  
  main :: IO ()
  main = do
    inVar <- newEmptyMVar
    caughtVar <- newEmptyMVar
    tid <- forkIO (trapHandler inVar caughtVar)
    yield
    putMVar inVar 1
    threadDelay 1000
    throwTo tid (E.ErrorCall "1st")
    takeMVar caughtVar
    putMVar inVar 2
    threadDelay 1000
    throwTo tid (E.ErrorCall "2nd")
          -- the second time around, exceptions will be blocked, because
          -- the trapHandler is effectively "still in the handler" from the
          -- first exception.  I'm not sure if this is by design or by
          -- accident.  Anyway, the trapHandler will at some point block
          -- in takeMVar, and thereby become interruptible, at which point
          -- it will receive the second exception.
    takeMVar caughtVar
    -- Running the GHCi way complains that tid is blocked indefinitely if
    -- it still exists, so kill it.
    killThread tid
    putStrLn "All done"
  