clock 0.8.2 → 0.8.3

raw patch · 5 files changed

+232/−38 lines, 5 filesdep −ghc-primdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-prim

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• System/Clock.hsc +31/−11
• System/Clock/Seconds.hs +77/−0
• clock.cabal +29/−10
• tests/test.hs +88/−17

@@ -0,0 +1,7 @@+# 0.8.3++- Dropped support for GHC < 7.8.+- Tested with GHC 7.8 - 9.2.+- TODO: new module `System.Clock.Seconds`+- TODO: new functions+- TODO: other changes

@@ -17,11 +17,14 @@   , toNanoSecs   , diffTimeSpec   , timeSpecAsNanoSecs+  , normalize+  , s2ns   ) where  import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word+import Data.Ratio import Data.Typeable (Typeable) import Foreign.C import Foreign.Ptr@@ -44,7 +47,7 @@  -- | Clock types. A clock may be system-wide (that is, visible to all processes) --   or per-process (measuring time that is meaningful only within a process).---   All implementations shall support 'Realtime'. +--   All implementations shall support 'Realtime'. data Clock      -- | The identifier for the system-wide monotonic clock, which is defined as@@ -227,21 +230,34 @@ instance Num TimeSpec where   (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $! TimeSpec (xs + ys) (xn + yn)   (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $! TimeSpec (xs - ys) (xn - yn)-  (TimeSpec xs xn) * (TimeSpec ys yn) = normalize $! TimeSpec (xsi_ysi) (xni_yni)-                                         where xsi_ysi = fromInteger $!  xsi*ysi -                                               xni_yni = fromInteger $! (xni*yni + (xni*ysi + xsi*yni) * s2ns) `div` s2ns-                                               xsi     =   toInteger  xs-                                               ysi     =   toInteger  ys-                                               xni     =   toInteger  xn-                                               yni     =   toInteger  yn-+  (normalize -> TimeSpec xs xn) * (normalize -> TimeSpec ys yn) = normalize $! TimeSpec (s2ns*xs*ys+xs*yn+xn*ys) (xn*yn)   negate (TimeSpec xs xn) = normalize $! TimeSpec (negate xs) (negate xn)   abs    (normalize -> TimeSpec xs xn) | xs == 0   = normalize $! TimeSpec 0 xn                                        | otherwise = normalize $! TimeSpec (abs xs) (signum xs * xn)-  signum (normalize -> TimeSpec xs xn) | xs == 0   = TimeSpec (signum xn) 0-                                       | otherwise = TimeSpec (signum xs) 0+  signum (normalize -> TimeSpec xs xn) | xs == 0   = TimeSpec 0 (signum xn)+                                       | otherwise = TimeSpec 0 (signum xs)   fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns +instance Enum TimeSpec where+  succ x = x + 1+  pred x = x - 1+  toEnum x = normalize $ TimeSpec 0 (fromIntegral x)+  fromEnum = fromEnum . toInteger++instance Real TimeSpec where+  toRational x = toInteger x % 1++instance Integral TimeSpec where+  toInteger = toNanoSecs+  quot (toInteger-> t1) (toInteger-> t2) = fromInteger $! quot t1 t2+  rem (toInteger-> t1) (toInteger-> t2) = fromInteger $! rem t1 t2+  div (toInteger-> t1) (toInteger-> t2) = fromInteger $! div t1 t2+  mod (toInteger-> t1) (toInteger-> t2) = fromInteger $! mod t1 t2+  divMod (toInteger-> t1) (toInteger-> t2) =+    let (q,r)=divMod t1 t2 in (fromInteger $! q, fromInteger $! r)+  quotRem (toInteger-> t1) (toInteger-> t2) =+    let (q,r)=quotRem t1 t2 in (fromInteger $! q, fromInteger $! r)+ instance Eq TimeSpec where   (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn                                                                  | otherwise  = es@@ -251,6 +267,10 @@   compare (normalize -> TimeSpec xs xn) (normalize -> TimeSpec ys yn) | EQ ==  os = compare xn yn                                                                       | otherwise = os                                                                         where  os = compare xs ys++instance Bounded TimeSpec where+  minBound = TimeSpec minBound 0+  maxBound = TimeSpec maxBound (s2ns-1)  -- | TimeSpec from nano seconds. fromNanoSecs :: Integer -> TimeSpec

@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module System.Clock.Seconds+  ( Clock(..)+  , Seconds(..)+  , getTime+  , getRes+  , fromNanoSecs+  , toNanoSecs+  , diffTimeSpec+  ) where++import Data.Coerce+import Data.Ratio+import Data.Typeable (Typeable)+import Foreign.Storable+import GHC.Generics (Generic)++import System.Clock(TimeSpec(..), Clock, s2ns, normalize)+import qualified System.Clock as C++newtype Seconds = Seconds { toTimeSpec :: TimeSpec }+ deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable, Bounded)++instance Num Seconds where+  fromInteger n = Seconds $ TimeSpec (fromInteger n) 0+  Seconds (TimeSpec xs xn) * Seconds (TimeSpec ys yn) =+    Seconds $ normalize $! TimeSpec (xs*ys) (xs*yn+xn*ys+((xn*yn) `div` s2ns))+  (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec)+  (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)+  negate = coerce (negate :: TimeSpec -> TimeSpec)+  abs = coerce (abs :: TimeSpec -> TimeSpec)+  signum (Seconds a) = case signum a of+    1 -> 1+    (-1) -> (-1)+    _ -> 0++instance Enum Seconds where+  succ x = x + 1+  pred x = x - 1+  toEnum x = Seconds $ TimeSpec (fromIntegral x) 0+  fromEnum (Seconds (TimeSpec s _)) = fromEnum s++instance Real Seconds where+  toRational (Seconds x) = toInteger x % s2ns++instance Fractional Seconds where+  fromRational x = Seconds . fromInteger $ floor (x * s2ns)+  Seconds a / Seconds b = Seconds $ a * s2ns `div` b+  recip (Seconds a) = Seconds $ s2ns * s2ns `div` a++instance RealFrac Seconds where+  properFraction (Seconds (TimeSpec s ns))+    | s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns)+    | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns)++-- | The 'getTime' function shall return the current value for the+--   specified clock.+getTime :: Clock -> IO Seconds+getTime = coerce C.getTime++-- | The 'getRes' function shall return the resolution of any clock.+--   Clock resolutions are implementation-defined and cannot be set+--   by a process.+getRes :: Clock -> IO Seconds+getRes = coerce C.getRes++-- | Seconds from nano seconds.+fromNanoSecs :: Integer -> Seconds+fromNanoSecs = coerce C.fromNanoSecs++-- | Seconds to nano seconds.+toNanoSecs :: Seconds -> Integer+toNanoSecs = coerce C.toNanoSecs++-- | Compute the absolute difference.+diffTimeSpec :: Seconds -> Seconds -> Seconds+diffTimeSpec = coerce C.diffTimeSpec

