atomic counter with potential for reduced persistence

counter.hs

module Main where

import Control.Monad
import Control.Monad.STM
import Control.Concurrent
import Control.Concurrent.STM

oneSecond = 1000000

writerThread :: TChan Int -> IO ()
writerThread chan = do
  atomically $ writeTChan chan 1
  threadDelay oneSecond
  atomically $ writeTChan chan 2
  threadDelay oneSecond
  atomically $ writeTChan chan 3
  threadDelay oneSecond
    
readerThread :: TChan Int -> IO ()
readerThread chan = do
  newInt <- atomically $ readTChan chan
  mt <- atomically $ isEmptyTChan chan
  putStrLn $ "read new value: " ++ show newInt
  when mt (putStrLn "(now empty)")
  readerThread chan

-- this demonstrates how to read an use an atomic counter and then write
-- to the db. the "when mt" part above is when i would write to the db, you
-- can ignore the previous vals since you would just write over them anyway

main = do
  chan <- atomically $ newTChan
  forkIO $ readerThread chan
  -- forkIO $ writerThread chan
  c <- atomically $ newTVar (1 :: Int)
  v1 <- atomically $ do
    t <- readTVar c
    writeTVar c (t+1)
    writeTChan chan t
    return t
  putStrLn $ "new val: " ++ show v1
  v2 <- atomically $ do
    t <- readTVar c
    writeTVar c (t+1)
    writeTChan chan t
    writeTChan chan 8
    return t
  putStrLn $ "new val: " ++ show v2
  threadDelay $ 4 * oneSecond
  v3 <- atomically $ do
    t <- readTVar c
    writeTVar c (t+1)
    writeTChan chan t
    writeTChan chan 8
    return t
  putStrLn $ "new val: " ++ show v3