multithreadinghaskelliostmio-monad

Stop threads from interleaving output


The following program creates two threads running concurrently, that each sleep for a random amount of time, before printing a line of text to stdout.

import Control.Concurrent
import Control.Monad
import System.Random

randomDelay t = randomRIO (0, t) >>= threadDelay

printer str = forkIO . forever $ do
  randomDelay 1000000 -- μs
  putStrLn str

main = do
  printer "Hello"
  printer "World"
  return ()

The output generally looks something like

>> main
Hello
World
World
Hello
WoHrelld
o
World
Hello
*Interrupted
>>

How do you ensure that only one thread can write to stdout at a time? This seems like the kind of thing that STM should be good at, but all STM transactions must have the type STM a for some a, and an action that prints to the screen has type IO a, and there doesn't seem to be a way to embed IO into STM.


Solution

  • The way to handle output with STM is to have an output queue that is shared between all threads and which is processed by a single thread.

    import Control.Concurrent
    import Control.Concurrent.STM
    import Control.Monad
    import System.Random
    
    randomDelay t = randomRIO (0, t) >>= threadDelay
    
    printer queue str = forkIO . forever $ do
      randomDelay 1000000 -- μs
      atomically $ writeTChan queue str
    
    prepareOutputQueue = do
        queue <- newTChanIO
        forkIO . forever $ atomically (readTChan queue) >>= putStrLn
        return queue
    
    main = do
      queue <- prepareOutputQueue
      printer queue "Hello"
      printer queue "World"
      return ()