-- 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 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 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