timer-wheel 0.2.0.1 → 0.3.0
raw patch · 16 files changed
+592/−705 lines, 16 filesdep −clockdep −randomdep ~basedep ~vector
Dependencies removed: clock, random
Dependency ranges changed: base, vector
Files
- .travis.yml +0/−142
- CHANGELOG.md +22/−3
- README.md +7/−0
- cabal.project +1/−0
- src/Data/TimerWheel.hs +205/−203
- src/Data/TimerWheel/Internal/Config.hs +19/−0
- src/Data/TimerWheel/Internal/Entries.hs +69/−0
- src/Data/TimerWheel/Internal/Micros.hs +46/−0
- src/Data/TimerWheel/Internal/Supply.hs +21/−0
- src/Data/TimerWheel/Internal/Timestamp.hs +42/−0
- src/Data/TimerWheel/Internal/Wheel.hs +85/−0
- src/Entries.hs +0/−71
- src/Supply.hs +0/−19
- src/Wheel.hs +0/−167
- test/Main.hs +50/−59
- timer-wheel.cabal +25/−41
− .travis.yml
@@ -1,142 +0,0 @@-# This Travis job script has been generated by a script via-#-# haskell-ci 'timer-wheel.cabal'-#-# For more information, see https://github.com/haskell-CI/haskell-ci-#-# version: 0.3.20190418-#-language: c-dist: xenial-git:- # whether to recursively clone submodules- submodules: false-cache:- directories:- - $HOME/.cabal/packages- - $HOME/.cabal/store-before_cache:- - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log- # remove files that are regenerated by 'cabal update'- - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*- - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar- - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx- - rm -rfv $CABALHOME/packages/head.hackage-matrix:- include:- - compiler: ghc-8.6.5- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}- - compiler: ghc-8.4.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}- - compiler: ghc-8.2.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}- - compiler: ghc-8.0.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}-before_install:- - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')- - HCPKG="$HC-pkg"- - unset CC- - CABAL=/opt/ghc/bin/cabal- - CABALHOME=$HOME/.cabal- - export PATH="$CABALHOME/bin:$PATH"- - TOP=$(pwd)- - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))- - echo $HCNUMVER- - CABAL="$CABAL -vnormal+nowrap+markoutput"- - set -o pipefail- - |- echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk- echo 'BEGIN { state = "output"; }' >> .colorful.awk- echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk- echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk- echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk- echo ' if (state == "cabal") {' >> .colorful.awk- echo ' print blue($0)' >> .colorful.awk- echo ' } else {' >> .colorful.awk- echo ' print $0' >> .colorful.awk- echo ' }' >> .colorful.awk- echo '}' >> .colorful.awk- - cat .colorful.awk- - |- color_cabal_output () {- awk -f $TOP/.colorful.awk- }- - echo text | color_cabal_output-install:- - ${CABAL} --version- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"- - TEST=--enable-tests- - BENCH=--enable-benchmarks- - GHCHEAD=${GHCHEAD-false}- - rm -f $CABALHOME/config- - |- echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config- echo "remote-build-reporting: anonymous" >> $CABALHOME/config- echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config- echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config- echo "world-file: $CABALHOME/world" >> $CABALHOME/config- echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config- echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config- echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config- echo "store-dir: $CABALHOME/store" >> $CABALHOME/config- echo "install-dirs user" >> $CABALHOME/config- echo " prefix: $CABALHOME" >> $CABALHOME/config- echo "repository hackage.haskell.org" >> $CABALHOME/config- echo " url: http://hackage.haskell.org/" >> $CABALHOME/config- - cat $CABALHOME/config- - rm -fv cabal.project cabal.project.local cabal.project.freeze- - travis_retry ${CABAL} v2-update -v- # Generate cabal.project- - rm -rf cabal.project cabal.project.local cabal.project.freeze- - touch cabal.project- - |- echo 'packages: "."' >> cabal.project- - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(timer-wheel)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"- - cat cabal.project || true- - cat cabal.project.local || true- - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi- - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output- - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"- - rm cabal.project.freeze- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output- - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output-script:- - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)- # Packaging...- - ${CABAL} v2-sdist all | color_cabal_output- # Unpacking...- - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/- - cd ${DISTDIR} || false- - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;- # Generate cabal.project- - rm -rf cabal.project cabal.project.local cabal.project.freeze- - touch cabal.project- - |- echo 'packages: "timer-wheel-*/*.cabal"' >> cabal.project- - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(timer-wheel)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"- - cat cabal.project || true- - cat cabal.project.local || true- # Building...- # this builds all libraries and executables (without tests/benchmarks)- - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output- # Building with tests and benchmarks...- # build & run tests, build benchmarks- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output- # Testing...- - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output- # cabal check...- - (cd timer-wheel-* && ${CABAL} -vnormal check)- # haddock...- - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output- # Building without installed constraints for packages in global-db...- - rm -f cabal.project.local- - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output--# REGENDATA ["timer-wheel.cabal"]-# EOF
CHANGELOG.md view
@@ -5,16 +5,35 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.3.0] - 2020-06-18++### Added+- Add `with`+- Add support for GHC 8.8, GHC 8.10++### Changed+- Change type of `spokes` from `Natural` to `Int`+- Change order of delay and action arguments in `register`, `register_`, `recurring`, and `recurring_`+- Simplify `cancel` to return `True` at most once+- Throw an error if a negative delay is provided to `register`, `register_`, `recurring`, or `recurring_`+- Fix underflow bug that affected recurring timers++### Removed+- Remove `create`, `destroy`+- Remove `TimerWheelDied` exception. `with` now simply re-throws the exception that the timer wheel thread throws+- Remove `InvalidTimerWheelConfig` exception. `error` is used instead+- Remove support for GHC < 8.6+ ## [0.2.0.1] - 2019-05-19 ### Changed-- Swapped out `ghc-prim` and `primitive` for `vector`+- Swap out `ghc-prim` and `primitive` for `vector` ## [0.2.0] - 2019-02-03 ### Added-- `destroy` function, for reaping the background thread-- `recurring_` function+- Add `destroy` function, for reaping the background thread+- Add `recurring_` function ### Changed - If the timer wheel reaper thread crashes, it will propagate the exception to
+ README.md view
@@ -0,0 +1,7 @@+# `timer-wheel`++[](https://github.com/mitchellwrosen/timer-wheel/actions)+[](https://hackage.haskell.org/package/timer-wheel)+[](https://www.stackage.org/lts/package/timer-wheel)+[](https://www.stackage.org/nightly/package/timer-wheel)+[](https://packdeps.haskellers.com/reverse/timer-wheel)
+ cabal.project view
@@ -0,0 +1,1 @@+packages: .
src/Data/TimerWheel.hs view
@@ -1,261 +1,263 @@+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -funbox-strict-fields #-} +-- | A simple, hashed timer wheel. module Data.TimerWheel ( -- * Timer wheel- TimerWheel- , create- , destroy- , Config(..)- , register- , register_- , recurring- , recurring_- , InvalidTimerWheelConfig(..)- , TimerWheelDied(..)- ) where--import Supply (Supply)-import Wheel (Wheel)--import qualified Supply-import qualified Wheel+ TimerWheel,+ with,+ Config (..),+ register,+ register_,+ recurring,+ recurring_,+ )+where -import Control.Concurrent (ThreadId, forkIOWithUnmask, killThread, myThreadId,- throwTo)-import Control.Exception (AsyncException(ThreadKilled),- Exception(fromException, toException), SomeException,- asyncExceptionFromException,- asyncExceptionToException, catch, throwIO)-import Control.Monad (join, void, when)-import Data.Coerce (coerce)-import Data.Fixed (E6, Fixed(MkFixed))-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Word (Word64)-import GHC.Generics (Generic)-import Numeric.Natural (Natural)+import Control.Concurrent+import Control.Exception+import Control.Monad (join, void)+import Data.Bool (bool)+import Data.Fixed (E6, Fixed)+import Data.Function (fix)+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.TimerWheel.Internal.Config (Config)+import qualified Data.TimerWheel.Internal.Config as Config+import Data.TimerWheel.Internal.Micros (Micros (Micros))+import qualified Data.TimerWheel.Internal.Micros as Micros+import Data.TimerWheel.Internal.Supply (Supply)+import qualified Data.TimerWheel.Internal.Supply as Supply+import Data.TimerWheel.Internal.Wheel (Wheel)+import qualified Data.TimerWheel.Internal.Wheel as Wheel --- | A 'TimerWheel' is a vector-of-collections-of timers to fire. It is--- configured with a /spoke count/ and /resolution/. Timers may be scheduled--- arbitrarily far in the future. A timeout thread is spawned to step through--- the timer wheel and fire expired timers at regular intervals.+-- | A timer wheel is a vector-of-collections-of timers to fire. It is configured with a /spoke count/ and /resolution/.+-- Timers may be scheduled arbitrarily far in the future. A timeout thread is spawned to step through the timer wheel+-- and fire expired timers at regular intervals. -- -- * The /spoke count/ determines the size of the timer vector. ----- * A __larger spoke count__ will result in __less insert contention__ at--- each spoke and will require __more memory__ to store the timer wheel.+-- * A __larger spoke count__ will result in __less insert contention__ at each spoke and will require+-- __more memory__ to store the timer wheel. ----- * A __smaller spoke count__ will result in __more insert contention__ at--- each spoke and will require __less memory__ to store the timer wheel.+-- * A __smaller spoke count__ will result in __more insert contention__ at each spoke and will require+-- __less memory__ to store the timer wheel. ----- * The /resolution/ determines both the duration of time that each spoke--- corresponds to, and how often the timeout thread wakes. For example, with a--- resolution of __@1s@__, a timer that expires at __@2.5s@__ will not fire--- until the timeout thread wakes at __@3s@__.+-- * The /resolution/ determines both the duration of time that each spoke corresponds to, and how often the timeout+-- thread wakes. For example, with a resolution of __@1s@__, a timer that expires at __@2.5s@__ will not fire until+-- the timeout thread wakes at __@3s@__. ----- * A __larger resolution__ will result in __more insert contention__ at--- each spoke, __less accurate__ timers, and will require--- __fewer wakeups__ by the timeout thread.+-- * A __larger resolution__ will result in __more insert contention__ at each spoke, __less accurate__ timers, and+-- will require __fewer wakeups__ by the timeout thread. ----- * A __smaller resolution__ will result in __less insert contention__ at--- each spoke, __more accurate__ timers, and will require __more wakeups__--- by the timeout thread.+-- * A __smaller resolution__ will result in __less insert contention__ at each spoke, __more accurate__ timers, and+-- will require __more 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, 'register' them directly. Otherwise,--- consider registering an action that enqueues the /real/ action to be--- performed on a job queue.+-- * There is only one, and it fires expired timers synchronously. If your timer actions execute quicky, 'register'+-- them directly. Otherwise, consider registering an action that enqueues the /real/ action to be performed on a+-- job queue. ----- * Synchronous exceptions thrown by enqueued @IO@ actions will bring the--- thread down, which will cause it to asynchronously throw a--- 'TimerWheelDied' exception to the thread that 'create'd it. If you want--- to catch exceptions and log them, for example, you will have to bake--- this into the registered actions yourself.+-- * Synchronous exceptions thrown by enqueued @IO@ actions will bring the thread down, and the exception will be+-- propagated to the thread that created the timer wheel. If you want to catch exceptions and log them, for+-- example, you will have to bake this into the registered actions yourself. ----- Below is a depiction of a timer wheel with @6@ timers inserted across @8@--- spokes, and a resolution of @0.1s@.+-- As an example, below is a depiction of a timer wheel with @6@ timers inserted across @8@ spokes, and a resolution of+-- @.1s@. It depicts a cursor at @.3s@, which indicates where the timeout thread currently is. -- -- @--- 0s .1s .2s .3s .4s .5s .6s .7s .8s--- +-----+-----+-----+-----+-----+-----+-----+-----+--- | | A | | B,C | D | | | E,F |--- +-----+-----+-----+-----+-----+-----+-----+-----++-- 0 .1 .2 .3 .4 .5 .6 .7+-- ┌───────┬───────┬───────┬───────┬───────┬───────┬───────┬───────┐+-- │ │ A⁰ │ │ B¹ C⁰ │ D⁰ │ │ │ E² F⁰ │+-- └───────┴───────┴───────┴───────┴───────┴───────┴───────┴───────┘+-- ↑ -- @-data TimerWheel = TimerWheel- { wheelSupply :: !Supply- -- ^ A supply of unique ints.- , wheelWheel :: !Wheel- -- ^ The array of collections of timers.- , wheelThread :: !ThreadId+--+-- After @.1s@, the timeout thread will advance to the next spoke and process all of the timers it passed over. In+-- this case, __C__ will fire, and __B__ will be put back with its count decremented to @0@. This is how the timer wheel+-- can schedule a timer to fire arbitrarily far in the future: its count is simply the number of times its delay wraps+-- the entire duration of the timer wheel.+--+-- @+-- 0 .1 .2 .3 .4 .5 .6 .7+-- ┌───────┬───────┬───────┬───────┬───────┬───────┬───────┬───────┐+-- │ │ A⁰ │ │ B⁰ │ D⁰ │ │ │ E² F⁰ │+-- └───────┴───────┴───────┴───────┴───────┴───────┴───────┴───────┘+-- ↑+-- @+data TimerWheel = TimerWheel+ { -- | A supply of unique ints.+ supply :: Supply,+ -- | The array of collections of timers.+ wheel :: Wheel,+ thread :: ThreadId } -data Config- = Config- { spokes :: !Natural -- ^ Spoke count.- , resolution :: !(Fixed E6) -- ^ Resolution, in seconds.- } deriving (Generic, Show)- -- | The timeout thread died. newtype TimerWheelDied = TimerWheelDied SomeException- deriving (Show)+ deriving stock (Show) instance Exception TimerWheelDied where toException = asyncExceptionToException fromException = asyncExceptionFromException --- | The timer wheel config was invalid.------ * @spokes@ must be positive, and less than @maxBound@ of @Int@.--- * @resolution@ must be positive.-data InvalidTimerWheelConfig- = InvalidTimerWheelConfig !Config- deriving (Show)--instance Exception InvalidTimerWheelConfig---- | Create a timer wheel.+-- | Perform an action with a timer wheel. ----- /Throws./ If the config is invalid, throws 'InvalidTimerWheelConfig'.+-- /Throws./ ----- /Throws./ If the timeout thread dies, asynchronously throws 'TimerWheelDied'--- to the thread that called 'create'.-create :: Config -> IO TimerWheel-create config@(Config { spokes, resolution }) = do- when (invalidConfig config)- (throwIO (InvalidTimerWheelConfig config))-- wheel :: Wheel <-- Wheel.create- (fromIntegral spokes)- (fromIntegral (coerce resolution :: Integer))-- supply :: Supply <-- Supply.new-- thread <- myThreadId+-- * Calls 'error' if the config is invalid+-- * Throws the exception the given action throws, if any+-- * Throws the exception the timer wheel thread throws, if any+with :: Config -> (TimerWheel -> IO a) -> IO a+with config action =+ case validateConfig config of+ () -> _with config action - reaperThread <-- forkIOWithUnmask $ \unmask ->- unmask (Wheel.reap wheel)- `catch` \e ->+_with :: Config -> (TimerWheel -> IO a) -> IO a+_with config action = do+ wheel <- Wheel.create (Config.spokes config) (Micros.fromFixed (Config.resolution config))+ supply <- Supply.new+ parentThread <- myThreadId+ uninterruptibleMask \restore -> do+ thread <-+ forkIOWithUnmask $ \unmask ->+ unmask (Wheel.reap wheel) `catch` \e -> case fromException e of Just ThreadKilled -> pure ()- _ -> throwTo thread (TimerWheelDied e)-- pure TimerWheel- { wheelSupply = supply- , wheelWheel = wheel- , wheelThread = reaperThread- }---- | Tear down a timer wheel by killing the timeout thread.-destroy :: TimerWheel -> IO ()-destroy wheel =- killThread (wheelThread wheel)+ _ -> throwTo parentThread (TimerWheelDied e)+ let cleanup = killThread thread+ let handler :: SomeException -> IO void+ handler ex = do+ cleanup+ case fromException ex of+ Just (TimerWheelDied ex') -> throwIO ex'+ _ -> throwIO ex+ result <- restore (action TimerWheel {supply, wheel, thread}) `catch` handler+ cleanup+ pure result -invalidConfig :: Config -> Bool-invalidConfig Config { spokes, resolution } =- or- [ spokes == 0- , spokes > fromIntegral (maxBound :: Int)- , resolution <= 0- ]+validateConfig :: Config -> ()+validateConfig config+ | invalid = error ("[timer-wheel] invalid config: " ++ show config)+ | otherwise = ()+ where+ invalid :: Bool+ invalid =+ Config.spokes config <= 0 || Config.resolution config <= 0 --- | @register wheel action delay@ registers an action __@action@__ in timer--- wheel __@wheel@__ to fire after __@delay@__ seconds.+-- | @register wheel delay action@ registers an action __@action@__ in timer wheel __@wheel@__ to fire after __@delay@__+-- seconds. ----- Returns an action that, when called, attempts to cancel the timer, and--- returns whether or not it was successful (@False@ means the timer has already--- fired).+-- Returns an action that, when called, attempts to cancel the timer, and returns whether or not it was successful+-- (@False@ means the timer has already fired, or was already cancelled). ----- Subsequent calls to the cancel action have no effect, and continue to return--- whatever the first result was.+-- /Throws/.+--+-- * Calls 'error' if the given number of seconds is negative. register ::- TimerWheel -- ^- -> IO () -- ^ Action- -> Fixed E6 -- ^ Delay, in seconds- -> IO (IO Bool)-register wheel action (MkFixed (fromIntegral -> delay)) =- _register wheel action delay+ -- |+ TimerWheel ->+ -- | Delay, in seconds+ Fixed E6 ->+ -- | Action+ IO () ->+ IO (IO Bool)+register wheel (Micros.fromSeconds -> delay) =+ _register wheel delay -- | Like 'register', but for when you don't intend to cancel the timer.+--+-- /Throws/.+--+-- * Calls 'error' if the given number of seconds is negative. register_ ::- TimerWheel -- ^- -> IO () -- ^ Action- -> Fixed E6 -- ^ Delay, in seconds- -> IO ()-register_ wheel action delay =- void (register wheel action delay)--_register :: TimerWheel -> IO () -> Word64 -> IO (IO Bool)-_register wheel action delay = do- key <- Supply.next (wheelSupply wheel)- Wheel.insert (wheelWheel wheel) key action delay+ -- |+ TimerWheel ->+ -- | Delay, in seconds+ Fixed E6 ->+ -- | Action+ IO () ->+ IO ()+register_ wheel delay action =+ void (register wheel delay action) -_register_ :: TimerWheel -> IO () -> Word64 -> IO ()-_register_ wheel action delay =- void (_register wheel action delay)+_register :: TimerWheel -> Micros -> IO () -> IO (IO Bool)+_register TimerWheel {supply, wheel} delay action = do+ key <- Supply.next supply+ Wheel.insert wheel key delay action --- | @recurring wheel action delay@ registers an action __@action@__ in timer--- wheel __@wheel@__ to fire every __@delay@__ seconds.+-- | @recurring wheel action delay@ registers an action __@action@__ in timer wheel __@wheel@__ to fire every+-- __@delay@__ seconds (or every /resolution/ seconds, whichever is smaller). -- -- Returns an action that, when called, cancels the recurring timer.+--+-- /Throws/.+--+-- * Calls 'error' if the given number of seconds is negative. recurring ::- TimerWheel- -> IO () -- ^ Action- -> Fixed E6 -- ^ Delay, in seconds- -> IO (IO ())-recurring wheel action (MkFixed (fromIntegral -> delay)) = mdo- let- doAction :: IO ()- doAction = do- -- Re-register one bucket early, to account for the fact that timers are- -- expired at the *end* of a bucket.- --- -- +---+---+---+---+- -- { A | | | }- -- +---+---+---+---+- -- |- -- The reaper thread fires 'A' approximately here, so if it's meant- -- to be repeated every two buckets, and we just re-register it at- -- this time, three buckets will pass before it's run again. So, we- -- act as if it's still "one bucket ago" at the moment we re-register- -- it.- writeIORef cancelRef =<<- _register- wheel- doAction- (delay - Wheel.resolution (wheelWheel wheel))- action-- cancel :: IO Bool <-- _register wheel doAction delay-- cancelRef :: IORef (IO Bool) <-- newIORef cancel-+ TimerWheel ->+ -- | Delay, in seconds+ Fixed E6 ->+ -- | Action+ IO () ->+ IO (IO ())+recurring wheel (Micros.fromSeconds -> delay) action = mdo+ let doAction :: IO ()+ doAction = do+ writeIORef cancelRef =<< _reregister wheel delay doAction+ action+ cancel <- _register wheel delay doAction+ cancelRef <- newIORef cancel pure (untilTrue (join (readIORef cancelRef)))+ where+ -- Repeat an IO action until it returns 'True'.+ untilTrue :: IO Bool -> IO ()+ untilTrue m =+ fix \again ->+ m >>= bool again (pure ()) -- | Like 'recurring', but for when you don't intend to cancel the timer.+--+-- /Throws/.+--+-- * Calls 'error' if the given number of seconds is negative. recurring_ ::- TimerWheel- -> IO () -- ^ Action- -> Fixed E6 -- ^ Delay, in seconds- -> IO ()-recurring_ wheel action (MkFixed (fromIntegral -> delay)) =- _register_ wheel doAction delay-+ TimerWheel ->+ -- | Delay, in seconds+ Fixed E6 ->+ -- | Action+ IO () ->+ IO ()+recurring_ wheel (Micros.fromSeconds -> delay) action =+ void (_register wheel delay doAction) where doAction :: IO () doAction = do- _register_ wheel doAction (delay - Wheel.resolution (wheelWheel wheel))+ _ <- _reregister wheel delay doAction action --- Repeat an IO action until it returns 'True'.-untilTrue :: IO Bool -> IO ()-untilTrue action =- action >>= \case- True -> pure ()- False -> untilTrue action+-- Re-register one bucket early, to account for the fact that timers are+-- expired at the *end* of a bucket.+--+-- +---+---+---+---++-- { A | | | }+-- +---+---+---+---++-- |+-- The reaper thread fires 'A' approximately here, so if it's meant+-- to be repeated every two buckets, and we just re-register it at+-- this time, three buckets will pass before it's run again. So, we+-- act as if it's still "one bucket ago" at the moment we re-register+-- it.+_reregister :: TimerWheel -> Micros -> IO () -> IO (IO Bool)+_reregister wheel delay =+ _register wheel (if reso > delay then Micros 0 else delay `Micros.minus` reso)+ where+ reso :: Micros+ reso =+ resolution wheel++resolution :: TimerWheel -> Micros+resolution =+ Wheel.resolution . wheel
+ src/Data/TimerWheel/Internal/Config.hs view
@@ -0,0 +1,19 @@+module Data.TimerWheel.Internal.Config+ ( Config (..),+ )+where++import Data.Fixed (E6, Fixed)+import GHC.Generics (Generic)++-- | Timer wheel config.+--+-- * @spokes@ must be ∈ @(0, maxBound]@+-- * @resolution@ must ∈ @(0, ∞]@+data Config = Config+ { -- | Spoke count.+ spokes :: Int,+ -- | Resolution, in seconds.+ resolution :: Fixed E6+ }+ deriving stock (Generic, Show)
+ src/Data/TimerWheel/Internal/Entries.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeApplications #-}++module Data.TimerWheel.Internal.Entries+ ( Entries,+ empty,+ Data.TimerWheel.Internal.Entries.null,+ size,+ insert,+ delete,+ partition,+ )+where++import Data.Coerce+import Data.IntPSQ (IntPSQ)+import qualified Data.IntPSQ as IntPSQ+import Data.Word (Word64)++newtype Entries+ = Entries (IntPSQ Word64 (IO ()))++-- | An empty collection.+empty :: Entries+empty =+ Entries IntPSQ.empty+{-# INLINEABLE empty #-}++null :: Entries -> Bool+null =+ coerce (IntPSQ.null @Word64 @(IO ()))+{-# INLINEABLE null #-}++-- | The number of timers in the collection.+size :: Entries -> Int+size =+ coerce (IntPSQ.size @Word64 @(IO ()))+{-# INLINEABLE size #-}++-- | @insert i n m x@ inserts callback @m@ into collection @x@ with unique+-- identifier @i@ and "count" @n@. The+insert :: Int -> Word64 -> IO () -> Entries -> Entries+insert i n m =+ coerce (IntPSQ.unsafeInsertNew i n m)+{-# INLINEABLE insert #-}++-- | Delete a timer by id. Returns 'Nothing' if the timer was not found.+delete :: Int -> Entries -> Maybe Entries+delete =+ coerce delete_+{-# INLINEABLE delete #-}++delete_ :: Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ()))+delete_ i xs =+ (\(_, _, ys) -> ys) <$> IntPSQ.deleteView i xs++-- | Extract expired timers.+partition :: Entries -> ([IO ()], Entries)+partition (Entries entries) =+ case IntPSQ.atMostView 0 entries of+ (expired, alive) ->+ (map f expired, Entries (IntPSQ.unsafeMapMonotonic g alive))+ where+ f :: (Int, Word64, IO ()) -> IO ()+ f (_, _, m) =+ m+ g :: Int -> Word64 -> IO () -> (Word64, IO ())+ g _ n m =+ (n -1, m)+{-# INLINEABLE partition #-}
+ src/Data/TimerWheel/Internal/Micros.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TypeApplications #-}++module Data.TimerWheel.Internal.Micros+ ( Micros (..),+ fromFixed,+ fromSeconds,+ Data.TimerWheel.Internal.Micros.div,+ minus,+ scale,+ sleep,+ )+where++import Control.Concurrent (threadDelay)+import Data.Coerce+import Data.Fixed+import Data.Word++newtype Micros = Micros {unMicros :: Word64}+ deriving stock (Eq, Ord)++-- | Precondition: input is >= 0+fromFixed :: Fixed E6 -> Micros+fromFixed =+ coerce @(Integer -> Word64) fromIntegral++fromSeconds :: Fixed E6 -> Micros+fromSeconds seconds@(MkFixed micros)+ | micros < 0 = error ("[timer-wheel] invalid seconds: " ++ show seconds)+ | otherwise = Micros (fromIntegral micros)++div :: Micros -> Micros -> Micros+div =+ coerce (Prelude.div @Word64)++minus :: Micros -> Micros -> Micros+minus =+ coerce ((-) @Word64)++scale :: Int -> Micros -> Micros+scale n (Micros w) =+ Micros (fromIntegral n * w)++sleep :: Micros -> IO ()+sleep (Micros micros) =+ threadDelay (fromIntegral micros)
+ src/Data/TimerWheel/Internal/Supply.hs view
@@ -0,0 +1,21 @@+module Data.TimerWheel.Internal.Supply+ ( Supply,+ new,+ next,+ )+where++import Data.Atomics.Counter (AtomicCounter, incrCounter, newCounter)+import Data.Coerce (coerce)++newtype Supply+ = Supply AtomicCounter++new :: IO Supply+new =+ coerce (newCounter 0)++next :: Supply -> IO Int+next =+ coerce (incrCounter 1)+{-# INLINE next #-}
+ src/Data/TimerWheel/Internal/Timestamp.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TypeApplications #-}++module Data.TimerWheel.Internal.Timestamp+ ( Timestamp (..),+ epoch,+ minus,+ now,+ plus,+ Data.TimerWheel.Internal.Timestamp.rem,+ )+where++import Data.Coerce (coerce)+import Data.TimerWheel.Internal.Micros (Micros (..))+import Data.Word (Word64)+import GHC.Clock (getMonotonicTimeNSec)++newtype Timestamp+ = Timestamp Word64+ deriving stock (Eq, Ord)++-- Which epoch does this correspond to, if they are measured in chunks of the given number of milliseconds?+epoch :: Micros -> Timestamp -> Word64+epoch (Micros chunk) (Timestamp timestamp) =+ timestamp `div` chunk++minus :: Timestamp -> Timestamp -> Micros+minus =+ coerce ((-) @Word64)++now :: IO Timestamp+now = do+ nanos <- getMonotonicTimeNSec+ pure (Timestamp (nanos `div` 1000))++plus :: Timestamp -> Micros -> Timestamp+plus =+ coerce ((+) @Word64)++rem :: Timestamp -> Micros -> Micros+rem =+ coerce (Prelude.rem @Word64)
+ src/Data/TimerWheel/Internal/Wheel.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE StrictData #-}++module Data.TimerWheel.Internal.Wheel+ ( Wheel (resolution),+ create,+ lenMicros,+ insert,+ reap,+ )+where++import Control.Monad (join, when)+import Data.IORef+import Data.TimerWheel.Internal.Entries (Entries)+import qualified Data.TimerWheel.Internal.Entries as Entries+import Data.TimerWheel.Internal.Micros (Micros (..))+import qualified Data.TimerWheel.Internal.Micros as Micros+import Data.TimerWheel.Internal.Timestamp (Timestamp)+import qualified Data.TimerWheel.Internal.Timestamp as Timestamp+import Data.Vector (Vector)+import qualified Data.Vector as Vector++data Wheel = Wheel+ { buckets :: Vector (IORef Entries),+ resolution :: Micros+ }++create :: Int -> Micros -> IO Wheel+create spokes resolution = do+ buckets <- Vector.replicateM spokes (newIORef Entries.empty)+ pure Wheel {buckets, resolution}++numSpokes :: Wheel -> Int+numSpokes wheel =+ Vector.length (buckets wheel)++lenMicros :: Wheel -> Micros+lenMicros wheel =+ Micros.scale (numSpokes wheel) (resolution wheel)++bucket :: Wheel -> Timestamp -> IORef Entries+bucket wheel timestamp =+ Vector.unsafeIndex (buckets wheel) (index wheel timestamp)++index :: Wheel -> Timestamp -> Int+index wheel@Wheel {resolution} timestamp =+ fromIntegral (Timestamp.epoch resolution timestamp) `rem` numSpokes wheel++insert :: Wheel -> Int -> Micros -> IO () -> IO (IO Bool)+insert wheel key delay action = do+ bucketRef <- do+ now <- Timestamp.now+ pure (bucket wheel (now `Timestamp.plus` delay))++ atomicModifyIORef' bucketRef (\entries -> (insertEntry entries, ()))++ pure do+ atomicModifyIORef' bucketRef \entries ->+ case Entries.delete key entries of+ Nothing -> (entries, False)+ Just entries' -> (entries', True)+ where+ insertEntry :: Entries -> Entries+ insertEntry =+ Entries.insert key (unMicros (delay `Micros.div` lenMicros wheel)) action++reap :: Wheel -> IO ()+reap wheel@Wheel {buckets, resolution} = do+ now <- Timestamp.now+ let remainingBucketMicros = resolution `Micros.minus` (now `Timestamp.rem` resolution)+ Micros.sleep remainingBucketMicros+ loop (now `Timestamp.plus` remainingBucketMicros `Timestamp.plus` resolution) (index wheel now)+ where+ loop :: Timestamp -> Int -> IO ()+ loop nextTime i = do+ join (atomicModifyIORef' (Vector.unsafeIndex buckets i) expire)+ afterTime <- Timestamp.now+ when (afterTime < nextTime) (Micros.sleep (nextTime `Timestamp.minus` afterTime))+ loop (nextTime `Timestamp.plus` resolution) ((i + 1) `rem` numSpokes wheel)+ expire :: Entries -> (Entries, IO ())+ expire entries+ | Entries.null entries = (entries, pure ())+ | otherwise = (alive, sequence_ expired)+ where+ (expired, alive) = Entries.partition entries
− src/Entries.hs
@@ -1,71 +0,0 @@-{-# language LambdaCase #-}-{-# language TypeApplications #-}--module Entries- ( Entries- , empty- , Entries.null- , size- , insert- , delete- , partition- ) where--import Data.Coerce-import Data.IntPSQ (IntPSQ)-import Data.Word (Word64)--import qualified Data.IntPSQ as IntPSQ--newtype Entries- = Entries (IntPSQ Word64 (IO ()))---- | An empty collection.-empty :: Entries-empty =- Entries IntPSQ.empty-{-# INLINABLE empty #-}--null :: Entries -> Bool-null =- coerce (IntPSQ.null @Word64 @(IO ()))-{-# INLINABLE null #-}---- | The number of timers in the collection.-size :: Entries -> Int-size =- coerce (IntPSQ.size @Word64 @(IO ()))-{-# INLINABLE size #-}---- | @insert i n m x@ inserts callback @m@ into collection @x@ with unique--- identifier @i@ and "count" @n@. The-insert :: Int -> Word64 -> IO () -> Entries -> Entries-insert i n m =- coerce (IntPSQ.unsafeInsertNew i n m)-{-# INLINABLE insert #-}---- | Delete a timer by id. Returns 'Nothing' if the timer was not found.-delete :: Int -> Entries -> Maybe Entries-delete =- coerce delete_-{-# INLINABLE delete #-}--delete_ :: Int -> IntPSQ Word64 (IO ()) -> Maybe (IntPSQ Word64 (IO ()))-delete_ i xs =- (\(_, _, ys) -> ys) <$> IntPSQ.deleteView i xs---- | Extract expired timers.-partition :: Entries -> ([IO ()], Entries)-partition (Entries entries) =- case IntPSQ.atMostView 0 entries of- (expired, alive) ->- (map f expired, Entries (IntPSQ.unsafeMapMonotonic g alive))- where- f :: (Int, Word64, IO ()) -> IO ()- f (_, _, m) =- m-- g :: Int -> Word64 -> IO () -> (Word64, IO ())- g _ n m =- (n-1, m)-{-# INLINABLE partition #-}
− src/Supply.hs
@@ -1,19 +0,0 @@-module Supply- ( Supply- , new- , next- ) where--import Data.Atomics.Counter (AtomicCounter, incrCounter, newCounter)--newtype Supply- = Supply AtomicCounter--new :: IO Supply-new =- Supply <$> newCounter 0--next :: Supply -> IO Int-next (Supply counter) =- incrCounter 1 counter-{-# INLINE next #-}
− src/Wheel.hs
@@ -1,167 +0,0 @@-{-# LANGUAGE CPP #-}--module Wheel- ( Wheel(resolution)- , create- , lenMicros- , insert- , reap- ) where--import Entries (Entries)--import qualified Entries as Entries--import Control.Concurrent (threadDelay)-import Control.Concurrent.MVar-import Control.Monad (join, when)-import Data.IORef-import Data.Vector (Vector)-import Data.Word (Word64)-import System.IO.Unsafe (unsafeInterleaveIO)--#if MIN_VERSION_base(4,11,0)-import GHC.Clock (getMonotonicTimeNSec)-#else-import System.Clock (Clock(Monotonic), getTime, toNanoSecs)-#endif--import qualified Data.Vector as Vector----data Wheel- = Wheel- { buckets :: !(Vector (IORef Entries))- , resolution :: !Word64 -- micros- }--create ::- Int- -> Word64- -> IO Wheel-create spokes resolution = do- buckets :: Vector (IORef Entries) <-- Vector.replicateM spokes (newIORef Entries.empty)-- pure Wheel- { buckets = buckets- , resolution = resolution- }--numSpokes :: Wheel -> Int-numSpokes wheel =- Vector.length (buckets wheel)--lenMicros :: Wheel -> Word64-lenMicros wheel =- fromIntegral (numSpokes wheel) * resolution wheel--bucket :: Wheel -> Word64 -> IORef Entries-bucket wheel time =- Vector.unsafeIndex- (buckets wheel)- (index wheel time)--index :: Wheel -> Word64 -> Int-index wheel@Wheel{resolution} time =- fromIntegral (time `div` resolution) `rem` numSpokes wheel--insert ::- Wheel- -> Int- -> IO ()- -> Word64- -> IO (IO Bool)-insert wheel key action delay = do- now :: Word64 <-- getMonotonicMicros-- let- time :: Word64- time =- now + delay-- let- count :: Word64- count =- delay `div` lenMicros wheel-- let- bucketRef :: IORef Entries- bucketRef =- bucket wheel time-- atomicModifyIORef' bucketRef- (\entries ->- (Entries.insert key count action entries, ()))-- canceledVar :: MVar (Maybe Bool) <-- unsafeInterleaveIO (newMVar Nothing)-- pure $ do- modifyMVar canceledVar $ \result -> do- canceled <-- maybe- (atomicModifyIORef' bucketRef- (\entries ->- maybe- (entries, False)- (, True)- (Entries.delete key entries)))- pure- result- pure (Just canceled, canceled)---reap :: Wheel -> IO ()-reap wheel@Wheel{buckets, resolution} = do- now :: Word64 <-- getMonotonicMicros-- let- -- How far in time are we into the very first bucket? Sleep until it's over.- elapsedBucketMicros :: Word64- elapsedBucketMicros =- now `rem` resolution-- let- remainingBucketMicros :: Word64- remainingBucketMicros =- resolution - elapsedBucketMicros-- threadDelay (fromIntegral remainingBucketMicros)-- loop- (now + remainingBucketMicros + resolution)- (index wheel now)-- where- loop :: Word64 -> Int -> IO ()- loop nextTime i = do- join- (atomicModifyIORef' (Vector.unsafeIndex buckets i)- (\entries ->- if Entries.null entries- then- (entries, pure ())- else- case Entries.partition entries of- (expired, alive) ->- (alive, sequence_ expired)))-- afterTime :: Word64 <-- getMonotonicMicros-- when (afterTime < nextTime) $- (threadDelay (fromIntegral (nextTime - afterTime)))-- loop (nextTime + resolution) ((i+1) `rem` numSpokes wheel)--getMonotonicMicros :: IO Word64-getMonotonicMicros =-#if MIN_VERSION_base(4,11,0)- (`div` 1000) <$> getMonotonicTimeNSec-#else- ((`div` 1000) . fromIntegral . toNanoSecs <$> getTime Monotonic)-#endif
test/Main.hs view
@@ -1,83 +1,77 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE BlockArguments, DeriveAnyClass, DerivingStrategies, FlexibleInstances, MultiParamTypeClasses #-} import Control.Concurrent import Control.Exception import Control.Monad-import Data.Fixed (E6, Fixed(..)) import Data.IORef+import Data.Maybe (isJust) import Data.TimerWheel-import System.Random+import System.Mem (performGC)+import System.Mem.Weak (deRefWeak) main :: IO () main = do do putStrLn "Timer wheel runs scheduled actions"- let n = 10000- ref <- newIORef (0::Int)- wheel <- create Config { spokes = 4, resolution = 0.25 }- putStrLn ("> Inserting " ++ show n ++ " timers")- replicateM_ n $ do- delay <- randomRIO (0, 4*1000*1000)- register_ wheel (modifyIORef' ref (+1)) (MkFixed delay)- putStrLn "> Sleeping for 5s"- sleep 5- readIORef ref `is` n- destroy wheel+ with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ var <- newEmptyMVar+ let n = 1000+ replicateM_ n (register_ wheel 0 (putMVar var ()))+ replicateM_ n (takeMVar var) do putStrLn "Timers can be canceled"- let n = 10000- ref <- newIORef (0::Int)- wheel <- create Config { spokes = 4, resolution = 0.25 }- putStrLn ("> Inserting " ++ show n ++ " timers")- cancels <-- replicateM n $ do- delay <- randomRIO (0, 4*1000*1000)- register wheel (modifyIORef' ref (+1)) (MkFixed delay)- putStrLn "> Sleeping for 2s"- sleep 2- putStrLn "> Canceling all timers"- successes <- sequence cancels- readIORef ref `is` (n - length (filter id successes))- destroy wheel+ var <- newEmptyMVar+ with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ let n = 1000+ cancels <- replicateM n (register wheel 0 (putMVar var ()))+ successes <- sequence (take (n `div` 2) cancels)+ replicateM_ (n - length (filter id successes)) (takeMVar var) do- putStrLn "Re-calling a successful cancel works"- wheel <- create Config { spokes = 4, resolution = 0.25 }- cancel <- register wheel (pure ()) 1- cancel `is` True- cancel `is` True- destroy wheel+ putStrLn "Successful `cancel` returns True (then False)"+ with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ cancel <- register wheel 1 (pure ())+ cancel `is` True+ cancel `is` False do- putStrLn "Re-calling a failed cancel works"- wheel <- create Config { spokes = 4, resolution = 0.25 }- cancel <- register wheel (pure ()) 0.5- sleep 1- cancel `is` False- cancel `is` False- destroy wheel+ putStrLn "Unsuccessful `cancel` returns False"+ with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ var <- newEmptyMVar+ cancel <- register wheel 0 (putMVar var ())+ takeMVar var+ cancel `is` False do putStrLn "Recurring timers work"- ref <- newIORef (0::Int)- wheel <- create Config { spokes = 4, resolution = 0.05 }- recurring_ wheel (modifyIORef' ref (+1)) 0.15- sleep 1- readIORef ref `is` (6::Int)- destroy wheel+ with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ canary <- newIORef () -- kept alive only by timer+ weakCanary <- mkWeakIORef canary (pure ())+ var <- newEmptyMVar+ cancel <- recurring wheel 0 (readIORef canary >> putMVar var ())+ replicateM_ 2 (takeMVar var)+ cancel -- should drop reference canary after a GC+ performGC+ (isJust <$> deRefWeak weakCanary) `is` False do- putStrLn "Recurring timers can be canceled"- ref <- newIORef (0::Int)- wheel <- create Config { spokes = 4, resolution = 0.05 }- cancel <- recurring wheel (modifyIORef' ref (+1)) 0.15- sleep 1- cancel- sleep 1- readIORef ref `is` (6::Int)- destroy wheel+ putStrLn "`with` re-throws exception from background thread"+ catch+ (with Config { spokes = 4, resolution = 0.05 } \wheel -> do+ var <- newEmptyMVar+ register_ wheel 0 (throwIO Bye >> putMVar var ())+ takeMVar var+ throwIO (userError "fail"))+ (\ex ->+ case fromException ex of+ Just Bye -> pure ()+ _ -> throwIO ex) +data Bye = Bye+ deriving stock (Show)+ deriving anyclass (Exception)+ class Assert a b where is :: a -> b -> IO () @@ -85,6 +79,3 @@ is mx y = do x <- mx unless (x == y) (throwIO (userError (show x ++ " /= " ++ show y)))--sleep :: Fixed E6 -> IO ()-sleep (MkFixed micro) = threadDelay (fromIntegral micro)
timer-wheel.cabal view
@@ -1,41 +1,31 @@ cabal-version: 2.0 name: timer-wheel-version: 0.2.0.1+version: 0.3.0 category: Data description: This library provides a timer wheel data structure for .- * /O(1)/ registering @IO@ actions to fire after a given amount of time+ * (Almost) /O(1)/ registering @IO@ actions to fire after a given amount of time * /O(1)/ canceling registered actions .- It is similar to @TimerManager@ from "GHC.Event", but can scale much better- under concurrent access patterns.+ It is similar to @TimerManager@ from "GHC.Event", but supports recurring+ timers, can scale to handle many more registered timers. .- An unreleased version of this library has a @backpack@-based signature for- selecting from a variety of different data structures used internally.- However, until @backpack@ has broader support on Hackage, and in Haddocks,- etc, I decided to just hard-code something decent (a priority search queue).- This makes the @O(1)@ claims above a bit of a lie, as these rely on using a- linked list data structure internally. synopsis: A timer wheel author: Mitchell Rosen maintainer: Mitchell Rosen <mitchellwrosen@gmail.com> homepage: https://github.com/mitchellwrosen/timer-wheel bug-reports: https://github.com/mitchellwrosen/timer-wheel/issues-copyright: (c) 2018, Mitchell Rosen+copyright: (c) 2018-2020, Mitchell Rosen license: BSD3 license-file: LICENSE build-type: Simple-tested-with:- GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.5 extra-source-files:- .travis.yml CHANGELOG.md+ README.md+ cabal.project source-repository head type: git@@ -44,15 +34,15 @@ library build-depends: atomic-primops ^>= 0.8,- base ^>= 4.9 || ^>= 4.10 || ^>= 4.11 || ^>= 4.12,+ base ^>= 4.9 || ^>= 4.10 || ^>= 4.11 || ^>= 4.12 || ^>= 4.13 || ^>= 4.14, psqueues ^>= 0.2.7, vector ^>= 0.10 || ^>= 0.11 || ^>= 0.12- if !impl(ghc >= 8.4)- build-depends:- clock ^>= 0.7 default-extensions:+ BlockArguments+ DeriveAnyClass DeriveGeneric+ DerivingStrategies GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns@@ -69,36 +59,30 @@ Data.TimerWheel ghc-options:- -fprint-expanded-synonyms- -fprint-explicit-foralls- -fprint-explicit-kinds- -fprint-unicode-syntax- -Wall- -Wcompat- -Widentities- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wmissing-local-signatures- -Wnoncanonical-monad-instances- -Wnoncanonical-monadfail-instances- -Wredundant-constraints- if impl(ghc >= 8.4)+ -Weverything+ -Wno-all-missed-specialisations+ -Wno-implicit-prelude+ -Wno-missing-import-lists+ -Wno-unsafe+ if impl(ghc >= 8.10) ghc-options:- -Wpartial-fields- -Wmissing-export-lists+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module hs-source-dirs: src other-modules:- Entries- Supply- Wheel+ Data.TimerWheel.Internal.Config+ Data.TimerWheel.Internal.Entries+ Data.TimerWheel.Internal.Micros+ Data.TimerWheel.Internal.Supply+ Data.TimerWheel.Internal.Timestamp+ Data.TimerWheel.Internal.Wheel test-suite tests build-depends: base,- random, timer-wheel default-language: