[Haskell-cafe] Mixing IO and STM

[Brian Sniffen]

Here's a version that provides clean output with no delays.  It uses a
single-entry mailbox (the TMVar "output") to ensure the processing
doesn't run too far ahead of the log.

module Test where

import System.Random
import Control.Concurrent
import Control.Concurrent.STM

test :: IO ()
test =
  do
    tv <- atomically (newTVar 0)
    output <- atomically (newTMVar "Log begins")
    forkIO (writer output)
    forkIO (producer tv output)
    consumer tv output

write :: TMVar String -> String -> STM ()
write output message = putTMVar output message

producer tv o =
              do r <- randomRIO (1,10)
                 atomically $ do v <- readTVar tv
                                 writeTVar tv (v+r)
                                 write o ("insert " ++ show r)
                 producer tv o
                 return ()

consumer tv o =
              do r <- randomRIO (1,10)
                 atomically $ do v <- readTVar tv
                                 if (v < r)
                                  then retry
                                  else writeTVar tv (v-r)
                                 write o ("consume " ++ show r)
                 consumer tv o
                 return ()

writer :: TMVar String -> IO ()
writer o =
    do msg <- atomically $ takeTMVar o
       putStrLn msg
       writer o