Skip to content

Instantly share code, notes, and snippets.

@joelmccracken

joelmccracken/Main.hs

Last active August 14, 2025 18:25
Show Gist options
  • Save joelmccracken/3e58633af2ec622aa0c850895a7a6ed3 to your computer and use it in GitHub Desktop.
Save joelmccracken/3e58633af2ec622aa0c850895a7a6ed3 to your computer and use it in GitHub Desktop.
Download ZIP
ping-pong example
Raw
Main.hs
-- uses stm, async
import Control.Concurrent.STM.TChan (newTChan, readTChan, writeTChan)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.Async (async, wait)
import Control.Monad (forever, void)
import Prelude
main :: IO ()
main = do
pingerC <- atomically $ newTChan
pongerC <- atomically $ newTChan
pingPongC <- atomically $ newTChan
pinger <- async $ forever $ do
void $ atomically $ do
void $ readTChan pingerC
writeTChan pingPongC "ping!"
writeTChan pongerC ()
ponger <- async $ forever $ do
void $ atomically $ do
readTChan pongerC
writeTChan pingPongC "pong?"
writeTChan pingerC ()
pingponger <- async $ forever $ do
msg <- atomically $ readTChan pingPongC
putStrLn $ "read from channel: " <> msg
atomically $ writeTChan pingerC ()
void $ wait pinger
void $ wait ponger
void $ wait pingponger
@joelmccracken
Copy link
Author

results:

joelmccracken@glamdring> stack run ping-pong | head
read from channel: ping!
read from channel: pong?
read from channel: ping!
read from channel: pong?
read from channel: ping!
read from channel: pong?
read from channel: ping!
read from channel: pong?
read from channel: ping!
read from channel: pong?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment