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
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
data Message a = Shutdown | Payload a
fuzzDelay = False
fuzz :: IO ()
fuzz = if fuzzDelay
then do
seconds <- (getStdRandom random :: IO Double)
threadDelay $ round (realToFrac (1000000 * seconds))
else return ()
-- 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