{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}

module Test where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Typeable
import System.IO

data MyTerminateException = MyTerminateException deriving (Show, Typeable)

instance Exception MyTerminateException

doSomething :: IO ()
doSomething = threadDelay $ 1000 * 1000 * 1000

createNewThread :: IO (ThreadId, MVar ())
createNewThread = do
  terminated <- newEmptyMVar
  let run = doSomething `catches` [
                Handler (\(_ :: MyTerminateException) -> return ()), -- we ignore MyTerminateException
                Handler (\(e :: SomeException) -> putStrLn $ "Exception: " ++ show e) -- we handle other exceptions, printing them for example
              ] `finally` (putMVar terminated ()) -- add ">> throwIO ThreadKilled" to fix the problem
  -- TODO: There is a race condition before finally puts in place putMVar, fix in GHC 7.0
  nid <- forkIO run
  return (nid, terminated)

main :: IO ()
main = do
  (nid, terminated) <- createNewThread
  threadDelay $ 1000 * 1000
  
  replicateM_ 100 (throwTo nid MyTerminateException)
  
  takeMVar terminated
  putStrLn "MVar was successfully taken"