Skip to content

Instantly share code, notes, and snippets.

@mitsuji
Last active August 29, 2015 14:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mitsuji/2d7ee022b2177f4e3918 to your computer and use it in GitHub Desktop.
Save mitsuji/2d7ee022b2177f4e3918 to your computer and use it in GitHub Desktop.
broadcast by STM
import Control.Concurrent(forkIO,threadDelay)
import qualified Control.Concurrent.STM.TChan as TChan
import qualified Control.Monad.STM as STM
main = do
rp <- TChan.newTChanIO
bc <- TChan.newBroadcastTChanIO
forkIO $ broadcast bc
forkIO $ receive 0 rp bc
forkIO $ receive 1 rp bc
forkIO $ receive 2 rp bc
forkIO $ receive 3 rp bc
forkIO $ receive 4 rp bc
forkIO $ receive 5 rp bc
forkIO $ receive 6 rp bc
forkIO $ receive 7 rp bc
forkIO $ receive 8 rp bc
forkIO $ receive 9 rp bc
report rp
broadcast :: TChan.TChan Int -> IO()
broadcast c = loop 0
where
loop n = do
STM.atomically $ TChan.writeTChan c n
threadDelay 10000
loop $ n+1
receive :: Int -> TChan.TChan String -> TChan.TChan Int -> IO()
receive id rp bc = do
dc <- STM.atomically $ TChan.dupTChan bc
loop dc
where
loop dc = do
n <- STM.atomically $ TChan.readTChan dc
STM.atomically $ TChan.writeTChan rp $ "receive:" ++ (show id) ++ ":" ++ (show n)
loop dc
report :: TChan.TChan String -> IO()
report c = loop
where
loop = do
msg <- STM.atomically $ TChan.readTChan c
putStrLn msg
loop
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment