https://youtu.be/2lll2VbX8Vc

STM.hs

-- Compile with -threaded

import System.IO
import Control.Concurrent
import Control.Concurrent.STM

-- (<Sum>, <Number of finished transactions>)
type Result = TVar (Int, Int)

-- Adds x to result and increments the number of finished transactions
addToResult :: Result -> Int -> STM ()
addToResult result x = do
  (sum, endCtr) <- readTVar result
  writeTVar result (sum+x, endCtr+1)

-- Waits for the number of finished transactions to reach a limit
-- Then returns the sum of the result
waitForCounter :: Result -> Int -> STM Int
waitForCounter result limit = do
  (sum, endCtr) <- readTVar result
  if endCtr < limit then retry else return sum

main :: IO ()
main = do
  -- Number of threads to spawn
  let n = 100
  -- Set up TVar
  result <- atomically $ newTVar (0, 0)
  -- Spawn threads
  mapM_ (\x -> forkIO $ atomically $ addToResult result x) [1..n] 
  -- Wait for threads to finish and get sum
  sum <- atomically $ waitForCounter result n
  -- Print sum
  putStrLn $ "Sum [1..n] = " ++ show sum