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)