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