[Haskell-cafe] Guidance on using asynchronous exceptions
hehx0sk02 at sneakemail.com
Fri Nov 16 01:06:34 EST 2007
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
(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.)
Advanced Exception Handling Mechanisms
module Main where
import Prelude hiding (log)
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
threadDelay (n * 1000000) -- TODO allow interrupts only at this point
-- 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
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"
-- 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"
More information about the Haskell-Cafe