Control.Concurrent.Async.race and runInteractiveProcess

Question

I'm using the race function from the async package, exported by Control.Concurrent.Async.

The subtasks I fire off using race themselves invoke runInteractiveProcess to run (non-Haskell) executables. The idea is to run different external programs and take the result of the first one to finish. In a sense, Haskell "orchestrates" a bunch of external programs.

What I'm observing is that while race works correctly by killing the Haskell level "slower" thread; the sub-processes spawned from the slow thread itself continue to run.

I suspect expecting race to kill processes spawned this way is a bit unrealistic, as they probably become zombies and get inherited by init. For my purposes however, keeping the external processes running defeats the whole purpose of using race in the first place.

Is there an alternative way of using race so the subprocesses created this way get killed as well? While I don't have a use case yet, it'd be best if the entire chain of processes created from the raced tasks get killed; as one can imagine those external programs themselves creating a bunch of processes as well.

Answer 1

As already mentioned in the comments, you could use a combination of onException and terminateProcess.

My process-streaming library (which contains helper functions built on top of process and pipes) already does this. Asynchronous exceptions trigger the termination of the external process.

For example, the following code does not create file toolate.txt.

import qualified Pipes.ByteString as B
import System.Process.Streaming
import Control.Concurrent.Async

main :: IO ()
main =
  do
    result <-  race (runProgram prog1) (runProgram prog2)
    putStrLn $ show $ result
  where
    -- collecting stdout and stderr as bytestrings
    runProgram = simpleSafeExecute $ pipeoe $ 
                       separated (surely B.toLazyM) (surely B.toLazyM)
    prog1 = shell "{ echo aaa ; sleep 2 ; }"
    prog2 = shell "{ echo bbb ; sleep 7 ; touch toolate.txt ; }"

The result is:

Left (Right ("aaa\n",""))