import Control.Concurrent     ( forkIO )
import Control.Concurrent.STM

type Account = TVar Int

-- Create new account as a TVar.
newAccount :: Int -> STM Account
newAccount am = newTVar am

-- Get the balance of the account.
getBalance :: Account -> STM Int
getBalance acc = readTVar acc

-- Deposit some money into the account.
deposit :: Account -> Int -> STM ()
deposit acc am = do
  bal <- readTVar acc
  writeTVar acc (bal + am)

-- Withdraw some money from the account if the balance is positive.
-- The return flag indicates whether the withdraw was possible.
withdraw :: Account -> Int -> STM Bool
withdraw acc am = do
  bal <- readTVar acc
  if bal >= am then do writeTVar acc (bal - am)
                       return True
               else return False

-- Transfer some money from one account to another.
-- The return flag indicates whether the transfer was successful.
transfer :: Account -> Account -> Int -> STM Bool
transfer from to am = do
  bal <- getBalance from
  if bal >= am then do withdraw from am
                       deposit to am
                       return True
               else return False

-- do some number of successful(!) transfers from one account to the other:
transferTest :: Int -> Account -> Account -> IO ()
transferTest 0 _  _  = return ()
transferTest n k1 k2 = do
  res <- atomically $ transfer k1 k2 1
  if res then transferTest (n-1) k1 k2
         else transferTest n k1 k2

-- Main program: perform concurrently transfers
main = do 
  k1 <- atomically (newAccount 100)
  k2 <- atomically (newAccount 100)
  forkIO (transferTest 1000 k1 k2)
  transferTest 1000 k2 k1
  getLine -- wait to finish the concurrent process
  bal1 <- atomically $ getBalance k1
  print bal1
  bal2 <- atomically $ getBalance k2
  print bal2

-- Usage:
-- > cabal install stm