packages feed

timer-wheel 1.0.0 → 1.0.0.1

raw patch · 10 files changed

+263/−226 lines, 10 filesdep ~basedep ~randomdep ~tasty-bench

Dependency ranges changed: base, random, tasty-bench

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@-## [1.0.0] - 2023-10-10+## [1.0.0.1] - May 16, 2024 +- Fix `term-variable-capture` warnings+- Require at least GHC 9.2++## [1.0.0] - October 10, 2023+ - Add `count`, which returns the number of timers in a timer wheel - Add `Seconds` type alias for readability - Add `Timer` newtype for readability@@ -12,11 +17,11 @@ - Improve the resolution of timers from microseconds to nanoseconds - Simplify and optimize internals -## [0.4.0.1] - 2022-11-05+## [0.4.0.1] - November 5, 2022  - Fix inaccurate haddock on `recurring` -## [0.4.0] - 2022-11-05+## [0.4.0] - November 5, 2022  - Add `create` - Rename `Data.TimerWheel` to `TimerWheel`@@ -24,7 +29,7 @@ - Treat negative delays as 0 - Drop support for GHC < 8.6 -## [0.3.0] - 2020-06-18+## [0.3.0] - June 18, 2020  - Add `with` - Add support for GHC 8.8, GHC 8.10@@ -38,11 +43,11 @@ - Remove `InvalidTimerWheelConfig` exception. `error` is used instead - Remove support for GHC < 8.6 -## [0.2.0.1] - 2019-05-19+## [0.2.0.1] - May 19, 2019  - Swap out `ghc-prim` and `primitive` for `vector` -## [0.2.0] - 2019-02-03+## [0.2.0] - February 3, 2019  - Add `destroy` function, for reaping the background thread - Add `recurring_` function@@ -57,6 +62,6 @@ - Rename `new` to `create` - Make recurring timers more accurate -## [0.1.0] - 2018-07-18+## [0.1.0] - July 18, 2018  - Initial release
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2018-2023 Mitchell Rosen, Travis Staton+Copyright 2018-2024 Mitchell Dalvi Rosen, Travis Staton  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
src/TimerWheel.hs view
@@ -32,20 +32,20 @@ where  import Control.Exception (mask_)-import qualified Data.Atomics as Atomics-import Data.Functor (void)-import Data.Primitive.Array (MutableArray)-import qualified Data.Primitive.Array as Array-import GHC.Base (RealWorld)-import qualified Ki+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 qualified TimerWheel.Internal.Bucket as Bucket+import TimerWheel.Internal.Bucket qualified as Bucket import TimerWheel.Internal.Counter (Counter, decrCounter_, incrCounter, incrCounter_, newCounter, readCounter) import TimerWheel.Internal.Nanoseconds (Nanoseconds (..))-import qualified TimerWheel.Internal.Nanoseconds as Nanoseconds+import TimerWheel.Internal.Nanoseconds qualified as Nanoseconds import TimerWheel.Internal.Prelude+import TimerWheel.Internal.Timer (Timer (..), cancel) import TimerWheel.Internal.Timestamp (Timestamp)-import qualified TimerWheel.Internal.Timestamp as 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.@@ -90,11 +90,12 @@ -- |          |         | 'recurring_'   | -- +----------+---------+----------------+ data TimerWheel = TimerWheel-  { buckets :: {-# UNPACK #-} !(MutableArray RealWorld (Bucket Timer0)),+  { buckets :: {-# UNPACK #-} !AlarmBuckets,     resolution :: {-# UNPACK #-} !Nanoseconds,-    numTimers :: {-# UNPACK #-} !Counter,+    -- The number of registered alarms.+    count :: {-# UNPACK #-} !Counter,     -- A counter to generate unique ints that identify registered actions, so they can be canceled.-    timerIdSupply :: {-# UNPACK #-} !Counter+    supply :: {-# UNPACK #-} !Counter   }  -- | A timer wheel config.@@ -125,15 +126,15 @@   Config ->   -- | ​   IO TimerWheel-create scope (Config spokes0 resolution0) = do+create scope config = do   buckets <- Array.newArray spokes Bucket.empty-  numTimers <- newCounter-  timerIdSupply <- newCounter-  Ki.fork_ scope (runTimerReaperThread buckets numTimers resolution)-  pure TimerWheel {buckets, numTimers, resolution, timerIdSupply}+  count_ <- newCounter+  supply <- newCounter+  Ki.fork_ scope (runTimerReaperThread buckets resolution)+  pure TimerWheel {buckets, count = count_, resolution, supply}   where-    spokes = if spokes0 <= 0 then 1024 else spokes0-    resolution = Nanoseconds.fromNonNegativeSeconds (if resolution0 <= 0 then 1 else resolution0)+    spokes = if config.spokes <= 0 then 1024 else config.spokes+    resolution = Nanoseconds.fromNonNegativeSeconds (if config.resolution <= 0 then 1 else config.resolution)  -- | Perform an action with a timer wheel. with ::@@ -152,8 +153,8 @@ -- -- /O(1)/. count :: TimerWheel -> IO Int-count TimerWheel {numTimers} =-  readCounter numTimers+count wheel =+  readCounter wheel.count  -- | @register wheel delay action@ registers __@action@__ in __@wheel@__ to fire after __@delay@__ seconds. --@@ -168,19 +169,16 @@   IO () ->   -- | The timer   IO (Timer Bool)-register TimerWheel {buckets, numTimers, resolution, timerIdSupply} delay action = do+register wheel delay action = do   now <- Timestamp.now-  let timestamp = now `Timestamp.plus` Nanoseconds.fromSeconds delay-  let index = timestampToIndex buckets resolution timestamp-  timerId <- incrCounter timerIdSupply-  mask_ do-    atomicModifyArray buckets index (Bucket.insert timerId timestamp (OneShot1 action))-    incrCounter_ numTimers+  let ringsAt = now `Timestamp.plus` Nanoseconds.fromSeconds delay+  alarmId <- incrCounter wheel.supply+  insertAlarm wheel alarmId ringsAt (OneShot (action >> decrCounter_ wheel.count))   coerce @(IO (IO Bool)) @(IO (Timer Bool)) do     pure do       mask_ do-        deleted <- atomicMaybeModifyArray buckets index (Bucket.deleteExpectingHit timerId)-        when deleted (decrCounter_ numTimers)+        deleted <- AlarmBuckets.delete wheel.buckets wheel.resolution alarmId ringsAt+        when deleted (decrCounter_ wheel.count)         pure deleted  -- | Like 'register', but for when you don't intend to cancel the timer.@@ -206,20 +204,16 @@   IO () ->   -- | The timer   IO (Timer ())-recurring TimerWheel {buckets, numTimers, resolution, timerIdSupply} (Nanoseconds.fromSeconds -> delay) action = do+recurring wheel (Nanoseconds.fromSeconds -> delay) action = do   now <- Timestamp.now-  let timestamp = now `Timestamp.plus` delay-  let index = timestampToIndex buckets resolution timestamp-  timerId <- incrCounter timerIdSupply+  alarmId <- incrCounter wheel.supply   canceledRef <- newIORef False-  mask_ do-    atomicModifyArray buckets index (Bucket.insert timerId timestamp (Recurring1 action delay canceledRef))-    incrCounter_ numTimers+  insertAlarm wheel alarmId (now `Timestamp.plus` delay) (Recurring action delay canceledRef)   coerce @(IO (IO ())) @(IO (Timer ())) do     pure do       mask_ do         writeIORef canceledRef True-        decrCounter_ numTimers+        decrCounter_ wheel.count  -- | Like 'recurring', but for when you don't intend to cancel the timer. recurring_ ::@@ -229,109 +223,16 @@   -- | The action to fire repeatedly   IO () ->   IO ()-recurring_ TimerWheel {buckets, numTimers, resolution, timerIdSupply} (Nanoseconds.fromSeconds -> delay) action = do+recurring_ wheel (Nanoseconds.fromSeconds -> delay) action = do   now <- Timestamp.now-  let timestamp = now `Timestamp.plus` delay-  let index = timestampToIndex buckets resolution timestamp-  timerId <- incrCounter timerIdSupply-  mask_ do-    atomicModifyArray buckets index (Bucket.insert timerId timestamp (Recurring1_ action delay))-    incrCounter_ numTimers---- | A registered timer, parameterized by the result of attempting to cancel it:------     * A one-shot timer may only be canceled if it has not already fired.---     * A recurring timer can always be canceled.------ __API summary__------ +-------------+----------+--- | Create      | Modify   |--- +=============+==========+--- | 'register'  | 'cancel' |--- +-------------+----------+--- | 'recurring' |          |--- +-------------+----------+-newtype Timer a-  = Timer (IO a)---- | Cancel a timer.-cancel :: Timer a -> IO a-cancel =-  coerce---- `timestampToIndex buckets resolution timestamp` figures out which index `timestamp` corresponds to in `buckets`,--- where each bucket corresponds to `resolution` nanoseconds.------ For example, consider a three-element `buckets` with resolution `1000000000`.------   +--------------------------------------+---   | 1000000000 | 1000000000 | 1000000000 |---   +--------------------------------------+------ Some timestamp like `1053298012387` gets binned to one of the three indices 0, 1, or 2, with quick and easy maffs:------   1. Figure out which index the timestamp corresponds to, if there were infinitely many:------        1053298012387 `div` 1000000000 = 1053------   2. Wrap around per the actual length of the array:------        1053 `rem` 3 = 0-timestampToIndex :: MutableArray RealWorld bucket -> Nanoseconds -> Timestamp -> Int-timestampToIndex buckets resolution timestamp =-  -- This downcast is safe because there are at most `maxBound :: Int` buckets (not that anyone would ever have that-  -- many...)-  fromIntegral @Word64 @Int-    (Timestamp.epoch resolution timestamp `rem` fromIntegral @Int @Word64 (Array.sizeofMutableArray buckets))--data Timer0-  = OneShot1 !(IO ())-  | Recurring1 !(IO ()) !Nanoseconds !(IORef Bool)-  | Recurring1_ !(IO ()) !Nanoseconds--type TimerId =-  Int----------------------------------------------------------------------------------------------------------------------------- Atomic operations on arrays--atomicModifyArray :: forall a. MutableArray RealWorld a -> Int -> (a -> a) -> IO ()-atomicModifyArray array index f = do-  ticket0 <- Atomics.readArrayElem array index-  loop ticket0-  where-    loop :: Atomics.Ticket a -> IO ()-    loop ticket = do-      (success, ticket1) <- Atomics.casArrayElem array index ticket (f (Atomics.peekTicket ticket))-      if success then pure () else loop ticket1--atomicMaybeModifyArray :: forall a. MutableArray RealWorld a -> Int -> (a -> Maybe a) -> IO Bool-atomicMaybeModifyArray buckets index doDelete = do-  ticket0 <- Atomics.readArrayElem buckets index-  loop ticket0-  where-    loop :: Atomics.Ticket a -> IO Bool-    loop ticket =-      case doDelete (Atomics.peekTicket ticket) of-        Nothing -> pure False-        Just bucket -> do-          (success, ticket1) <- Atomics.casArrayElem buckets index ticket bucket-          if success then pure True else loop ticket1+  alarmId <- incrCounter wheel.supply+  insertAlarm wheel alarmId (now `Timestamp.plus` delay) (Recurring_ action delay) -atomicExtractExpiredTimersFromBucket :: MutableArray RealWorld (Bucket Timer0) -> Int -> Timestamp -> IO (Bucket Timer0)-atomicExtractExpiredTimersFromBucket buckets index now = do-  ticket0 <- Atomics.readArrayElem buckets index-  loop ticket0-  where-    loop :: Atomics.Ticket (Bucket Timer0) -> IO (Bucket Timer0)-    loop ticket = do-      let Bucket.Pair expired bucket1 = Bucket.partition now (Atomics.peekTicket ticket)-      if Bucket.isEmpty expired-        then pure Bucket.empty-        else do-          (success, ticket1) <- Atomics.casArrayElem buckets index ticket bucket1-          if success then pure expired else loop ticket1+insertAlarm :: TimerWheel -> AlarmId -> Timestamp -> Alarm -> IO ()+insertAlarm wheel alarmId ringsAt alarm =+  mask_ do+    incrCounter_ wheel.count+    AlarmBuckets.insert wheel.buckets wheel.resolution alarmId ringsAt alarm  ------------------------------------------------------------------------------------------------------------------------ -- Timer reaper thread@@ -426,8 +327,8 @@ -- 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 :: MutableArray RealWorld (Bucket Timer0) -> Counter -> Nanoseconds -> IO void-runTimerReaperThread buckets numTimers resolution = do+runTimerReaperThread :: AlarmBuckets -> Nanoseconds -> IO v+runTimerReaperThread buckets resolution = do   -- Sleep until the very first bucket of timers expires   --   --     resolution                         = 100@@ -449,54 +350,46 @@   Nanoseconds.sleep remaining   -- Enter the Loop™   let idealTime = now `Timestamp.plus` remaining-  theLoop idealTime (timestampToIndex buckets resolution now)+  theLoop idealTime (AlarmBuckets.timestampToIndex buckets resolution 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 void+    theLoop :: Timestamp -> Int -> IO v     theLoop !idealTime !index = do-      expired2 <- atomicExtractExpiredTimersFromBucket buckets index idealTime-      fireTimerBucket expired2-      let !nextIdealTime = idealTime `Timestamp.plus` resolution+      expired <- AlarmBuckets.deleteExpiredAt buckets index idealTime+      fireBucket expired+       now <- Timestamp.now+      let !nextIdealTime = idealTime `Timestamp.plus` resolution       when (nextIdealTime > now) (Nanoseconds.sleep (nextIdealTime `Timestamp.unsafeMinus` now))+       theLoop nextIdealTime ((index + 1) `rem` Array.sizeofMutableArray buckets)       where-        fireTimerBucket :: Bucket Timer0 -> IO ()-        fireTimerBucket bucket0 =+        fireBucket :: Bucket Alarm -> IO ()+        fireBucket bucket0 =           case Bucket.pop bucket0 of             Bucket.PopNada -> pure ()-            Bucket.PopAlgo timerId timestamp timer bucket1 -> do-              expired2 <- fireTimer bucket1 timerId timestamp timer-              fireTimerBucket expired2+            Bucket.PopAlgo alarmId ringsAt timer bucket1 -> do+              expired <- fireAlarm bucket1 alarmId ringsAt timer+              fireBucket expired -        fireTimer :: Bucket Timer0 -> TimerId -> Timestamp -> Timer0 -> IO (Bucket Timer0)-        fireTimer bucket timerId timestamp timer =-          case timer of-            OneShot1 action -> do+        fireAlarm :: Bucket Alarm -> AlarmId -> Timestamp -> Alarm -> IO (Bucket Alarm)+        fireAlarm bucket alarmId ringsAt alarm =+          case alarm of+            OneShot action -> do               action-              decrCounter_ numTimers               pure bucket-            Recurring1 action delay canceledRef ->+            Recurring action delay canceledRef ->               readIORef canceledRef >>= \case                 True -> pure bucket-                False -> do-                  action-                  scheduleNextOccurrence (timestamp `Timestamp.plus` delay)-            Recurring1_ action delay -> do-              action-              scheduleNextOccurrence (timestamp `Timestamp.plus` delay)+                False -> fireRecurring action delay+            Recurring_ action delay -> fireRecurring action delay           where-            scheduleNextOccurrence :: Timestamp -> IO (Bucket Timer0)-            scheduleNextOccurrence nextOccurrence =-              if nextOccurrence < idealTime-                then pure $! insertNextOccurrence bucket+            fireRecurring :: IO () -> Nanoseconds -> IO (Bucket Alarm)+            fireRecurring action delay = do+              action+              let ringsAtNext = ringsAt `Timestamp.plus` delay+              if ringsAtNext < idealTime+                then pure $! Bucket.insert alarmId ringsAtNext alarm bucket                 else do-                  atomicModifyArray-                    buckets-                    (timestampToIndex buckets resolution nextOccurrence)-                    insertNextOccurrence+                  AlarmBuckets.insert buckets resolution alarmId ringsAtNext alarm                   pure bucket-              where-                insertNextOccurrence :: Bucket Timer0 -> Bucket Timer0-                insertNextOccurrence =-                  Bucket.insert timerId nextOccurrence timer
+ src/TimerWheel/Internal/Alarm.hs view
@@ -0,0 +1,12 @@+module TimerWheel.Internal.Alarm+  ( Alarm (..),+  )+where++import TimerWheel.Internal.Nanoseconds (Nanoseconds)+import TimerWheel.Internal.Prelude++data Alarm+  = OneShot !(IO ())+  | Recurring !(IO ()) {-# UNPACK #-} !Nanoseconds !(IORef Bool)+  | Recurring_ !(IO ()) {-# UNPACK #-} !Nanoseconds
+ src/TimerWheel/Internal/AlarmBuckets.hs view
@@ -0,0 +1,102 @@+module TimerWheel.Internal.AlarmBuckets+  ( AlarmBuckets,+    AlarmId,+    insert,+    delete,+    deleteExpiredAt,+    timestampToIndex,+  )+where++import Data.Atomics qualified as Atomics+import Data.Primitive.Array (MutableArray)+import Data.Primitive.Array qualified as Array+import GHC.Base (RealWorld)+import TimerWheel.Internal.Alarm (Alarm (..))+import TimerWheel.Internal.Bucket (Bucket)+import TimerWheel.Internal.Bucket qualified as Bucket+import TimerWheel.Internal.Nanoseconds (Nanoseconds)+import TimerWheel.Internal.Prelude+import TimerWheel.Internal.Timestamp (Timestamp)+import TimerWheel.Internal.Timestamp qualified as Timestamp++type AlarmBuckets =+  MutableArray RealWorld (Bucket Alarm)++type AlarmId =+  Int++insert :: AlarmBuckets -> Nanoseconds -> AlarmId -> Timestamp -> Alarm -> IO ()+insert buckets resolution alarmId timestamp alarm = do+  ticket <- Atomics.readArrayElem buckets index+  loop ticket+  where+    loop :: Atomics.Ticket (Bucket Alarm) -> IO ()+    loop ticket = do+      (success, ticket1) <-+        Atomics.casArrayElem+          buckets+          index+          ticket+          (Bucket.insert alarmId timestamp alarm (Atomics.peekTicket ticket))+      if success then pure () else loop ticket1++    index :: Int+    index =+      timestampToIndex buckets resolution timestamp++delete :: AlarmBuckets -> Nanoseconds -> AlarmId -> Timestamp -> IO Bool+delete buckets resolution alarmId timestamp = do+  ticket <- Atomics.readArrayElem buckets index+  loop ticket+  where+    loop :: Atomics.Ticket (Bucket Alarm) -> IO Bool+    loop ticket =+      case Bucket.deleteExpectingHit alarmId (Atomics.peekTicket ticket) of+        Nothing -> pure False+        Just bucket -> do+          (success, ticket1) <- Atomics.casArrayElem buckets index ticket bucket+          if success then pure True else loop ticket1++    index :: Int+    index =+      timestampToIndex buckets resolution timestamp++deleteExpiredAt :: AlarmBuckets -> Int -> Timestamp -> IO (Bucket Alarm)+deleteExpiredAt buckets index now = do+  ticket <- Atomics.readArrayElem buckets index+  loop ticket+  where+    loop :: Atomics.Ticket (Bucket Alarm) -> IO (Bucket Alarm)+    loop ticket = do+      let Bucket.Pair expired bucket1 = Bucket.partition now (Atomics.peekTicket ticket)+      if Bucket.isEmpty expired+        then pure Bucket.empty+        else do+          (success, ticket1) <- Atomics.casArrayElem buckets index ticket bucket1+          if success then pure expired else loop ticket1++-- `timestampToIndex buckets resolution timestamp` figures out which index `timestamp` corresponds to in `buckets`,+-- where each bucket corresponds to `resolution` nanoseconds.+--+-- For example, consider a three-element `buckets` with resolution `1000000000`.+--+--   +--------------------------------------++--   | 1000000000 | 1000000000 | 1000000000 |+--   +--------------------------------------++--+-- Some timestamp like `1053298012387` gets binned to one of the three indices 0, 1, or 2, with quick and easy maffs:+--+--   1. Figure out which index the timestamp corresponds to, if there were infinitely many:+--+--        1053298012387 `div` 1000000000 = 1053+--+--   2. Wrap around per the actual length of the array:+--+--        1053 `rem` 3 = 0+timestampToIndex :: AlarmBuckets -> Nanoseconds -> Timestamp -> Int+timestampToIndex buckets resolution timestamp =+  -- This downcast is safe because there are at most `maxBound :: Int` buckets (not that anyone would ever have that+  -- many...)+  fromIntegral @Word64 @Int+    (Timestamp.epoch resolution timestamp `rem` fromIntegral @Int @Word64 (Array.sizeofMutableArray buckets))
src/TimerWheel/Internal/Bucket.hs view
@@ -69,13 +69,13 @@     --      a left-bound on the diffbit, that is, the true diffbit can be no left-er than `m`.     --   5. No key in `l` has the `m` bit set     --   6. All keys in `r` have the `m` bit set-    Bin {-# UNPACK #-} !TimerId {-# UNPACK #-} !Timestamp !a {-# UNPACK #-} !Mask !(Bucket a) !(Bucket a)-  | Tip {-# UNPACK #-} !TimerId {-# UNPACK #-} !Timestamp !a+    Bin {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a {-# UNPACK #-} !Mask !(Bucket a) !(Bucket a)+  | Tip {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a   | Nil  type Mask = Word64 -type TimerId = Int+type AlarmId = Int  -- | An empty bucket. empty :: Bucket a@@ -110,7 +110,7 @@ -- | Insert a new timer into a bucket. -- -- If a timer with the given id is already in the bucket, behavior is undefined.-insert :: forall a. TimerId -> Timestamp -> a -> Bucket a -> Bucket a+insert :: forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a insert i p x bucket =   case bucket of     Nil -> Tip i p x@@ -141,7 +141,7 @@     linki = link i p x  data Pop a-  = PopAlgo {-# UNPACK #-} !TimerId {-# UNPACK #-} !Timestamp !a !(Bucket a)+  = PopAlgo {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a !(Bucket a)   | PopNada  pop :: Bucket a -> Pop a@@ -152,7 +152,7 @@ {-# INLINE pop #-}  -- | Delete a timer from a bucket, expecting it to be there.-deleteExpectingHit :: TimerId -> Bucket v -> Maybe (Bucket v)+deleteExpectingHit :: AlarmId -> Bucket v -> Maybe (Bucket v) deleteExpectingHit i =   go   where@@ -170,12 +170,12 @@         | otherwise -> bin j p x m l <$> go r  -- | 'Bin' smart constructor, respecting the invariant that both children can't be 'Nil'.-bin :: TimerId -> Timestamp -> v -> Mask -> Bucket v -> Bucket v -> Bucket v+bin :: AlarmId -> Timestamp -> v -> Mask -> Bucket v -> Bucket v -> Bucket v bin i p x _ Nil Nil = Tip i p x bin i p x m l r = Bin i p x m l r {-# INLINE bin #-} -link :: TimerId -> Timestamp -> v -> TimerId -> Bucket v -> Bucket v -> Bucket v+link :: AlarmId -> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v link i p x j t u   | goleft j m = Bin i p x m t u   | otherwise = Bin i p x m u t@@ -272,7 +272,7 @@ -- Bit fiddling  -- | Is (or should) this timer be stored on the left of this bin, given its mask?-goleft :: TimerId -> Mask -> Bool+goleft :: AlarmId -> Mask -> Bool goleft i m =   i2w i .&. m == 0 {-# INLINE goleft #-}@@ -282,7 +282,7 @@ -- j = JJJJ??????????????????? -- -- prefixNotEqual m i j answers, is IIII not equal to JJJJ?-prefixNotEqual :: Mask -> TimerId -> TimerId -> Bool+prefixNotEqual :: Mask -> AlarmId -> AlarmId -> Bool prefixNotEqual (prefixMask -> e) i j =   i2w i .&. e /= i2w j .&. e {-# INLINE prefixNotEqual #-}@@ -297,7 +297,7 @@ onlyHighestBit w = unsafeShiftL 1 (WORD_SIZE_IN_BITS - 1 - countLeadingZeros w) {-# INLINE onlyHighestBit #-} -i2w :: TimerId -> Word64+i2w :: AlarmId -> Word64 i2w = fromIntegral {-# INLINE i2w #-}
src/TimerWheel/Internal/Prelude.hs view
@@ -1,16 +1,17 @@ module TimerWheel.Internal.Prelude   ( Seconds,-    module X,+    module Reexport,   ) where -import Control.Monad as X (when)-import Data.Coerce as X (coerce)+import Control.Monad as Reexport (when)+import Data.Coerce as Reexport (coerce) import Data.Fixed (E9, Fixed)-import Data.IORef as X (IORef, newIORef, readIORef, writeIORef)-import Data.Word as X (Word64)-import GHC.Generics as X (Generic)-import Prelude as X hiding (lookup, null)+import Data.Functor as Reexport (void)+import Data.IORef as Reexport (IORef, newIORef, readIORef, writeIORef)+import Data.Word as Reexport (Word64)+import GHC.Generics as Reexport (Generic)+import Prelude as Reexport hiding (lookup, null)  -- | A number of seconds, with nanosecond precision. --
+ src/TimerWheel/Internal/Timer.hs view
@@ -0,0 +1,29 @@+module TimerWheel.Internal.Timer+  ( Timer (..),+    cancel,+  )+where++import TimerWheel.Internal.Prelude++-- | A registered timer, parameterized by the result of attempting to cancel it:+--+--     * A one-shot timer may only be canceled if it has not already fired.+--     * A recurring timer can always be canceled.+--+-- __API summary__+--+-- +-------------+----------++-- | Create      | Modify   |+-- +=============+==========++-- | 'register'  | 'cancel' |+-- +-------------+----------++-- | 'recurring' |          |+-- +-------------+----------++newtype Timer a+  = Timer (IO a)++-- | Cancel a timer.+cancel :: Timer a -> IO a+cancel =+  coerce
test/Main.hs view
@@ -124,7 +124,7 @@ class Assert a b where   is :: a -> b -> IO () -instance (Eq e, Exception e) => Assert (IO void) (Exn e) where+instance (Eq e, Exception e) => Assert (IO v) (Exn e) where   is mx y = do     try (void mx) >>= \case       Left ex
timer-wheel.cabal view
@@ -1,24 +1,25 @@ cabal-version: 3.0 -author: Mitchell Rosen+author: Mitchell Dalvi Rosen bug-reports: https://github.com/awkward-squad/timer-wheel/issues build-type: Simple category: Data+copyright: (c) 2018-2024 Mitchell Dalvi Rosen, Travis Staton+homepage: https://github.com/awkward-squad/timer-wheel+license-file: LICENSE+license: BSD-3-Clause+maintainer: Mitchell Dalvi Rosen <mitchellwrosen@gmail.com>, Travis Staton <hello@travisstaton.com>+name: timer-wheel+synopsis: A timer wheel+tested-with: GHC == 9.6.5, GHC == 9.8.2, GHC == 9.10.1+version: 1.0.0.1+ description:   This library provides a timer wheel data structure for registering one-shot or recurring @IO@ actions to fire after a   given amount of time.   .   It is similar to @TimerManager@ from @GHC.Event@, but supports recurring actions, and can scale to handle many more   registered actions.-copyright: (c) 2018-2023 Mitchell Rosen, Travis Staton-homepage: https://github.com/awkward-squad/timer-wheel-license-file: LICENSE-license: BSD-3-Clause-maintainer: Mitchell Rosen <mitchellwrosen@gmail.com>, Travis Staton <hello@travisstaton.com>-name: timer-wheel-synopsis: A timer wheel-tested-with: GHC == 9.4.7, GHC == 9.6.3, GHC == 9.8.1-version: 1.0.0  extra-source-files:   CHANGELOG.md@@ -30,28 +31,19 @@  common component   build-depends:-    base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19,+    base ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19 || ^>= 4.20,   default-extensions:-    BangPatterns     BlockArguments     DeriveAnyClass-    DeriveGeneric     DerivingStrategies     DuplicateRecordFields-    FlexibleInstances-    GeneralizedNewtypeDeriving     LambdaCase-    MultiParamTypeClasses     MultiWayIf     NamedFieldPuns-    NoImplicitPrelude-    NumericUnderscores-    OverloadedStrings-    ScopedTypeVariables-    TupleSections-    TypeApplications+    NoFieldSelectors+    OverloadedRecordDot     ViewPatterns-  default-language: Haskell2010+  default-language: GHC2021   ghc-options:     -Weverything     -Wno-all-missed-specialisations@@ -83,10 +75,13 @@     TimerWheel   hs-source-dirs: src   other-modules:+    TimerWheel.Internal.Alarm+    TimerWheel.Internal.AlarmBuckets     TimerWheel.Internal.Bucket     TimerWheel.Internal.Counter     TimerWheel.Internal.Nanoseconds     TimerWheel.Internal.Prelude+    TimerWheel.Internal.Timer     TimerWheel.Internal.Timestamp  test-suite tests@@ -105,7 +100,7 @@   build-depends:     ki,     random ^>= 1.2,-    tasty-bench,+    tasty-bench ^>= 0.3.5,     timer-wheel,   ghc-options: -fproc-alignment=64 -rtsopts -threaded "-with-rtsopts=-N2 -T -A32m"   hs-source-dirs: bench