Search code examples
asynchronoushaskellconcurrencyfunctional-programming

How can I "suppress" concurrent "forever-running" actions from main thread upon user input?


This program

{-# LANGUAGE LambdaCase #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
import Control.Exception (finally)
import Control.Monad (forever)

main :: IO ()
main = do
  let as = [(forever $ wait1sec >> putStrLn "hello 0") `finally` putStrLn "bye 0",
            (forever $ wait1sec >> putStrLn "hello 1") `finally` putStrLn "bye 1",
            (forever $ wait1sec >> putStrLn "hello 2") `finally` putStrLn "bye 2"]
  foldr (\a b -> withAsync a (const b))
        (forever $ do wait1sec >> putStrLn "hellooo")
        as
  where
    wait1sec = threadDelay 1000000

prints every second a random permutation of these 4 lines

hello 0
hello 1
hello 2
hellooo

and, when the program terminates (the only way is killing it, obviously), it also prints

bye 2
bye 1
bye 0

(I'm always seeing the output in this order, I presume because that's the order in which the entries of the list are destroyed?)

Now, suppose that I want the main thread of the program (the one printing hellooo) to get input from the keyboard and, based on that, "kill" one of the entries in as (which would cause it's bye to be printed). How would I go about that?


I suppose there's no way to achieve that as long as as is immutable, so probably a first step is to create an IORef to it. This would certainly give me a way to alter the list from inside the main thread, like this

-- assuming asr is an IORef [IO Any]
        (forever $ do wait1sec >> putStrLn "gimme a number"
                      getChar >>= \case
                                    '0' -> atomicModifyIORef' asr (\a -> (tail a, ()))
                                    '1' -> atomicModifyIORef' asr (\a -> ([head a, last a], ()))
                                    '2' -> atomicModifyIORef' asr (\a -> (init a, ()))
                                    _ -> return ())

but that would have fundamentally no effect, because foldr has already spawned the 3 concurrent actions (I still have to pass to it the list, so as, not asr), which will not care about what happens to asr, right?

I start thinking that unless I put some mechanism in place so that forever does not really mean "forever", I have no chance.


Well, yeah, I was slowly remembering an older question of mine together with the accepted answer, so I've posted a self-answer. However, it would be nice to see what other approaches might be.

For instance, one thing in my self-answer which is not quite in line with what was initially spinning in my head, is that even after the actions have terminated, as is still there, with its 3 elements.

To give a bit of context, in my real usecase, I'm thinking of as as somehting that can grow or shrink over time; furthermore, when an entry is added to it, a file is serialized to disk which is associated to it; when an entry is deleted from it, the corresponding file should be deleted (which made me think finally is the way to handle the file deletion).


Solution

  • The preemptive way is to have an MVar [ThreadId]. New threads start by calling myThreadId+modifyMVar_; killers work by calling takeMVar+throwTo. The preemptive way lets you cut an action in the middle, and is more robust to buggy threads.

    The cooperative way coordinates thread liveness with an MVar Bool (or many such -- perhaps one per thread, for example). When threads reach a good checkpoint and are ready to be interrupted, they readMVar and continue if they see a True; killers work by calling modifyMVar_ to turn the contents to False.

    Both of these approaches can be embellished dramatically as various needs arise -- think of these merely as starting points. You can of course also mix and match -- e.g. by having a grace period after asking cooperatively for a thread to shut down before it gets forcibly pre-empted.