module UnliftIO.MessageBox.Util.CallId
  ( CallId (MkCallId),
    HasCallIdCounter (..),
    takeNext,
    newCallIdCounter,
  )
where

import Control.Monad.Reader (MonadReader, asks)
import UnliftIO.MessageBox.Util.Fresh
  ( CounterVar,
    incrementAndGet,
    newCounterVar,
  )
import UnliftIO (MonadIO, MonadUnliftIO)

-- | An identifier value every command send by 'call's.
newtype CallId = MkCallId Int
  deriving newtype (CallId -> CallId -> Bool
(CallId -> CallId -> Bool)
-> (CallId -> CallId -> Bool) -> Eq CallId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallId -> CallId -> Bool
$c/= :: CallId -> CallId -> Bool
== :: CallId -> CallId -> Bool
$c== :: CallId -> CallId -> Bool
Eq, Eq CallId
Eq CallId
-> (CallId -> CallId -> Ordering)
-> (CallId -> CallId -> Bool)
-> (CallId -> CallId -> Bool)
-> (CallId -> CallId -> Bool)
-> (CallId -> CallId -> Bool)
-> (CallId -> CallId -> CallId)
-> (CallId -> CallId -> CallId)
-> Ord CallId
CallId -> CallId -> Bool
CallId -> CallId -> Ordering
CallId -> CallId -> CallId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CallId -> CallId -> CallId
$cmin :: CallId -> CallId -> CallId
max :: CallId -> CallId -> CallId
$cmax :: CallId -> CallId -> CallId
>= :: CallId -> CallId -> Bool
$c>= :: CallId -> CallId -> Bool
> :: CallId -> CallId -> Bool
$c> :: CallId -> CallId -> Bool
<= :: CallId -> CallId -> Bool
$c<= :: CallId -> CallId -> Bool
< :: CallId -> CallId -> Bool
$c< :: CallId -> CallId -> Bool
compare :: CallId -> CallId -> Ordering
$ccompare :: CallId -> CallId -> Ordering
$cp1Ord :: Eq CallId
Ord)

instance Show CallId where
  showsPrec :: Int -> CallId -> ShowS
showsPrec Int
_ (MkCallId !Int
i) =
    Char -> ShowS
showChar Char
'<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'

-- | Class of environment records containing a 'CounterVar' for 'CallId's.
class HasCallIdCounter env where
  getCallIdCounter :: env -> CounterVar CallId

instance HasCallIdCounter (CounterVar CallId) where
  {-# INLINE getCallIdCounter #-}
  getCallIdCounter :: CounterVar CallId -> CounterVar CallId
getCallIdCounter = CounterVar CallId -> CounterVar CallId
forall a. a -> a
id

-- | Create a new 'CallId' 'CounterVar'.
{-# INLINE newCallIdCounter #-}
newCallIdCounter :: MonadIO m => m (CounterVar CallId)
newCallIdCounter :: m (CounterVar CallId)
newCallIdCounter = m (CounterVar CallId)
forall k (a :: k) (m :: * -> *). MonadIO m => m (CounterVar a)
newCounterVar

-- | Increment and get a new 'CallId'.
{-# INLINE takeNext #-}
takeNext :: (MonadReader env m, HasCallIdCounter env, MonadUnliftIO m) => m CallId
takeNext :: m CallId
takeNext = (env -> CounterVar CallId) -> m (CounterVar CallId)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> CounterVar CallId
forall env. HasCallIdCounter env => env -> CounterVar CallId
getCallIdCounter m (CounterVar CallId)
-> (CounterVar CallId -> m CallId) -> m CallId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CounterVar CallId -> m CallId
forall a (m :: * -> *).
(MonadIO m, Coercible a Int) =>
CounterVar a -> m a
incrementAndGet