try6.hs

import Control.Monad
import System.Random

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TMQueue
import Data.Monoid ((<>))

fuzzDelay = True

fuzz :: IO ()
fuzz = when fuzzDelay $ do
         seconds <- getStdRandom random :: IO Double
         threadDelay $ round (realToFrac (1000000 * seconds))

printManager :: TMQueue [String] -> IO ()
printManager inputs = loop
  where
    loop = do
        mbThingToShow <- atomically (readTMQueue inputs)
        fuzz
        case mbThingToShow of
            Nothing -> pure ()
            Just thing -> do
                mapM_ putStrLn thing
                fuzz
                loop

counterManager :: TMQueue [String] -> TMQueue Int -> IO ()
counterManager printQueue inputs = loop 0
  where
    loop !i = do -- requires BangPatterns language extension
        mint <- atomically (readTMQueue inputs)
        case mint of
             Nothing -> pure ()
             Just int -> do
                 fuzz
                 let newCount = int + i
                 fuzz
                 atomically (writeTMQueue printQueue ["The count is now " <> show newCount, "---------------"])
                 fuzz
                 loop newCount

main :: IO ()
main = do
  printQueue <- atomically newTMQueue
  counterQueue <- atomically newTMQueue
  forkIO $ counterManager printQueue counterQueue
  forkIO $ printManager printQueue
  fuzz
  atomically $ writeTMQueue printQueue ["Starting up"]
  fuzz
  replicateM_ 10 $ do
         atomically $ writeTMQueue counterQueue 1
         fuzz
  atomically $ writeTMQueue printQueue ["Finishing up"]