Skip to content
try5.hs 1.95 KiB
Newer Older
Yuanle Song's avatar
Yuanle Song committed
-- use default Chan, use shutdown msg to terminate program.
-- let master thread wait for all created threads to finish.

import Control.Monad
import Control.Concurrent.MVar
import Control.Concurrent
import Text.Printf
import System.Random
Yuanle Song's avatar
Yuanle Song committed

import WorkGroup

data Message a = Shutdown | Payload a

fuzzDelay = False

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

-- handleShutdown :: Message a -> (a -> IO ()) -> IO ()
-- handleShutdown Shutdown _ = return ()
-- handleShutdown (Payload x) f = f x

counterManager :: MVar Integer -> Chan (Message Integer) -> Chan (Message [String]) -> IO ()
counterManager counter counterCh printerCh = do
  fuzz
  msg <- readChan counterCh
  case msg of
    Shutdown -> return ()
    Payload incrementBy -> do
             fuzz
             newCount <- modifyMVar counter (\i -> return (i + incrementBy, i + incrementBy))
             fuzz
             writeChan printerCh $ Payload [printf "The count is %d" newCount,
                                                   "---------------"]
             fuzz
             counterManager counter counterCh printerCh

printerManager :: Chan (Message [String]) -> IO ()
printerManager ch = do
  fuzz
  msg <- readChan ch
  case msg of
    Shutdown -> return ()
    Payload rows -> do
             fuzz
             mapM_ putStrLn rows
             fuzz
             printerManager ch
Yuanle Song's avatar
Yuanle Song committed

main :: IO ()
main = do
  counter <- newMVar 0
  counterCh <- newChan
  printerCh <- newChan
  counterWg <- newWorkGroup
  forkIOwg counterWg $ counterManager counter counterCh printerCh
  printerWg <- newWorkGroup
  forkIOwg printerWg $ printerManager printerCh
  writeChan printerCh $ Payload ["Starting up"]
  replicateM_ 10 (writeChan counterCh $ Payload 1)
  writeChan counterCh Shutdown
  joinWorkGroup counterWg
  writeChan printerCh $ Payload ["Finishing up"]
  writeChan printerCh Shutdown
  joinWorkGroup printerWg