-----------------------------------------------------------------------------
--
-- Module      :  Control.Concurrent.Util
-- Copyright   :  (c) 2016-17 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | Utilities related to concurrency.
--
-----------------------------------------------------------------------------


module Control.Concurrent.Util (
-- * Miscellaneous
  makeCounter
) where


import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar (newTVarIO, readTVar, writeTVar)


-- | Make a counter.
makeCounter :: (a -> a)  -- ^ How to increment the counter.
            -> a         -- ^ The initial value of the counter.
            -> IO (IO a) -- ^ Action for creating the action to increment the counter.
makeCounter f i =
  do
    counter <- newTVarIO i
    let
      next =
        atomically
          $ do
            j <- f <$> readTVar counter
            writeTVar counter j
            return j
    return next