-- | The Counter module implements a thread-safe integer counter. It
-- can be used to generate unique ids in a multi-threaded system.
module Control.Concurrent.STM.Counter (Counter, getCounter, incr, get, getAndIncr) where

import Data.IORef

import System.IO.Unsafe

-- | The counter is implemented as a simple IORef and modified atomically.
type Counter = IORef Int

-- | Returns a global counter.
{-# NOINLINE getCounter #-} 
getCounter :: Counter
getCounter = unsafePerformIO (newIORef 0) --(newMVar [0..])

-- | Returns a local counter.
getLocalCounter :: Counter
getLocalCounter = unsafePerformIO (newIORef 0) 

--mkCounter :: Int -> IO Counter
--mkCounter i = newIORef i

-- | Returns the current value of the counter.                 
get :: Counter -> IO Int
get c = readIORef c

-- | Increments the counter.
incr :: Counter -> IO ()
incr c = atomicModifyIORef c (\a -> (a+1,()))

-- | Increments the counter and returns the previous version.
getAndIncr :: Counter -> IO Int
getAndIncr c = do old <- atomicModifyIORef c (\a -> (a+1,a))
                  return old

-- | Increments the counter without synchronization and returns the
-- previous version. This is unsafe as concurrent access might return
-- the same value.
getAndIncrWithoutSync :: Counter -> IO Int
getAndIncrWithoutSync c = do old <- get c 
                             writeIORef c (old+1)
                             return old