Simple STM example

From HaskellWiki
Jump to navigation Jump to search
{-# OPTIONS_GHC -rtsopts -with-rtsopts=-N4 -threaded -Wall #-}
module Main where
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM

main :: IO ()
main = do shared <- newTVarIO (0 :: Int)
          before <- atomRead shared
          putStrLn ("Before: " ++ show before)
          repeatIO 25 (dispVar shared >> threadDelay 20_000)
          repeatIO 10 (appV (+ 2) shared >> threadDelay 50_000)
          repeatIO 20 (appV pred shared >> threadDelay 25_000)
          threadDelay 800_000
          after <- atomRead shared
          putStrLn ("After: " ++ show after)
  where
    repeatIO n = void . forkIO . replicateM_ n
    atomRead = readTVarIO
    dispVar x = atomRead x >>= print
    appV fn x = atomically (modifyTVar x fn)