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