never executed always true always false
    1 -- | Threadsafe, shared, atomic counters
    2 --
    3 -- This is based on "Data.Atomics.Counter".
    4 module UnliftIO.MessageBox.Util.Fresh
    5   ( fresh,
    6     incrementAndGet,
    7     newCounterVar,
    8     HasCounterVar (getCounterVar),
    9     CounterVar (),
   10   )
   11 where
   12 
   13 import Control.Monad.Reader (MonadReader, asks)
   14 import Data.Atomics.Counter
   15   ( AtomicCounter,
   16     incrCounter,
   17     newCounter,
   18   )
   19 import Data.Coerce (Coercible, coerce)
   20 import UnliftIO (MonadIO (..))
   21 
   22 -- | A threadsafe atomic a
   23 
   24 -- | Atomically increment and get the value of the 'Counter'
   25 -- for type @a@ that must be present in the @env@.
   26 {-# INLINE fresh #-}
   27 fresh ::
   28   forall a env m.
   29   ( MonadReader env m,
   30     MonadIO m,
   31     HasCounterVar a env,
   32     Coercible a Int
   33   ) =>
   34   m a
   35 fresh =
   36   asks (getCounterVar @a) >>= incrementAndGet
   37 
   38 -- | Atomically increment and get the value of the 'Counter'
   39 -- for type @a@ that must be present in the @env@.
   40 {-# INLINE incrementAndGet #-}
   41 incrementAndGet ::
   42   forall a m.
   43   ( MonadIO m,
   44     Coercible a Int
   45   ) =>
   46   CounterVar a -> m a
   47 incrementAndGet (MkCounterVar !atomicCounter) =
   48   coerce <$> liftIO (incrCounter 1 atomicCounter)
   49 
   50 
   51 -- | Create a new 'CounterVar' starting at @0@.
   52 {-# INLINE newCounterVar #-}
   53 newCounterVar ::
   54   forall a m.
   55   MonadIO m =>
   56   m (CounterVar a)
   57 newCounterVar =
   58   MkCounterVar <$> liftIO (newCounter 0)
   59 
   60 -- | An 'AtomicCounter'.
   61 newtype CounterVar a = MkCounterVar AtomicCounter
   62 
   63 -- | A type class for @MonadReader@ based
   64 -- applications.
   65 class HasCounterVar a env | env -> a where
   66   getCounterVar :: env -> CounterVar a
   67 
   68 instance HasCounterVar t (CounterVar t) where
   69   getCounterVar = id