How it works...

  1. Create a new project called working-with-STM with the simple stack template:
        stack new working-with-STM simple
  1. Add the ghc-options subsection to the executable section. Set the option to -threaded. Also add stm to the build-depends subsection:
        executable working-with-STM
          hs-source-dirs:      src
          main-is:             Main.hs
          ghc-options:         -threaded
          default-language:    Haskell2010
          build-depends:       base >= 4.7 && < 5
                             , stm
  1. Open src/Main.hs. We will be adding our source here. Import Control.Concurrent.STM to importing STM module:
        module Main where

        import Control.Concurrent.STM
        import Control.Concurrent
  1. Define the account type which points to TVar Int, which represents the current balance:
        newtype Account = Account (TVar Int)
  1. Define a transact function where the balance in the account can be modified. The transaction is not permitted if the balance would become less than zero. In such a case, the transaction is retried:
        transact :: Int -> Account -> STM Int
        transact x (Account ac) = do
          balance <- readTVar ac
          let balance' = balance + x
          case balance' < 0 of
            True -> retry
            False -> writeTVar ac balance'
          return balance'
  1. Initialize the bank account with any amount:
        openAccount :: Int -> STM Account
        openAccount i = do
          balance <- newTVar i
          return (Account balance)
  1. Write a function to print the balance:
        printBalance :: Account -> IO ()
        printBalance (Account ac) = do
          balance <- atomically (readTVar ac)
          putStrLn $ "Current balance : " ++ show balance
  1. Do the bank transaction in the main function. Open an account with initial balance 100. Let's then try to debit 200 from a thread. Since we do not have that much balance, this should wait until there is a sufficient balance. From another thread, we do two credits of 75 each. After the sufficient balance has been made available, the debit should be allowed:
        main :: IO ()
        main = do
          ac <- atomically $ openAccount 100
          printBalance ac
          forkIO $ do
            balance <- atomically $ transact (-200) ac
            putStrLn $ "Balance after debit : " ++ show balance

          forkIO $ do
            balance1 <- atomically $ transact 75 ac
            putStrLn $ "Balance after credit of 75 : " ++ show balance1
            balance2 <- atomically $ transact 75 ac
            putStrLn $ "Balance after credit of 75 : " ++ show balance2

          threadDelay (1000*1000) -- Wait for above actins to finish
          printBalance ac 
  1. Build and execute the project:
        stack build
        stack exec -- working-with-STM
  1. You should see the following output: