si-timers 1.3.0.0 → 1.4.0.0

raw patch · 8 files changed

+69/−57 lines, 8 filesdep ~basedep ~io-classesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, io-classes

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−5
• NOTICE +1/−1
• si-timers.cabal +5/−3
• src/Control/Monad/Class/MonadTime/SI.hs +15/−16
• src/Control/Monad/Class/MonadTimer/NonStandard.hs +7/−7
• src/Control/Monad/Class/MonadTimer/SI.hs +29/−18
• test/Main.hs +2/−2
• test/Test/MonadTimer.hs +5/−5

@@ -1,21 +1,21 @@ # Changelog -## next release--### Breaking changes+## 1.4.0.0  ### Non-breaking changes +* Prevent underflows in `threadDelay` (issue #129)+ ## 1.3.0.0 -- `io-sim-1.3.0.0`.+* `io-sim-1.3.0.0`. * Support `ghc-9.8`.  ## 1.2.0.0  ## Non breaking changes -- Added NFData & NoThunks instances for `Time`+* Added NFData & NoThunks instances for `Time`  ## 1.1.0.0 

@@ -1,4 +1,4 @@-Copyright 2019-2023 Input Output Global Inc (IOG)+Copyright 2019-2024 Input Output Global Inc (IOG)     Licensed under the Apache License, Version 2.0 (the "License");    you may not use this file except in compliance with the License.

