-- Implementation of MVar's using STM.
module MutVar where

import qualified Control.Concurrent as CC
import qualified Control.Concurrent.STM as STM

type MutVar a = STM.TVar (Maybe a)

newEmptyMutVar :: STM.STM (MutVar a)
newEmptyMutVar = STM.newTVar Nothing

putMutVar :: MutVar a -> a -> STM.STM ()
putMutVar r x = do
  y <- STM.readTVar r
  case y of
    Nothing -> STM.writeTVar r (Just x)
    Just _  -> STM.retry

takeMutVar :: MutVar a -> STM.STM a
takeMutVar r = do
  y <- STM.readTVar r
  case y of
    Nothing -> STM.retry
    Just x  -> do
      STM.writeTVar r Nothing
      return x

readMutVar :: MutVar a -> STM.STM a
readMutVar r = do
  x <- takeMutVar r
  putMutVar r x
  return x

tryTakeMutVar :: MutVar a -> STM.STM (Maybe a)
tryTakeMutVar r =
  do x <- takeMutVar r
     return (Just x)
  `STM.orElse`
    return Nothing

test :: IO ()
test = do
  r <- STM.atomically newEmptyMutVar
  CC.forkIO $ child r
  rest r
  

child :: MutVar Int -> IO ()
child r = do
  putStrLn "starting child"
  CC.threadDelay 2000000 -- wait (at least) two seconds
  putStrLn "putting"
  STM.atomically $ putMutVar r 42
  putStrLn "concurrency!!"

rest :: MutVar Int -> IO ()
rest r = do  
  n <- STM.atomically $ takeMutVar r
  putStrLn $ "end: " ++ show n
{-
A few different outcomes:

*MutVar> test
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package stm-2.1.1.2 ... linking ... done.
cosntcarting child
urrency!!
putting
end: 42

*MutVar> test
concurrency!!
starting child
putting
end: 42

*MutVar> test
concurrsetnacryt!i!n
g child
putting
end: 42
-}