@@ -1,6 +1,6 @@ cabal-version: >= 1.10 name:          clock-version:       0.8.2+version:       0.8.3 stability:     stable synopsis:      High-resolution clock functions: monotonic, realtime, cputime. description:   A package for convenient access to high-resolution clock and@@ -52,9 +52,23 @@ bug-reports:   https://github.com/corsis/clock/issues category:      System build-type:    Simple-tested-with: GHC==8.10.3, GHC==8.8.4, GHC==8.6.5 +tested-with:+  GHC == 9.2.1+  GHC == 9.0.2+  GHC == 8.10.7+  GHC == 8.8.4+  GHC == 8.6.5+  GHC == 8.4.4+  GHC == 8.2.2+  GHC == 8.0.2+  GHC == 7.10.3+  GHC == 7.8.4 +extra-source-files:+  CHANGELOG.md++ source-repository head     type:      git     location:  git://github.com/corsis/clock.git@@ -66,16 +80,18 @@   library-    default-language: Haskell2010-    if impl (ghc < 7.6)-      build-depends:       base >= 4.4 && <= 5, ghc-prim-    build-depends:       base >= 2 && <= 5+    build-depends:       base >= 4.7 && < 5+     exposed-modules:     System.Clock-    default-extensions:          DeriveGeneric+                         System.Clock.Seconds++    default-language:    Haskell2010+    default-extensions:  DeriveGeneric                          DeriveDataTypeable                          ForeignFunctionInterface                          ScopedTypeVariables                          ViewPatterns+                         GeneralizedNewtypeDeriving     if os(windows)       c-sources:         cbits/hs_clock_win32.c     include-dirs:        cbits@@ -86,7 +102,10 @@   test-suite test-    default-language: Haskell2010+    default-language:    Haskell2010+    default-extensions:  ScopedTypeVariables+                         GeneralizedNewtypeDeriving+                         StandaloneDeriving     type:       exitcode-stdio-1.0     hs-source-dirs:@@ -94,7 +113,7 @@     main-is:       test.hs     build-depends:-        base >= 4 && < 5+        base       , tasty >= 0.10       , tasty-quickcheck       , clock@@ -108,6 +127,6 @@     main-is:       benchmarks.hs     build-depends:-        base >= 4 && < 5+        base       , criterion       , clock

@@ -4,6 +4,7 @@ import Data.List -- import Test.Tasty.HUnit as HUnit import System.Clock+import System.Clock.Seconds as S  instance Arbitrary TimeSpec where   arbitrary = do@@ -11,28 +12,98 @@     nan <- arbitrarySizedIntegral     return $ TimeSpec sec nan -main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests)+deriving instance Arbitrary Seconds +main = defaultMain (localOption (QuickCheckTests 100000) $ tests)+ tests :: TestTree-tests  = testGroup "All tests" [numInstanceTests, ordInstanceTests]+tests  = testGroup "All tests" [timeSpecTests, secondsTests] -numInstanceTests = testGroup "Num instance tests" [qcNumInstance]-ordInstanceTests = testGroup "Ord instance tests" [qcOrdInstance]+timeSpecTests = testGroup "TimeSpec tests" [qcNumInstance (0 :: TimeSpec), qcRealInstance (0 :: TimeSpec), qcTimeSpec]+secondsTests = testGroup "Seconds tests" [qcNumInstance (0 :: S.Seconds), qcRealInstance (0 :: S.Seconds), qcSeconds] -qcNumInstance = testGroup "QuickCheck"-  [ -    QuickCheck.testProperty "x = abs(x) * signum(x)"                                 $ \ x   -> (x :: TimeSpec) == (abs x) * (signum x)-  , QuickCheck.testProperty "integer     addition equals TimeSpec     addition"      $ \ x y -> x + y == toNanoSecs (fromInteger x + fromInteger y)-  , QuickCheck.testProperty "integer subtraction equals TimeSpec subtracttion"      $ \ x y -> x - y == toNanoSecs (fromInteger x - fromInteger y)-  , QuickCheck.testProperty "rational multiplication equals TimeSpec multiplication" $-      \ x y ->-        let rationalMul = truncate                         ((x :: Nano) *                       (y :: Nano) * (10^9))-            timespecMul = toNanoSecs (fromInteger (truncate (x * 10^9)) * fromInteger (truncate (y * 10^9)))-        in  rationalMul == timespecMul-  , QuickCheck.testProperty "neg(neg(x)) = x" $ \ x -> negate (negate x :: TimeSpec) == x+qcNumInstance :: (Eq a, Num a, Arbitrary a, Show a) => a -> TestTree+qcNumInstance (s :: a) = testGroup "Num"+  [+    QuickCheck.testProperty "Associativity of (+)" $ \(x :: a) y z ->+        (x + y) + z == x + (y + z)+  , QuickCheck.testProperty "Commutativity of (+)" $ \(x :: a) y ->+        x + y == y + x+  , QuickCheck.testProperty "fromInteger 0 is the additive identity" $ \(x :: a) ->+        x + fromInteger 0 == x+  , QuickCheck.testProperty "negate gives the additive inverse" $ \(x :: a) ->+        x + negate x == fromInteger 0+  , QuickCheck.testProperty "fromInteger 1 is the multiplicative identity" $ \(x :: a) ->+        x * fromInteger 1 == x && fromInteger 1 * x == x+  , QuickCheck.testProperty "neg(neg(x)) = x" $ \(x :: a) ->+        negate (negate x) == x+  , QuickCheck.testProperty "x = abs(x) * signum(x)" $ \(x :: a) ->+        x == (abs x) * (signum x)   ] -qcOrdInstance = testGroup "QuickCheck"+qcRealInstance :: (Real a, Arbitrary a, Show a) => a -> TestTree+qcRealInstance (s :: a) = testGroup "Real"   [-    QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of integers" $ \ x -> sort (x :: [TimeSpec]) == map (fromInteger) (sort (map toNanoSecs x))+    QuickCheck.testProperty "integer addition is correct" $ \ x y ->+      toRational (x + y) == toRational (fromInteger x + fromInteger y :: a)+  , QuickCheck.testProperty "integer subtraction is correct" $ \ x y ->+      toRational (x - y) == toRational (fromInteger x - fromInteger y :: a)+  , QuickCheck.testProperty "integer multiplication is correct" $ \ x y ->+      toRational (x * y) == toRational (fromInteger x * fromInteger y :: a)+  , QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of rationals" $ \(x :: [a]) ->+      map toRational (sort x) == sort (map toRational x)+  ]++qcTimeSpec :: TestTree+qcTimeSpec = testGroup "TimeSpec-specific"+  [+    -- fails with Seconds on 0.000000001 * -1.000000002 * -2.000000001+    QuickCheck.testProperty "Associativity of (*)" $ \(x :: TimeSpec) y z ->+        (x * y) * z == x * (y * z)+    -- fails with Seconds on [-0.999999999,0.000000001,-1.000000001]+  , QuickCheck.testProperty "Distributivity of (*) with respect to (+)" $ \(a :: TimeSpec) b c ->+        a * (b + c) == (a * b) + (a * c) && (b + c) * a == (b * a) + (c * a)+  , QuickCheck.testProperty "TimeSpec Quot-rem division equality" $ \(x :: TimeSpec) y ->+      y == 0 || x == y * quot x y + rem x y+  , QuickCheck.testProperty "TimeSpec Rem is within bounds" $ \(x :: TimeSpec) y ->+      let r = rem x y in y == 0 || r == fromInteger 0 || abs r < abs y+  , QuickCheck.testProperty "TimeSpec quotRem agrees with quot and rem" $ \(x :: TimeSpec) y ->+      let (q,r) = quotRem x y in+        y == 0 || (q == quot x y && r == rem x y)+  , QuickCheck.testProperty "TimeSpec Div-mod division equality" $ \(x :: TimeSpec) y ->+      y == 0 || x == y * div x y + mod x y+  , QuickCheck.testProperty "TimeSpec Mod is within bounds" $ \(x :: TimeSpec) y ->+      let r = mod x y in y == 0 || (r == fromInteger 0 || abs r < abs y)+  , QuickCheck.testProperty "TimeSpec divMod agrees with div and mod" $ \(x :: TimeSpec) y ->+      let (q,r) = divMod x y in+        y == 0 || (q == div x y && r == mod x y)+  , QuickCheck.testProperty "TimeSpec toInteger . fromInteger is the identity" $ \x ->+      x == toInteger (fromInteger x :: TimeSpec)+  , QuickCheck.testProperty "TimeSpec fromInteger . toInteger is the identity" $ \(x :: TimeSpec) ->+      x == fromInteger (toInteger x)+  , QuickCheck.testProperty "TimeSpec division agrees with Integer" $ \(x :: TimeSpec) y ->+      y == 0 || toInteger (x `div` y) == toInteger x `div` toInteger y+  , QuickCheck.testProperty "TimeSpec quot agrees with Integer" $ \(x :: TimeSpec) y ->+      y == 0 || toInteger (x `quot` y) == toInteger x `quot` toInteger y+  ]++qcSeconds :: TestTree+qcSeconds = testGroup "Seconds-specific"+  [+    QuickCheck.testProperty "Seconds multiplication is Nano multiplication" $ \x y ->+      let nano = toRational $ (x :: Nano) * (y :: Nano)+          seconds = toRational $ (realToFrac x) * (realToFrac y :: Seconds)+      in  nano == seconds+  , QuickCheck.testProperty "Seconds truncate is Nano truncate" $ \(x :: Nano) ->+      let nano = truncate x :: Integer+          seconds = truncate (realToFrac x :: Seconds)+      in  nano == seconds+  , QuickCheck.testProperty "Seconds / is Nano /" $ \(x :: Nano) (y :: Nano) ->+      let nano = toRational $ x / y+          seconds = toRational (realToFrac x / realToFrac y :: Seconds)+      in y == 0 || nano == seconds+  , QuickCheck.testProperty "Seconds recip is Nano recip" $ \(x :: Nano) ->+      let nano = toRational $ recip x+          seconds = toRational (recip $ realToFrac x :: Seconds)+      in x == 0 || nano == seconds   ]