gistfile1.hs

module Main where

import Control.Distributed.STM.DSTM
import System.Environment (getArgs)

main = startDist goTasks

goTasks = do
  (arg:_) <- getArgs
  let n = read arg
  case n of
      1 -> goHost
      2 -> goClient

goHost = do
  q <- atomic $ newTVar []
  registerTVar gDefaultNameServer q "queue"
  hostLoop q 0

hostLoop :: TVar [Integer] -> Integer -> IO ()
hostLoop q base = do
  (_, now) <- atomic $ modifyTVar q (++ enumFromTo base (base+9))
  putStrLn $ "filling queue: " ++ show now
  getLine
  hostLoop q (base + 10)

goClient = do
  putStrLn "client"
  Just q <- lookupTVar gDefaultNameServer "queue"
  clientLoop q

clientLoop q = do
  (old, new) <- atomic $ takeJob q
  putStrLn $ "changing " ++ show old ++ " to " ++ show new
  clientLoop q

takeJob :: TVar [Integer] -> STM ([Integer], [Integer])
takeJob q = do
  theQueue <- readTVar q
  if null theQueue
    then retry
    else modifyTVar q (tail)

modifyTVar :: Dist a => TVar a -> (a -> a) -> STM (a, a)
modifyTVar var f = do
  old <- readTVar var
  let new = f old
  writeTVar var new
  return (old, new)