-- | This module is intended to be imported qualified:
--
-- > import TimerWheel (TimerWheel)
-- > import TimerWheel qualified
module TimerWheel
  ( -- * Timer wheel
    TimerWheel,

    -- * Timer wheel configuration
    Config (..),
    Seconds,

    -- * Timer
    Timer,

    -- * Constructing a timer wheel
    create,
    with,

    -- * Querying a timer wheel
    count,

    -- * Registering timers in a timer wheel
    register,
    register_,
    recurring,
    recurring_,

    -- * Canceling timers
    cancel,
  )
where

import Control.Exception (mask_)
import Data.Primitive.Array qualified as Array
import Ki qualified
import TimerWheel.Internal.Alarm (Alarm (..))
import TimerWheel.Internal.AlarmBuckets (AlarmBuckets, AlarmId)
import TimerWheel.Internal.AlarmBuckets qualified as AlarmBuckets
import TimerWheel.Internal.Bucket (Bucket)
import TimerWheel.Internal.Bucket qualified as Bucket
import TimerWheel.Internal.Counter (Counter, decrCounter_, incrCounter, incrCounter_, newCounter, readCounter)
import TimerWheel.Internal.Nanoseconds (Nanoseconds (..))
import TimerWheel.Internal.Nanoseconds qualified as Nanoseconds
import TimerWheel.Internal.Prelude
import TimerWheel.Internal.Timer (Timer (..), cancel)
import TimerWheel.Internal.Timestamp (Timestamp)
import TimerWheel.Internal.Timestamp qualified as Timestamp

