-- Simple example of message passing through TVar from base thread
-- to worker. Worker thread waits for messages on TVar and prints them out,
-- while base thread sends messages with 10ms delay.

module Main where

import System.Mem.Weak (addFinalizer)
import Control.Concurrent (ThreadId, forkIO, threadDelay, killThread)
import Control.Concurrent.STM (TVar, newTVarIO, readTVar, writeTVar, atomically, retry)
import Control.Monad (when, forever, forM_)

-- Data type for holding transaction variable and information about worker thread
data Socket = Socket ThreadId (TVar String)

-- "Open socket" means:
--   * create TVar for interaction between base and worker threads
--   * launch worker thread
--   * set finalizer on socket, that kills worker thread when the socket
--     is garbage collected

open :: IO Socket
open = do
  var <- newTVarIO ""
  threadId <- forkIO (loop var) -- launch worker thread
  let sock = Socket threadId var
  addFinalizer sock $ do
    putStrLn "finalizing"
    killThread threadId
  return sock
  where
    loop var = forever $ do
      x <- atomically $ extract var -- wait on TVar, read it
      putStrLn x -- then print it, then repeat
    extract var = do
      x <- readTVar var
      when (x == "") retry -- when no pending message, just wait
      writeTVar var ""
      return x

-- Send message. When there is already any message for delivery,
-- just wait and retry.

send :: Socket -> String -> IO ()
send sock@(Socket _ var) msg = do
  atomically $ do
    x <- readTVar var
    when (x /= "") retry
    writeTVar var msg

main :: IO ()
main = do
  socket <- open
  forM_ [1..1000000] $ \x -> do
    send socket (show x)
    threadDelay (10*1000)