practice: STM

countUp.hs

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

countUp :: Int -> IO ()
countUp num = do
  counter <- atomically $ newTVar 0
  sequence_ $ replicate num $ forkIO $ worker counter
  putStrLn "start..."
  printWorkerOutput counter

worker :: TVar Int -> IO ()
worker counter = do
  randomDelay 5
  atomically $ readTVar counter >>= return . (+1) >>= writeTVar counter

randomDelay :: Int -> IO ()
randomDelay max = (getStdRandom $ randomR (1, max)) >>= sleep

sleep :: Int -> IO ()
sleep sec = threadDelay $ sec * 1000000

-- 1 秒間隔で表示を続ける
printWorkerOutput :: TVar Int -> IO ()
printWorkerOutput counter = do
  sleep 1
  (atomically $ readTVar counter) >>= putStrLn . show
  printWorkerOutput counter