-- | A timer wheel is a vector-of-collections-of timers to fire. Timers may be one-shot or recurring, and may be
-- scheduled arbitrarily far in the future.
--
-- A timer wheel is configured with a /spoke count/ and /resolution/:
--
-- * The /spoke count/ determines the size of the timer vector.
--
--     A __larger spoke count__ will require __more memory__, but will result in __less insert contention__.
--
-- * The /resolution/ determines the duration of time that each spoke corresponds to, and thus how often timers are
--   checked for expiry.
--
--     For example, in a timer wheel with a /resolution/ of __@1 second@__, a timer that is scheduled to fire at
--     __@8.4 o'clock@__ will end up firing around __@9.0 o'clock@__ instead (that is, on the
--     __@1 second@__-boundary).
--
--     A __larger resolution__ will result in __more insert contention__ and __less accurate timers__, but will require
--     __fewer wakeups__ by the timeout thread.
--
-- The timeout thread has some important properties:
--
--     * There is only one, and it fires expired timers synchronously. If your timer actions execute quicky, you can
--       'register' them directly. Otherwise, consider registering an action that enqueues the real action to be
--       performed on a job queue.
--
--     * A synchronous exception thrown by a registered timer will bring the timeout thread down, and the exception will
--       be propagated to the thread that created the timer wheel. If you want to log and ignore exceptions, for example,
--       you will have to bake this into the registered actions yourself.
--
-- __API summary__
--
-- +----------+---------+----------------+
-- | Create   | Query   | Modify         |
-- +==========+=========+================+
-- | 'create' | 'count' | 'register'     |
-- +----------+---------+----------------+
-- | 'with'   |         | 'register_'    |
-- +----------+         +----------------+
-- |          |         | 'recurring'    |
-- |          |         +----------------+
-- |          |         | 'recurring_'   |
-- +----------+---------+----------------+
data TimerWheel = TimerWheel
  { TimerWheel -> AlarmBuckets
buckets :: {-# UNPACK #-} !AlarmBuckets,
    TimerWheel -> Nanoseconds
resolution :: {-# UNPACK #-} !Nanoseconds,
    -- The number of registered alarms.
    TimerWheel -> Counter
count :: {-# UNPACK #-} !Counter,
    -- A counter to generate unique ints that identify registered actions, so they can be canceled.
    TimerWheel -> Counter
supply :: {-# UNPACK #-} !Counter
  }

-- | A timer wheel config.
--
-- * @spokes@ must be ∈ @[1, maxBound]@, and is set to @1024@ if invalid.
-- * @resolution@ must be ∈ @(0, ∞]@, and is set to @1@ if invalid.
--
-- __API summary__
--
-- +----------+
-- | Create   |
-- +==========+
-- | 'Config' |
-- +----------+
data Config = Config
  { -- | Spoke count
    Config -> Int
spokes :: {-# UNPACK #-} !Int,
    -- | Resolution
    Config -> Seconds
resolution :: !Seconds
  }
  deriving stock ((forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Config -> Rep Config x
from :: forall x. Config -> Rep Config x
$cto :: forall x. Rep Config x -> Config
to :: forall x. Rep Config x -> Config
Generic, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

-- | Create a timer wheel in a scope.
create ::
  -- | ​
  Ki.Scope ->
  -- | ​
  Config ->
  -- | ​
  IO TimerWheel
create :: Scope -> Config -> IO TimerWheel
create Scope
scope Config
config = do
  AlarmBuckets
buckets <- Int
-> Bucket Alarm -> IO (MutableArray (PrimState IO) (Bucket Alarm))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
Array.newArray Int
spokes Bucket Alarm
forall a. Bucket a
Bucket.empty
  Counter
count_ <- IO Counter
newCounter
  Counter
supply <- IO Counter
newCounter
  Scope -> IO Void -> IO ()
Ki.fork_ Scope
scope (AlarmBuckets -> Nanoseconds -> IO Void
forall v. AlarmBuckets -> Nanoseconds -> IO v
runTimerReaperThread AlarmBuckets
buckets Nanoseconds
resolution)
  TimerWheel -> IO TimerWheel
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimerWheel {AlarmBuckets
buckets :: AlarmBuckets
buckets :: AlarmBuckets
buckets, count :: Counter
count = Counter
count_, Nanoseconds
resolution :: Nanoseconds
resolution :: Nanoseconds
resolution, Counter
supply :: Counter
supply :: Counter
supply}
  where
    spokes :: Int
spokes = if Config
config.spokes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
1024 else Config
config.spokes
    resolution :: Nanoseconds
resolution = Seconds -> Nanoseconds
Nanoseconds.fromNonNegativeSeconds (if Config
config.resolution Seconds -> Seconds -> Bool
forall a. Ord a => a -> a -> Bool
<= Seconds
0 then Seconds
1 else Config
config.resolution)

-- | Perform an action with a timer wheel.
with ::
  -- | ​
  Config ->
  -- | ​
  (TimerWheel -> IO a) ->
  -- | ​
  IO a
with :: forall a. Config -> (TimerWheel -> IO a) -> IO a
with Config
config TimerWheel -> IO a
action =
  (Scope -> IO a) -> IO a
forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
scope -> do
    TimerWheel
wheel <- Scope -> Config -> IO TimerWheel
create Scope
scope Config
config
    TimerWheel -> IO a
action TimerWheel
wheel

-- | Get the number of timers in a timer wheel.
--
-- /O(1)/.
count :: TimerWheel -> IO Int
count :: TimerWheel -> IO Int
count TimerWheel
wheel =
  Counter -> IO Int
readCounter TimerWheel
wheel.count

-- | @register wheel delay action@ registers __@action@__ in __@wheel@__ to fire after __@delay@__ seconds.
--
-- When canceled, the timer returns whether or not the cancelation was successful; @False@ means the timer had either
-- already fired, or had already been canceled.
register ::
  -- | The timer wheel
  TimerWheel ->
  -- | The delay before the action is fired
  Seconds ->
  -- | The action to fire
  IO () ->
  -- | The timer
  IO (Timer Bool)
register :: TimerWheel -> Seconds -> IO () -> IO (Timer Bool)
register TimerWheel
wheel Seconds
delay IO ()
action = do
  Timestamp
now <- IO Timestamp
Timestamp.now
  let ringsAt :: Timestamp
ringsAt = Timestamp
now Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Seconds -> Nanoseconds
Nanoseconds.fromSeconds Seconds
delay
  Int
alarmId <- Counter -> IO Int
incrCounter TimerWheel
wheel.supply
  TimerWheel -> Int -> Timestamp -> Alarm -> IO ()
insertAlarm TimerWheel
wheel Int
alarmId Timestamp
ringsAt (IO () -> Alarm
OneShot (IO ()
action IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Counter -> IO ()
decrCounter_ TimerWheel
wheel.count))
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO (IO Bool)) @(IO (Timer Bool)) do
    IO Bool -> IO (IO Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
      IO Bool -> IO Bool
forall a. IO a -> IO a
mask_ do
        Bool
deleted <- AlarmBuckets -> Nanoseconds -> Int -> Timestamp -> IO Bool
AlarmBuckets.delete TimerWheel
wheel.buckets TimerWheel
wheel.resolution Int
alarmId Timestamp
ringsAt
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
deleted (Counter -> IO ()
decrCounter_ TimerWheel
wheel.count)
        Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
deleted

-- | Like 'register', but for when you don't intend to cancel the timer.
register_ ::
  -- | The timer wheel
  TimerWheel ->
  -- | The delay before the action is fired
  Seconds ->
  -- | The action to fire
  IO () ->
  IO ()
register_ :: TimerWheel -> Seconds -> IO () -> IO ()
register_ TimerWheel
wheel Seconds
delay IO ()
action =
  IO (Timer Bool) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TimerWheel -> Seconds -> IO () -> IO (Timer Bool)
register TimerWheel
wheel Seconds
delay IO ()
action)

-- | @recurring wheel action delay@ registers __@action@__ in __@wheel@__ to fire in __@delay@__ seconds, and every
-- __@delay@__ seconds thereafter.
recurring ::
  -- | The timer wheel
  TimerWheel ->
  -- | The delay before each action is fired
  Seconds ->
  -- | The action to fire repeatedly
  IO () ->
  -- | The timer
  IO (Timer ())
recurring :: TimerWheel -> Seconds -> IO () -> IO (Timer ())
recurring TimerWheel
wheel (Seconds -> Nanoseconds
Nanoseconds.fromSeconds -> Nanoseconds
delay) IO ()
action = do
  Timestamp
now <- IO Timestamp
Timestamp.now
  Int
alarmId <- Counter -> IO Int
incrCounter TimerWheel
wheel.supply
  IORef Bool
canceledRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  TimerWheel -> Int -> Timestamp -> Alarm -> IO ()
insertAlarm TimerWheel
wheel Int
alarmId (Timestamp
now Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Nanoseconds
delay) (IO () -> Nanoseconds -> IORef Bool -> Alarm
Recurring IO ()
action Nanoseconds
delay IORef Bool
canceledRef)
  forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO (IO ())) @(IO (Timer ())) do
    IO () -> IO (IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
      IO () -> IO ()
forall a. IO a -> IO a
mask_ do
        IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
canceledRef Bool
True
        Counter -> IO ()
decrCounter_ TimerWheel
wheel.count

-- | Like 'recurring', but for when you don't intend to cancel the timer.
recurring_ ::
  TimerWheel ->
  -- | The delay before each action is fired
  Seconds ->
  -- | The action to fire repeatedly
  IO () ->
  IO ()
recurring_ :: TimerWheel -> Seconds -> IO () -> IO ()
recurring_ TimerWheel
wheel (Seconds -> Nanoseconds
Nanoseconds.fromSeconds -> Nanoseconds
delay) IO ()
action = do
  Timestamp
now <- IO Timestamp
Timestamp.now
  Int
alarmId <- Counter -> IO Int
incrCounter TimerWheel
wheel.supply
  TimerWheel -> Int -> Timestamp -> Alarm -> IO ()
insertAlarm TimerWheel
wheel Int
alarmId (Timestamp
now Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Nanoseconds
delay) (IO () -> Nanoseconds -> Alarm
Recurring_ IO ()
action Nanoseconds
delay)

insertAlarm :: TimerWheel -> AlarmId -> Timestamp -> Alarm -> IO ()
insertAlarm :: TimerWheel -> Int -> Timestamp -> Alarm -> IO ()
insertAlarm TimerWheel
wheel Int
alarmId Timestamp
ringsAt Alarm
alarm =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ do
    Counter -> IO ()
incrCounter_ TimerWheel
wheel.count
    AlarmBuckets -> Nanoseconds -> Int -> Timestamp -> Alarm -> IO ()
AlarmBuckets.insert TimerWheel
wheel.buckets TimerWheel
wheel.resolution Int
alarmId Timestamp
ringsAt Alarm
alarm

------------------------------------------------------------------------------------------------------------------------
-- Timer reaper thread
--
-- The main loop is rather simple, but the code is somewhat fiddly. In brief, the reaper thread wakes up to fire all of
-- the expired timers in bucket N, then sleeps, then wakes up to fire all of the expired timers in bucket N+1, then
-- sleeps, and so on, forever.
--
-- It wakes up on the "bucket boundaries", that is,
--
--   +------+------+------+------+------+------+------+------+------+------+
--   |      |      |      |      |      |      |      |      |      |      |
--   |      |      |      |      |      |      |      |      |      |      |
--   +------+------+------+------+------+------+------+------+------+------+
--                           ^   ^
--                           |   we wake up around here
--                           |
--                           to fire all of the expired timers stored here
--
-- It's entirely possible the reaper thread gets hopelessly behind, that is, it's taken so long to expire all of the
-- timers in previous buckets that we're behind schedule an entire bucket or more. That might look like this:
--
--   +------+------+------+------+------+------+------+------+------+------+
--   |      |      |      |      |      |      |      |      |      |      |
--   |      |      |      |      |      |      |      |      |      |      |
--   +------+------+------+------+------+------+------+------+------+------+
--                           ^                    ^
--                           |                    we are very behind, and enter the loop around here
--                           |
--                           yet we nonetheless fire all of the expired timers stored here, as if we were on time
--
-- That's accomplished simplly by maintaining in the loop state the "ideal" time that we wake up, ignoring reality. We
-- only ultimately check the *actual* current time when determining how long to *sleep* after expiring all of the timers
-- in the current bucket. If we're behind schedule, we won't sleep at all.
--
--   +------+------+------+------+------+------+------+------+------+------+
--   |      |      |      |      |      |      |      |      |      |      |
--   |      |      |      |      |      |      |      |      |      |      |
--   +------+------+------+------+------+------+------+------+------+------+
--                           ^   ^                  ^
--                           |   |                  |
--                           |   we enter the loop with this "ideal" time
--                           |                      |
--                           to fire timers in here |
--                                                  |
--                                                  not caring how far ahead the actual current time is
--
-- On to expiring timers: a "bucket" of timers is stored at each array index, which can be partitioned into "expired"
-- (meant to fire at or before the ideal time) and "not expired" (to expire on a subsequent wrap around the bucket
-- array).
--
--   +-----------------------+
--   |           /           |
--   | expired  /            |
--   |         / not expired |
--   |        /              |
--   +-----------------------+
--
-- The reaper thread simply atomically partitions the bucket, keeping the expired collection for itself, and putting the
-- not-expired collection back in the array.
--
-- Next, the timers are carefully fired one-by-one, in timestamp order. It's possible that two or more timers are
-- scheduled to expire concurrently (i.e. on the same nanosecond); that's fine: we fire them in the order they were
-- scheduled.
--
-- Let's say this is our set of timers to fire.
--
--    Ideal time         Timers to fire
--   +--------------+   +-----------------------------+
--   | 700          |   | Expiry | Type               |
--   +--------------+   +--------+--------------------+
--                      | 630    | One-shot           |
--    Next ideal time   | 643    | Recurring every 10 |
--   +--------------+   | 643    | One-shot           |
--   | 800          |   | 689    | Recurring every 80 |
--   +--------------+   +--------+--------------------+
--
-- Expiring a one-shot timer is simple: call the IO action and move on.
--
-- Expiring a recurring timer is less simple (but still simple): call the IO action, then schedule the next occurrence.
-- There are two possibilities.
--
--   1. The next occurrence is *at or before* the ideal time, which means it ought to fire along with the other timers
--      in the queue, right now. So, insert it into the collection of timers to fire.
--
--   2. The next occurrence is *after* the ideal time, so enqueue it in the array of buckets wherever it belongs.
--
-- After all expired timers are fired, the reaper thread has one last decision to make: how long should we sleep? We
-- get the current timestamp, and if it's still before the next ideal time (i.e. the current ideal time plus the wheel
-- resolution), then we sleep for the difference.
--
-- If the actual time is at or after the next ideal time, that's kind of bad - it means the reaper thread is behind
-- schedule. The user's enqueued actions have taken too long, or their wheel resolution is too short. Anyway, it's not
-- our problem, our behavior doesn't change per whether we are behind schedule or not.
runTimerReaperThread :: AlarmBuckets -> Nanoseconds -> IO v
runTimerReaperThread :: forall v. AlarmBuckets -> Nanoseconds -> IO v
runTimerReaperThread AlarmBuckets
buckets Nanoseconds
resolution = do
  -- Sleep until the very first bucket of timers expires
  --
  --     resolution                         = 100
  --     now                                = 184070
  --     progress   = now % resolution      = 70
  --     remaining  = resolution - progress = 30
  --     idealTime  = now + remaining       = 184100
  --
  --   +-------------------------+----------------+---------
  --   | progress = 70           | remaining = 30 |
  --   +-------------------------+----------------+
  --   | resolution = 100                         |
  --   +------------------------------------------+---------
  --                             ^                ^
  --                             now              idealTime
  Timestamp
now <- IO Timestamp
Timestamp.now
  let progress :: Nanoseconds
progress = Timestamp
now Timestamp -> Nanoseconds -> Nanoseconds
`Timestamp.intoEpoch` Nanoseconds
resolution
  let remaining :: Nanoseconds
remaining = Nanoseconds
resolution Nanoseconds -> Nanoseconds -> Nanoseconds
`Nanoseconds.unsafeMinus` Nanoseconds
progress
  Nanoseconds -> IO ()
Nanoseconds.sleep Nanoseconds
remaining
  -- Enter the Loop™
  let idealTime :: Timestamp
idealTime = Timestamp
now Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Nanoseconds
remaining
  Timestamp -> Int -> IO v
forall v. Timestamp -> Int -> IO v
theLoop Timestamp
idealTime (AlarmBuckets -> Nanoseconds -> Timestamp -> Int
AlarmBuckets.timestampToIndex AlarmBuckets
buckets Nanoseconds
resolution Timestamp
now)
  where
    -- `index` could be derived from `thisTime`, but it's cheaper to just store it separately and bump by 1 as we go
    theLoop :: Timestamp -> Int -> IO v
    theLoop :: forall v. Timestamp -> Int -> IO v
theLoop !Timestamp
idealTime !Int
index = do
      Bucket Alarm
expired <- AlarmBuckets -> Int -> Timestamp -> IO (Bucket Alarm)
AlarmBuckets.deleteExpiredAt AlarmBuckets
buckets Int
index Timestamp
idealTime
      Bucket Alarm -> IO ()
fireBucket Bucket Alarm
expired

      Timestamp
now <- IO Timestamp
Timestamp.now
      let !nextIdealTime :: Timestamp
nextIdealTime = Timestamp
idealTime Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Nanoseconds
resolution
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Timestamp
nextIdealTime Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
> Timestamp
now) (Nanoseconds -> IO ()
Nanoseconds.sleep (Timestamp
nextIdealTime Timestamp -> Timestamp -> Nanoseconds
`Timestamp.unsafeMinus` Timestamp
now))

      Timestamp -> Int -> IO v
forall v. Timestamp -> Int -> IO v
theLoop Timestamp
nextIdealTime ((Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` AlarmBuckets -> Int
forall s a. MutableArray s a -> Int
Array.sizeofMutableArray AlarmBuckets
buckets)
      where
        fireBucket :: Bucket Alarm -> IO ()
        fireBucket :: Bucket Alarm -> IO ()
fireBucket Bucket Alarm
bucket0 =
          case Bucket Alarm -> Pop Alarm
forall a. Bucket a -> Pop a
Bucket.pop Bucket Alarm
bucket0 of
            Pop Alarm
Bucket.PopNada -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Bucket.PopAlgo Int
alarmId Timestamp
ringsAt Alarm
timer Bucket Alarm
bucket1 -> do
              Bucket Alarm
expired <- Bucket Alarm -> Int -> Timestamp -> Alarm -> IO (Bucket Alarm)
fireAlarm Bucket Alarm
bucket1 Int
alarmId Timestamp
ringsAt Alarm
timer
              Bucket Alarm -> IO ()
fireBucket Bucket Alarm
expired

        fireAlarm :: Bucket Alarm -> AlarmId -> Timestamp -> Alarm -> IO (Bucket Alarm)
        fireAlarm :: Bucket Alarm -> Int -> Timestamp -> Alarm -> IO (Bucket Alarm)
fireAlarm Bucket Alarm
bucket Int
alarmId Timestamp
ringsAt Alarm
alarm =
          case Alarm
alarm of
            OneShot IO ()
action -> do
              IO ()
action
              Bucket Alarm -> IO (Bucket Alarm)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bucket Alarm
bucket
            Recurring IO ()
action Nanoseconds
delay IORef Bool
canceledRef ->
              IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
canceledRef IO Bool -> (Bool -> IO (Bucket Alarm)) -> IO (Bucket Alarm)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Bool
True -> Bucket Alarm -> IO (Bucket Alarm)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bucket Alarm
bucket
                Bool
False -> IO () -> Nanoseconds -> IO (Bucket Alarm)
fireRecurring IO ()
action Nanoseconds
delay
            Recurring_ IO ()
action Nanoseconds
delay -> IO () -> Nanoseconds -> IO (Bucket Alarm)
fireRecurring IO ()
action Nanoseconds
delay
          where
            fireRecurring :: IO () -> Nanoseconds -> IO (Bucket Alarm)
            fireRecurring :: IO () -> Nanoseconds -> IO (Bucket Alarm)
fireRecurring IO ()
action Nanoseconds
delay = do
              IO ()
action
              let ringsAtNext :: Timestamp
ringsAtNext = Timestamp
ringsAt Timestamp -> Nanoseconds -> Timestamp
`Timestamp.plus` Nanoseconds
delay
              if Timestamp
ringsAtNext Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
< Timestamp
idealTime
                then Bucket Alarm -> IO (Bucket Alarm)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bucket Alarm -> IO (Bucket Alarm))
-> Bucket Alarm -> IO (Bucket Alarm)
forall a b. (a -> b) -> a -> b
$! Int -> Timestamp -> Alarm -> Bucket Alarm -> Bucket Alarm
forall a. Int -> Timestamp -> a -> Bucket a -> Bucket a
Bucket.insert Int
alarmId Timestamp
ringsAtNext Alarm
alarm Bucket Alarm
bucket
                else do
                  AlarmBuckets -> Nanoseconds -> Int -> Timestamp -> Alarm -> IO ()
AlarmBuckets.insert AlarmBuckets
buckets Nanoseconds
resolution Int
alarmId Timestamp
ringsAtNext Alarm
alarm
                  Bucket Alarm -> IO (Bucket Alarm)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bucket Alarm
bucket