- Create a new project called working-with-STM with the simple stack template:
stack new working-with-STM simple
- 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
- 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
- Define the account type which points to TVar Int, which represents the current balance:
newtype Account = Account (TVar Int)
- 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'
- Initialize the bank account with any amount:
openAccount :: Int -> STM Account openAccount i = do balance <- newTVar i return (Account balance)
- Write a function to print the balance:
printBalance :: Account -> IO () printBalance (Account ac) = do balance <- atomically (readTVar ac) putStrLn $ "Current balance : " ++ show balance
- 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
- Build and execute the project:
stack build stack exec -- working-with-STM
- You should see the following output:
