[Haskell-cafe] Cleaning up threads

[Mitar]

Hi!

I run multiple threads where I would like that exception from any of
them (and main) propagate to others but at the same time that they can
gracefully cleanup after themselves (even if this means not exiting).
I have this code to try, but cleanup functions (stop) are interrupted.
How can I improve this code so that this not happen?

module Test where

import Control.Concurrent
import Control.Exception
import Control.Monad

thread :: String -> IO ThreadId
thread name = do
  mainThread <- myThreadId
  forkIO $ handle (throwTo mainThread :: SomeException -> IO ()) $ --
I want that possible exception in start, stop or run is propagated to
the main thread so that all other threads are cleaned up
    bracket_ start stop run
      where start = putStrLn $ name ++ " started"
            stop  = forever $ putStrLn $ name ++ " stopped" -- I want
that all threads have as much time as they need to cleanup after
themselves (closing (IO) resources and similar), even if this means
not dying
            run   = forever $ threadDelay $ 10 * 1000 * 1000

run :: IO ()
run = do
  threadDelay $ 1000 * 1000
  fail "exit"

main :: IO ()
main = do
  bracket (thread "foo") killThread $
    \_ -> bracket (thread "bar") killThread $
      \_ -> bracket (thread "baz") killThread (\_ -> run)


Mitar