@@ -1,13 +1,13 @@ cabal-version:       3.0 name:                si-timers-version:             1.3.0.0+version:             1.4.0.0 synopsis:            timers using SI units (seconds) description:   Timers using SI units (seconds) which are safe on 32-bit platforms and   compatible with [io-sim](https://hackage.haskell.org/package/io-sim). license:             Apache-2.0 license-files:       LICENSE NOTICE-copyright:           2022-2023 Input Output Global Inc (IOG)+copyright:           2022-2024 Input Output Global Inc (IOG) author:              Duncan Coutts, Neil Davis, Marcin Szamotulski maintainer:          Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category:            Time@@ -44,6 +44,7 @@                        Control.Monad.Class.MonadTimer.SI   other-modules:       Control.Monad.Class.MonadTimer.NonStandard   default-language:    Haskell2010+  default-extensions:  ImportQualifiedPost   other-extensions:    BangPatterns,                        CPP,                        ConstraintKinds,@@ -59,7 +60,7 @@                        stm,                        time              >=1.9.1 && <1.13, -                       io-classes       ^>=1.3+                       io-classes       ^>=1.4   if flag(asserts)      ghc-options:      -fno-ignore-asserts @@ -73,6 +74,7 @@   main-is:             Main.hs   other-modules:       Test.MonadTimer   default-language:    Haskell2010+  default-extensions:  ImportQualifiedPost   build-depends:       base,                         QuickCheck,

@@ -1,9 +1,9 @@-{-# LANGUAGE DefaultSignatures  #-}-{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE NumericUnderscores         #-}  module Control.Monad.Class.MonadTime.SI   ( MonadTime (..)@@ -20,20 +20,19 @@   , NominalDiffTime   ) where -import           Control.Monad.Reader-import           Control.DeepSeq (NFData (..))+import Control.DeepSeq (NFData (..))+import Control.Monad.Reader -import           Control.Monad.Class.MonadTime ( MonadMonotonicTimeNSec,-                     MonadTime (..), NominalDiffTime, UTCTime, diffUTCTime,-                     addUTCTime)-import qualified Control.Monad.Class.MonadTime as MonadTime+import Control.Monad.Class.MonadTime (MonadMonotonicTimeNSec, MonadTime (..),+           NominalDiffTime, UTCTime, addUTCTime, diffUTCTime)+import Control.Monad.Class.MonadTime qualified as MonadTime -import           NoThunks.Class (NoThunks (..))+import NoThunks.Class (NoThunks (..)) -import           Data.Word (Word64)-import           Data.Time.Clock (DiffTime)-import qualified Data.Time.Clock as Time-import           GHC.Generics (Generic (..))+import Data.Time.Clock (DiffTime)+import Data.Time.Clock qualified as Time+import Data.Word (Word64)+import GHC.Generics (Generic (..))   -- | A point in time in a monotonic clock.

@@ -36,17 +36,17 @@   , AwaitTimeout   ) where -import qualified Control.Concurrent.STM as STM+import Control.Concurrent.STM qualified as STM #ifndef GHC_TIMERS_API-import           Control.Monad (when)+import Control.Monad (when) #endif-import           Control.Monad.Class.MonadSTM+import Control.Monad.Class.MonadSTM  #ifdef GHC_TIMERS_API-import qualified GHC.Event as GHC (TimeoutKey, getSystemTimerManager,-                     registerTimeout, unregisterTimeout)+import GHC.Event qualified as GHC (TimeoutKey, getSystemTimerManager,+           registerTimeout, unregisterTimeout) #else-import qualified GHC.Conc.IO as GHC (registerDelay)+import GHC.Conc.IO qualified as GHC (registerDelay) #endif  @@ -93,7 +93,7 @@ -- You should consider the cancelled state if you plan to use 'cancelTimeout'. -- readTimeout :: ReadTimeout IO Timeout-type ReadTimeout m timeout = timeout -> STM m TimeoutState +type ReadTimeout m timeout = timeout -> STM m TimeoutState   -- | Cancel a timeout (unless it has already fired), putting it into the

@@ -19,22 +19,22 @@   , TimeoutState (..)     -- * Default implementations   , defaultRegisterDelay-  , defaultRegisterDelayCancellable  +  , defaultRegisterDelayCancellable   ) where -import           Control.Concurrent.Class.MonadSTM-import           Control.Exception (assert)-import           Control.Monad.Class.MonadFork-import           Control.Monad.Class.MonadTime.SI-import qualified Control.Monad.Class.MonadTimer as MonadTimer-import           Control.Monad.Class.MonadTimer.NonStandard (TimeoutState (..))-import qualified Control.Monad.Class.MonadTimer.NonStandard as NonStandard+import Control.Concurrent.Class.MonadSTM+import Control.Exception (assert)+import Control.Monad.Class.MonadFork+import Control.Monad.Class.MonadTime.SI+import Control.Monad.Class.MonadTimer qualified as MonadTimer+import Control.Monad.Class.MonadTimer.NonStandard (TimeoutState (..))+import Control.Monad.Class.MonadTimer.NonStandard qualified as NonStandard -import           Control.Monad.Reader+import Control.Monad.Reader -import           Data.Bifunctor (bimap)-import           Data.Functor (($>))-import           Data.Time.Clock (diffTimeToPicoseconds)+import Data.Bifunctor (bimap)+import Data.Functor (($>))+import Data.Time.Clock (diffTimeToPicoseconds)   @@ -42,11 +42,16 @@ -- -- Note that on 32bit systems it can only represent `2^31-1` seconds, which is -- only ~35 minutes.+--+-- It doesn't prevent under- or overflows; when assertions are on it will thrown+-- an assertion exception.+-- diffTimeToMicrosecondsAsInt :: DiffTime -> Int diffTimeToMicrosecondsAsInt d =     let usec :: Integer         usec = diffTimeToPicoseconds d `div` 1_000_000 in-    assert (usec <= fromIntegral (maxBound :: Int)) $+    assert (usec <= fromIntegral (maxBound :: Int)+         && usec >= fromIntegral (minBound :: Int)) $     fromIntegral usec  @@ -60,15 +65,21 @@       ) => MonadDelay m where   threadDelay :: DiffTime -> m () --- | Thread delay.  When the delay is smaller than what `Int` can represent it--- will use the `Control.Monad.Class.MonadTimer.threadDelay` (e.g. for the `IO`--- monad it will use `Control.Concurrent.threadDelay`); otherwise it will--- recursively call `Control.Monad.Class.MonadTimer.threadDelay`.+-- | Thread delay. This implementation will not over- or underflow. --+-- For delay larger than what `Int` can represent (see+-- `diffTimeToMicrosecondsAsInt`), it will recursively call+-- `Control.Monad.Class.MonadTimer.threadDelay`.+--+-- For delays smaller than `minBound :: Int` seconds, `minBound :: Int` will be+-- used instead.+-- instance MonadDelay IO where   threadDelay :: forall m.                  MonadDelay m               => DiffTime -> m ()+  threadDelay d | d <= 0        = return ()+   threadDelay d | d <= maxDelay =       MonadTimer.threadDelay (diffTimeToMicrosecondsAsInt d)     where@@ -248,7 +259,7 @@       maxDelay = microsecondsAsIntToDiffTime maxBound    registerDelayCancellable =-    defaultRegisterDelayCancellable +    defaultRegisterDelayCancellable       NonStandard.newTimeout       NonStandard.readTimeout       NonStandard.cancelTimeout

@@ -1,8 +1,8 @@ module Main (main) where -import           Test.Tasty+import Test.Tasty -import qualified Test.MonadTimer+import Test.MonadTimer qualified  main :: IO () main = defaultMain tests

@@ -3,12 +3,12 @@  module Test.MonadTimer (tests) where -import           Control.Monad.Class.MonadTimer.SI-import           GHC.Real+import Control.Monad.Class.MonadTimer.SI+import GHC.Real -import           Test.QuickCheck-import           Test.Tasty-import           Test.Tasty.QuickCheck (testProperty)+import Test.QuickCheck+import Test.Tasty+import Test.Tasty.QuickCheck (testProperty)  tests :: TestTree tests =