diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -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
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,5 +1,4 @@
-Copyright (c) 2009-2012, Cetin Sert
-Copyright (c) 2010, Eugene Kirpichov
+Copyright (c) 2009-2022, Clock Contributors
All rights reserved.
diff --git a/System/Clock.hsc b/System/Clock.hsc
--- a/System/Clock.hsc
+++ b/System/Clock.hsc
@@ -3,6 +3,7 @@
-- 1003.1-2008: ,
--
+{-# LANGUAGE CApiFFI #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- To allow importing Data.Int and Data.Word indiscriminately on all platforms,
-- since we can't systematically predict what typedef's expand to.
@@ -17,12 +18,16 @@
, 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
import Foreign.Storable
import Foreign.Marshal.Alloc
@@ -30,15 +35,17 @@
#if defined(_WIN32)
# include "hs_clock_win32.c"
-#elif defined(__MACH__) && defined(__APPLE__)
-# include "hs_clock_darwin.c"
+# define HS_CLOCK_HAVE_PROCESS_CPUTIME
+# define HS_CLOCK_HAVE_THREAD_CPUTIME
#else
# include
--- Due to missing define in FreeBSD 9.0 and 9.1
--- (http://lists.freebsd.org/pipermail/freebsd-stable/2013-September/075095.html).
-# ifndef CLOCK_PROCESS_CPUTIME_ID
-# define CLOCK_PROCESS_CPUTIME_ID 15
+# ifdef CLOCK_PROCESS_CPUTIME_ID
+# define HS_CLOCK_HAVE_PROCESS_CPUTIME
# endif
+# ifdef CLOCK_THREAD_CPUTIME_ID
+# define HS_CLOCK_HAVE_THREAD_CPUTIME
+# endif
+import System.Posix.Types
#endif
#if __GLASGOW_HASKELL__ < 800
@@ -47,8 +54,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 CLOCK_REALTIME. (The only suspend-aware
--- monotonic is CLOCK_BOOTTIME on Linux.)
+-- All implementations shall support 'Realtime'.
data Clock
-- | The identifier for the system-wide monotonic clock, which is defined as
@@ -62,102 +68,133 @@
-- monotonic clock is meaningless (because its origin is arbitrary), and
-- thus there is no need to set it. Furthermore, realtime applications can
-- rely on the fact that the value of this clock is never set.
+ -- (Identical to 'Boottime' since Linux 4.17, see https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/commit/?id=d6ed449afdb38f89a7b38ec50e367559e1b8f71f)
+ -- @CLOCK_MONOTONIC@ (macOS - @SYSTEM_CLOCK@)
= Monotonic
-- | The identifier of the system-wide clock measuring real time. For this
-- clock, the value returned by 'getTime' represents the amount of time (in
-- seconds and nanoseconds) since the Epoch.
+ -- @CLOCK_REALTIME@ (macOS - @CALENDAR_CLOCK@, Windows - @GetSystemTimeAsFileTime@)
| Realtime
+#ifdef HS_CLOCK_HAVE_PROCESS_CPUTIME
-- | The identifier of the CPU-time clock associated with the calling
-- process. For this clock, the value returned by 'getTime' represents the
-- amount of execution time of the current process.
| ProcessCPUTime
+#endif
+#ifdef HS_CLOCK_HAVE_THREAD_CPUTIME
-- | The identifier of the CPU-time clock associated with the calling OS
-- thread. For this clock, the value returned by 'getTime' represents the
-- amount of execution time of the current OS thread.
| ThreadCPUTime
+#endif
#if defined (CLOCK_MONOTONIC_RAW)
- -- | (since Linux 2.6.28; Linux-specific)
- -- Similar to CLOCK_MONOTONIC, but provides access to a
+ -- | (since Linux 2.6.28, macOS 10.12)
+ -- Similar to 'Monotonic', but provides access to a
-- raw hardware-based time that is not subject to NTP
-- adjustments or the incremental adjustments performed by
-- adjtime(3).
+ -- @CLOCK_MONOTONIC_RAW@ (Windows - @QueryPerformanceCounter@, @QueryPerformanceFrequency@)
| MonotonicRaw
#endif
#if defined (CLOCK_BOOTTIME)
-- | (since Linux 2.6.39; Linux-specific)
- -- Identical to CLOCK_MONOTONIC, except it also includes
- -- any time that the system is suspended. This allows
+ -- Identical to `Monotonic`, except it also includes
+ -- any time that the system is suspended. This allows
-- applications to get a suspend-aware monotonic clock
- -- without having to deal with the complications of
- -- CLOCK_REALTIME, which may have discontinuities if the
- -- time is changed using settimeofday(2).
+ -- without having to deal with the complications of 'Realtime',
+ -- which may have discontinuities if the time is changed
+ -- using settimeofday(2).
+ -- (since Linux 4.17; identical to 'Monotonic')
+ -- @CLOCK_BOOTTIME@
| Boottime
#endif
#if defined (CLOCK_MONOTONIC_COARSE)
-- | (since Linux 2.6.32; Linux-specific)
- -- A faster but less precise version of CLOCK_MONOTONIC.
+ -- A faster but less precise version of 'Monotonic'.
-- Use when you need very fast, but not fine-grained timestamps.
+ -- @CLOCK_MONOTONIC_COARSE@
| MonotonicCoarse
#endif
#if defined (CLOCK_REALTIME_COARSE)
-- | (since Linux 2.6.32; Linux-specific)
- -- A faster but less precise version of CLOCK_REALTIME.
+ -- A faster but less precise version of 'Realtime'.
-- Use when you need very fast, but not fine-grained timestamps.
+ -- @CLOCK_REALTIME_COARSE@
| RealtimeCoarse
#endif
deriving (Eq, Enum, Generic, Read, Show, Typeable)
#if defined(_WIN32)
-foreign import ccall hs_clock_win32_gettime_monotonic :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_gettime_realtime :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_gettime_processtime :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_gettime_threadtime :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_getres_monotonic :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_win32_getres_threadtime :: Ptr TimeSpec -> IO ()
-#elif defined(__MACH__) && defined(__APPLE__)
-foreign import ccall hs_clock_darwin_gettime :: #{type clock_id_t} -> Ptr TimeSpec -> IO ()
-foreign import ccall hs_clock_darwin_getres :: #{type clock_id_t} -> Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_gettime_monotonic :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_gettime_realtime :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_gettime_processtime :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_gettime_threadtime :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_getres_monotonic :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO ()
+foreign import ccall unsafe hs_clock_win32_getres_threadtime :: Ptr TimeSpec -> IO ()
#else
-foreign import ccall unsafe clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO ()
-foreign import ccall unsafe clock_getres :: #{type clockid_t} -> Ptr TimeSpec -> IO ()
+#if MIN_VERSION_base(4,10,0)
+type ClockId = CClockId
+#else
+type ClockId = #{type clockid_t}
#endif
-#if !defined(_WIN32)
-#if defined(__MACH__) && defined(__APPLE__)
-clockToConst :: Clock -> #{type clock_id_t}
-clockToConst Monotonic = #const SYSTEM_CLOCK
-clockToConst Realtime = #const CALENDAR_CLOCK
-clockToConst ProcessCPUTime = #const SYSTEM_CLOCK
-clockToConst ThreadCPUTime = #const SYSTEM_CLOCK
-#else
-clockToConst :: Clock -> #{type clockid_t}
-clockToConst Monotonic = #const CLOCK_MONOTONIC
-clockToConst Realtime = #const CLOCK_REALTIME
-clockToConst ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID
-clockToConst ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID
+foreign import ccall unsafe clock_gettime :: ClockId -> Ptr TimeSpec -> IO CInt
+foreign import ccall unsafe clock_getres :: ClockId -> Ptr TimeSpec -> IO CInt
+
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC" clock_MONOTONIC :: ClockId
+foreign import capi unsafe "time.h value CLOCK_REALTIME" clock_REALTIME :: ClockId
+#if defined (CLOCK_PROCESS_CPUTIME_ID)
+foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" clock_PROCESS_CPUTIME_ID :: ClockId
#endif
+#if defined (CLOCK_THREAD_CPUTIME_ID)
+foreign import capi unsafe "time.h value CLOCK_THREAD_CPUTIME_ID" clock_THREAD_CPUTIME_ID :: ClockId
+#endif
+#if defined (CLOCK_MONOTONIC_RAW)
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_RAW" clock_MONOTONIC_RAW :: ClockId
+#endif
+#if defined (CLOCK_BOOTTIME)
+foreign import capi unsafe "time.h value CLOCK_BOOTTIME" clock_BOOTTIME :: ClockId
+#endif
+#if defined (CLOCK_MONOTONIC_COARSE)
+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_COARSE" clock_MONOTONIC_COARSE :: ClockId
+#endif
+#if defined (CLOCK_REALTIME_COARSE)
+foreign import capi unsafe "time.h value CLOCK_REALTIME_COARSE" clock_REALTIME_COARSE :: ClockId
+#endif
+#endif
+#if !defined(_WIN32)
+clockToConst :: Clock -> ClockId
+clockToConst Monotonic = clock_MONOTONIC
+clockToConst Realtime = clock_REALTIME
+#if defined (CLOCK_PROCESS_CPUTIME_ID)
+clockToConst ProcessCPUTime = clock_PROCESS_CPUTIME_ID
+#endif
+#if defined (CLOCK_THREAD_CPUTIME_ID)
+clockToConst ThreadCPUTime = clock_THREAD_CPUTIME_ID
+#endif
#if defined (CLOCK_MONOTONIC_RAW)
-clockToConst MonotonicRaw = #const CLOCK_MONOTONIC_RAW
+clockToConst MonotonicRaw = clock_MONOTONIC_RAW
#endif
#if defined (CLOCK_BOOTTIME)
-clockToConst Boottime = #const CLOCK_BOOTTIME
+clockToConst Boottime = clock_BOOTTIME
#endif
#if defined (CLOCK_MONOTONIC_COARSE)
-clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE
+clockToConst MonotonicCoarse = clock_MONOTONIC_COARSE
#endif
#if defined (CLOCK_REALTIME_COARSE)
-clockToConst RealtimeCoarse = #const CLOCK_REALTIME_COARSE
+clockToConst RealtimeCoarse = clock_REALTIME_COARSE
#endif
#endif
@@ -178,10 +215,8 @@
getTime Realtime = allocaAndPeek hs_clock_win32_gettime_realtime
getTime ProcessCPUTime = allocaAndPeek hs_clock_win32_gettime_processtime
getTime ThreadCPUTime = allocaAndPeek hs_clock_win32_gettime_threadtime
-#elif defined(__MACH__) && defined(__APPLE__)
-getTime clk = allocaAndPeek $! hs_clock_darwin_gettime $! clockToConst clk
#else
-getTime clk = allocaAndPeek $! clock_gettime $! clockToConst clk
+getTime clk = allocaAndPeek $! throwErrnoIfMinus1_ "clock_gettime" . clock_gettime (clockToConst clk)
#endif
#if defined(_WIN32)
@@ -189,10 +224,8 @@
getRes Realtime = allocaAndPeek hs_clock_win32_getres_realtime
getRes ProcessCPUTime = allocaAndPeek hs_clock_win32_getres_processtime
getRes ThreadCPUTime = allocaAndPeek hs_clock_win32_getres_threadtime
-#elif defined(__MACH__) && defined(__APPLE__)
-getRes clk = allocaAndPeek $! hs_clock_darwin_getres $! clockToConst clk
#else
-getRes clk = allocaAndPeek $! clock_getres $! clockToConst clk
+getRes clk = allocaAndPeek $! throwErrnoIfMinus1_ "clock_getres" . clock_getres (clockToConst clk)
#endif
-- | TimeSpec structure
@@ -238,26 +271,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
--- let xsi = toInteger xs -- convert to arbitraty Integer type to avoid int overflow
--- xni = toInteger xn
--- ysi = toInteger ys
--- yni = toInteger yn -- seconds -- nanoseconds
--- in normalize $! TimeSpec (fromInteger $! xsi * ysi) (fromInteger $! (xni * yni + (xni * ysi + xsi * yni) * s2ns) `div` s2ns)
-
+ (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
@@ -267,6 +308,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
diff --git a/System/Clock/Seconds.hs b/System/Clock/Seconds.hs
new file mode 100644
--- /dev/null
+++ b/System/Clock/Seconds.hs
@@ -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
diff --git a/cbits/hs_clock_darwin.c b/cbits/hs_clock_darwin.c
deleted file mode 100644
--- a/cbits/hs_clock_darwin.c
+++ /dev/null
@@ -1,29 +0,0 @@
-#ifdef __MACH__
-#include
-#include
-#include
-
-void hs_clock_darwin_gettime(clock_id_t clock, struct timespec *ts)
-{
- // OS X does not have clock_gettime, use clock_get_time
- // see http://stackoverflow.com/questions/11680461/monotonic-clock-on-osx
- clock_serv_t cclock;
- mach_timespec_t mts;
- host_get_clock_service(mach_host_self(), clock, &cclock);
- clock_get_time(cclock, &mts);
- mach_port_deallocate(mach_task_self(), cclock);
- ts->tv_sec = mts.tv_sec;
- ts->tv_nsec = mts.tv_nsec;
-}
-
-void hs_clock_darwin_getres(clock_id_t clock, struct timespec *ts)
-{
- clock_serv_t cclock;
- int nsecs;
- mach_msg_type_number_t count;
- host_get_clock_service(mach_host_self(), clock, &cclock);
- clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);
- mach_port_deallocate(mach_task_self(), cclock);
-}
-
-#endif /* __MACH__ */
diff --git a/clock.cabal b/clock.cabal
--- a/clock.cabal
+++ b/clock.cabal
@@ -1,5 +1,6 @@
+cabal-version: >= 1.10
name: clock
-version: 0.8
+version: 0.8.4
stability: stable
synopsis: High-resolution clock functions: monotonic, realtime, cputime.
description: A package for convenient access to high-resolution clock and
@@ -35,26 +36,44 @@
.
Refreshment release in 2019-04 after numerous contributions.
.
+ Refactoring for Windows, Mac implementation consistence by Alexander Vershilov on 2021-01-16.
+ .
[Version Scheme]
Major-@/R/@-ewrite . New-@/F/@-unctionality . @/I/@-mprovementAndBugFixes . @/P/@-ackagingOnly
.
* @PackagingOnly@ changes are made for quality assurance reasons.
-copyright: Copyright © Cetin Sert 2009-2016, Eugene Kirpichov 2010, Finn Espen Gundersen 2013, Gerolf Seitz 2013, Mathieu Boespflug 2014 2015, Chris Done 2015, Dimitri Sabadie 2015, Christian Burger 2015, Mario Longobardi 2016
+copyright: Copyright © Cetin Sert 2009-2023, Eugene Kirpichov 2010, Finn Espen Gundersen 2013, Gerolf Seitz 2013, Mathieu Boespflug 2014 2015, Chris Done 2015, Dimitri Sabadie 2015, Christian Burger 2015, Mario Longobardi 2016, Alexander Vershilov 2021.
license: BSD3
license-file: LICENSE
-author: Cetin Sert , Corsis Research
-maintainer: Cetin Sert , Corsis Research
+author: Cetin Sert , Elefunc, Inc.
+maintainer: Cetin Sert , Elefunc, Inc.
homepage: https://github.com/corsis/clock
bug-reports: https://github.com/corsis/clock/issues
category: System
build-type: Simple
-cabal-version: >= 1.8
+tested-with:
+ GHC == 9.6.1
+ GHC == 9.4.4
+ GHC == 9.2.7
+ 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
+ location: https://github.com/corsis/clock.git
flag llvm
@@ -63,17 +82,18 @@
library
- 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
- extensions: DeriveGeneric
+ System.Clock.Seconds
+
+ default-language: Haskell2010
+ default-extensions: DeriveGeneric
DeriveDataTypeable
ForeignFunctionInterface
ScopedTypeVariables
ViewPatterns
- if os(darwin)
- c-sources: cbits/hs_clock_darwin.c
+ GeneralizedNewtypeDeriving
if os(windows)
c-sources: cbits/hs_clock_win32.c
include-dirs: cbits
@@ -84,8 +104,10 @@
test-suite test
--- default-language:
--- Haskell2010
+ default-language: Haskell2010
+ default-extensions: ScopedTypeVariables
+ GeneralizedNewtypeDeriving
+ StandaloneDeriving
type:
exitcode-stdio-1.0
hs-source-dirs:
@@ -93,12 +115,13 @@
main-is:
test.hs
build-depends:
- base >= 4 && < 5
+ base
, tasty >= 0.10
, tasty-quickcheck
, clock
benchmark benchmarks
+ default-language: Haskell2010
type:
exitcode-stdio-1.0
hs-source-dirs:
@@ -106,6 +129,6 @@
main-is:
benchmarks.hs
build-depends:
- base >= 4 && < 5
+ base
, criterion
, clock
diff --git a/tests/test.hs b/tests/test.hs
--- a/tests/test.hs
+++ b/tests/test.hs
@@ -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
]