unliftio-messagebox-1.0.0: src/UnliftIO/MessageBox/Util/Fresh.hs

-- | Threadsafe, shared, atomic counters
--
-- This is based on "Data.Atomics.Counter".
module UnliftIO.MessageBox.Util.Fresh
  ( fresh,
    incrementAndGet,
    newCounterVar,
    HasCounterVar (getCounterVar),
    CounterVar (),
  )
where

import Control.Monad.Reader (MonadReader, asks)
import Data.Atomics.Counter
  ( AtomicCounter,
    incrCounter,
    newCounter,
  )
import Data.Coerce (Coercible, coerce)
import UnliftIO (MonadIO (..))

-- | A threadsafe atomic a

-- | Atomically increment and get the value of the 'Counter'
-- for type @a@ that must be present in the @env@.
{-# INLINE fresh #-}
fresh ::
  forall a env m.
  ( MonadReader env m,
    MonadIO m,
    HasCounterVar a env,
    Coercible a Int
  ) =>
  m a
fresh =
  asks (getCounterVar @a) >>= incrementAndGet

-- | Atomically increment and get the value of the 'Counter'
-- for type @a@ that must be present in the @env@.
{-# INLINE incrementAndGet #-}
incrementAndGet ::
  forall a m.
  ( MonadIO m,
    Coercible a Int
  ) =>
  CounterVar a -> m a
incrementAndGet (MkCounterVar !atomicCounter) =
  coerce <$> liftIO (incrCounter 1 atomicCounter)


-- | Create a new 'CounterVar' starting at @0@.
{-# INLINE newCounterVar #-}
newCounterVar ::
  forall a m.
  MonadIO m =>
  m (CounterVar a)
newCounterVar =
  MkCounterVar <$> liftIO (newCounter 0)

-- | An 'AtomicCounter'.
newtype CounterVar a = MkCounterVar AtomicCounter

-- | A type class for @MonadReader@ based
-- applications.
class HasCounterVar a env | env -> a where
  getCounterVar :: env -> CounterVar a

instance HasCounterVar t (CounterVar t) where
  getCounterVar = id