To follow up on my previous post ("Asynchronous Exceptions and the RealWorld"), I've decided to put together something more concrete in the hopes of eliciting response. I'm trying to write a library of higher-level concurrency abstractions, in particular for asynchronous systems programming. The principal goal here is composability and safety. Ideally, one can apply combinators on any existing (IO a), not just procedures written for this library. But that seems like a pipe dream at this point. In the code below, the running theme is process orchestration. (I've put TODOs at places where I'm blocked - no pun intended.) I'm currently worried that what I'm trying to do is simply impossible in Concurrent Haskell. I'm bewildered by the design decisions in the asynchronous exceptions paper. I'm also wondering if there are any efforts under way to reform this situation. I found some relevant posts below hinting at this, but I'm not sure what the status is today. (Something like this is straightforward to build if I abandon Concurrent Haskell and use cooperative threading, and if the operations I wanted to perform could be done asynchronously.) Relevant papers --------------- http://citeseer.ist.psu.edu/415348.html http://research.microsoft.com/users/simonpj/papers/concurrent-haskell.ps.gz http://www.haskell.org/~simonmar/papers/web-server.ps.gz Relevant posts/threads ---------------------- http://osdir.com/ml/lang.haskell.prime/2006-04/msg00032.html http://osdir.com/ml/lang.haskell.general/2001-11/msg00131.html http://www.haskell.org/pipermail/haskell-prime/2006-April/001280.html http://www.haskell.org/pipermail/haskell-prime/2006-April/001290.html http://www.nabble.com/throwTo---block-statements-considered-harmful-tf278026... http://www.nabble.com/What-guarantees-(if-any)-do-interruptible-operations-h... Misc ---- http://lambda-the-ultimate.org/node/1570 Advanced Exception Handling Mechanisms http://www.springerlink.com/content/3723wg2t81248027/ http://64.233.169.104/search?q=cache:c4pS0FDKMXcJ:www.cs.ioc.ee/tfp-icfp-gpce05/tfp-proc/06num.pdf+concurrency+interrupts+abort+safe+asynchronous+exceptions+threads&h http://64.233.169.104/search?q=cache:hmC-jl-iNkoJ:www.jot.fm/issues/issue_2007_11/article4.pdf+concurrency+interrupts+abort+safe+asynchronous+exceptions+threads&hl=en http://www.mathematik.uni-marburg.de/~eden/paper/edenEuropar03.pdf Code ==== module Main where import Control.Concurrent import Control.Concurrent.MVar import Control.Exception import Control.Monad import Prelude hiding (log) import System.IO import System.Posix.Signals import System.Process log = putStrLn startProc cmd = runCommand cmd stopProc p = terminateProcess p waitProc p = waitForProcess p -- Run a process, blocking on it until it exits. If we're interrupted, -- terminate the process. (IIRC, terminateProcess issues SIGTERM, and -- the documentation is buggy; more detailed code should go here later -- to retry with SIGKILL.) runProc cmd = do log "launching proc" p <- startProc cmd waitProc p -- TODO allow interrupts only at this point `finally` ( log "stopping" >> stopProc p >> log "stopped" ) -- Sleep for n seconds. timeout n = do log "sleeping" threadDelay (n * 1000000) -- TODO allow interrupts only at this point log "waking" -- TODO is there any way to block *only* the Cancel exception? (Even -- if this could be done, though, it's still not a modular approach.) spawn :: IO a -> (a -> IO ()) -> IO ThreadId spawn f y = forkIO (block (f >>= y)) -- The any/sum/choice combinator. On return, guarantee that both tasks -- have stopped. (<|>) :: IO a -> IO b -> IO (Either a b) a <|> b = do result <- newEmptyMVar :: IO (MVar (Either a b)) tida <- newEmptyMVar :: IO (MVar ThreadId) tidb <- newEmptyMVar :: IO (MVar ThreadId) let yield lr x = do let name = case lr x of Left _ -> "a" Right _ -> "b" log $ "saving result of " ++ name putMVar result (lr x) log $ "saved result of " ++ name let other = case lr x of Left _ -> tidb Right _ -> tida log "taking other" t <- takeMVar other log "killing other" -- Later: replace the following with a throwTo -- so as to notify (rather than kill) the thread -- with a Cancel killThread t ta <- spawn a (yield Left) tb <- spawn b (yield Right) putMVar tida ta putMVar tidb tb log "waiting for result" res <- takeMVar result -- TODO wait for both tasks to have stopped log "returning result" return res -- simple test -- cmd1 = "for i in `seq 1`; do sleep 1; echo hello; done" cmd2 = "for i in `seq 3`; do sleep 1; echo world; done" main = do -- TODO for some reason, cmd2 doesn't get terminated. result <- runProc cmd1 <|> runProc cmd2 case result of Left _ -> putStrLn "finished process" Right _ -> putStrLn "got exception"