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