clock-0.8/0000755000000000000000000000000013460604655010653 5ustar0000000000000000clock-0.8/LICENSE0000644000000000000000000000276413460604655011671 0ustar0000000000000000Copyright (c) 2009-2012, Cetin Sert Copyright (c) 2010, Eugene Kirpichov All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. clock-0.8/Setup.hs0000644000000000000000000000005613460604655012310 0ustar0000000000000000import Distribution.Simple main = defaultMain clock-0.8/clock.cabal0000644000000000000000000001002113460604655012724 0ustar0000000000000000name: clock version: 0.8 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and timer functions of different operating systems via a unified API. . POSIX code and surface API was developed by Cetin Sert in 2009. . Windows code was contributed by Eugene Kirpichov in 2010. . FreeBSD code was contributed by Finn Espen Gundersen on 2013-10-14. . OS X code was contributed by Gerolf Seitz on 2013-10-15. . Derived @Generic@, @Typeable@ and other instances for @Clock@ and @TimeSpec@ was contributed by Mathieu Boespflug on 2014-09-17. . Corrected dependency listing for @GHC < 7.6@ was contributed by Brian McKenna on 2014-09-30. . Windows code corrected by Dimitri Sabadie on 2015-02-09. . Added @timeSpecAsNanoSecs@ as observed widely-used by Chris Done on 2015-01-06, exported correctly on 2015-04-20. . Imported Control.Applicative operators correctly for Haskell Platform on Windows on 2015-04-21. . Unit tests and instance fixes by Christian Burger on 2015-06-25. . Removal of fromInteger : Integer -> TimeSpec by Cetin Sert on 2015-12-15. . New Linux-specific Clocks: MonotonicRaw, Boottime, MonotonicCoarse, RealtimeCoarse by Cetin Sert on 2015-12-15. . Reintroduction fromInteger : Integer -> TimeSpec by Cetin Sert on 2016-04-05. . Fixes for older Linux build failures introduced by new Linux-specific clocks by Mario Longobardi on 2016-04-18. . Refreshment release in 2019-04 after numerous contributions. . [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 license: BSD3 license-file: LICENSE author: Cetin Sert , Corsis Research maintainer: Cetin Sert , Corsis Research homepage: https://github.com/corsis/clock bug-reports: https://github.com/corsis/clock/issues category: System build-type: Simple cabal-version: >= 1.8 source-repository head type: git location: git://github.com/corsis/clock.git flag llvm description: compile via LLVM default : False library if impl (ghc < 7.6) build-depends: base >= 4.4 && <= 5, ghc-prim build-depends: base >= 2 && <= 5 exposed-modules: System.Clock extensions: DeriveGeneric DeriveDataTypeable ForeignFunctionInterface ScopedTypeVariables ViewPatterns if os(darwin) c-sources: cbits/hs_clock_darwin.c if os(windows) c-sources: cbits/hs_clock_win32.c include-dirs: cbits ghc-options: -O3 -Wall if flag(llvm) ghc-options: -fllvm -optlo-O3 test-suite test -- default-language: -- Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: test.hs build-depends: base >= 4 && < 5 , tasty >= 0.10 , tasty-quickcheck , clock benchmark benchmarks type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: benchmarks.hs build-depends: base >= 4 && < 5 , criterion , clock clock-0.8/System/0000755000000000000000000000000013460604655012137 5ustar0000000000000000clock-0.8/System/Clock.hsc0000644000000000000000000003007413460604655013675 0ustar0000000000000000-- | High-resolution, realtime clock and timer functions for Posix -- systems. This module is being developed according to IEEE Std -- 1003.1-2008: , -- {-# 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. {-# OPTIONS_GHC -fno-warn-unused-imports #-} module System.Clock ( Clock(..) , TimeSpec(..) , getTime , getRes , fromNanoSecs , toNanoSecs , diffTimeSpec , timeSpecAsNanoSecs ) where import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import GHC.Generics (Generic) #if defined(_WIN32) # include "hs_clock_win32.c" #elif defined(__MACH__) && defined(__APPLE__) # include "hs_clock_darwin.c" #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 # endif #endif #if __GLASGOW_HASKELL__ < 800 # let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) #endif -- | 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.) data Clock -- | The identifier for the system-wide monotonic clock, which is defined as -- a clock measuring real time, whose value cannot be set via -- @clock_settime@ and which cannot have negative clock jumps. The maximum -- possible clock jump shall be implementation defined. For this clock, -- the value returned by 'getTime' represents the amount of time (in -- seconds and nanoseconds) since an unspecified point in the past (for -- example, system start-up time, or the Epoch). This point does not -- change after system start-up time. Note that the absolute value of the -- 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. = 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. | Realtime -- | 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 -- | 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 #if defined (CLOCK_MONOTONIC_RAW) -- | (since Linux 2.6.28; Linux-specific) -- Similar to CLOCK_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). | 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 -- 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). | Boottime #endif #if defined (CLOCK_MONOTONIC_COARSE) -- | (since Linux 2.6.32; Linux-specific) -- A faster but less precise version of CLOCK_MONOTONIC. -- Use when you need very fast, but not fine-grained timestamps. | MonotonicCoarse #endif #if defined (CLOCK_REALTIME_COARSE) -- | (since Linux 2.6.32; Linux-specific) -- A faster but less precise version of CLOCK_REALTIME. -- Use when you need very fast, but not fine-grained timestamps. | 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 () #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 () #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 #endif #if defined (CLOCK_MONOTONIC_RAW) clockToConst MonotonicRaw = #const CLOCK_MONOTONIC_RAW #endif #if defined (CLOCK_BOOTTIME) clockToConst Boottime = #const CLOCK_BOOTTIME #endif #if defined (CLOCK_MONOTONIC_COARSE) clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE #endif #if defined (CLOCK_REALTIME_COARSE) clockToConst RealtimeCoarse = #const CLOCK_REALTIME_COARSE #endif #endif allocaAndPeek :: Storable a => (Ptr a -> IO ()) -> IO a allocaAndPeek f = alloca $ \ptr -> f ptr >> peek ptr -- | The 'getTime' function shall return the current value for the -- specified clock. getTime :: Clock -> IO TimeSpec -- | 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 TimeSpec #if defined(_WIN32) getTime Monotonic = allocaAndPeek hs_clock_win32_gettime_monotonic 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 #endif #if defined(_WIN32) getRes Monotonic = allocaAndPeek hs_clock_win32_getres_monotonic 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 #endif -- | TimeSpec structure data TimeSpec = TimeSpec { sec :: {-# UNPACK #-} !Int64 -- ^ seconds , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds } deriving (Generic, Read, Show, Typeable) #if defined(_WIN32) instance Storable TimeSpec where sizeOf _ = sizeOf (undefined :: Int64) * 2 alignment _ = alignment (undefined :: Int64) poke ptr ts = do pokeByteOff ptr 0 (sec ts) pokeByteOff ptr (sizeOf (undefined :: Int64)) (nsec ts) peek ptr = do TimeSpec <$> peekByteOff ptr 0 <*> peekByteOff ptr (sizeOf (undefined :: Int64)) #else instance Storable TimeSpec where sizeOf _ = #{size struct timespec} alignment _ = #{alignment struct timespec} poke ptr ts = do let xs :: #{type time_t} = fromIntegral $ sec ts xn :: #{type long} = fromIntegral $ nsec ts #{poke struct timespec, tv_sec} ptr (xs) #{poke struct timespec, tv_nsec} ptr (xn) peek ptr = do xs :: #{type time_t} <- #{peek struct timespec, tv_sec} ptr xn :: #{type long} <- #{peek struct timespec, tv_nsec} ptr return $ TimeSpec (fromIntegral xs) (fromIntegral xn) #endif s2ns :: Num a => a s2ns = 10^9 normalize :: TimeSpec -> TimeSpec normalize (TimeSpec xs xn) | xn < 0 || xn >= s2ns = TimeSpec (xs + q) r | otherwise = TimeSpec xs xn where (q, r) = xn `divMod` s2ns 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) 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 fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns instance Eq TimeSpec where (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn | otherwise = es where es = xs == ys instance Ord TimeSpec where compare (normalize -> TimeSpec xs xn) (normalize -> TimeSpec ys yn) | EQ == os = compare xn yn | otherwise = os where os = compare xs ys -- | TimeSpec from nano seconds. fromNanoSecs :: Integer -> TimeSpec fromNanoSecs x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns -- | TimeSpec to nano seconds. toNanoSecs :: TimeSpec -> Integer toNanoSecs (TimeSpec (toInteger -> s) (toInteger -> n)) = s * s2ns + n -- | Compute the absolute difference. diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec diffTimeSpec ts1 ts2 = abs (ts1 - ts2) {-# DEPRECATED timeSpecAsNanoSecs "Use toNanoSecs instead! Replaced timeSpecAsNanoSecs with the same signature TimeSpec -> Integer" #-} -- | TimeSpec as nano seconds. timeSpecAsNanoSecs :: TimeSpec -> Integer timeSpecAsNanoSecs (TimeSpec s n) = toInteger s * s2ns + toInteger n clock-0.8/bench/0000755000000000000000000000000013460604655011732 5ustar0000000000000000clock-0.8/bench/benchmarks.hs0000644000000000000000000000144513460604655014407 0ustar0000000000000000{-# language CPP #-} module Main (main) where import Criterion.Main import System.Clock #if MIN_VERSION_base(4,11,0) import GHC.Clock #endif main :: IO () main = defaultMain [ bgroup "getTime" [ bench "Monotonic" $ whnfIO (getTime Monotonic) , bench "Realtime" $ whnfIO (getTime Realtime) , bench "ProcessCPUTime" $ whnfIO (getTime ProcessCPUTime) , bench "ThreadCPUTime" $ whnfIO (getTime ThreadCPUTime) , bench "MonotonicRaw" $ whnfIO (getTime MonotonicRaw) , bench "Boottime" $ whnfIO (getTime Boottime) , bench "MonotonicCoarse" $ whnfIO (getTime MonotonicCoarse) , bench "RealtimeCoarse" $ whnfIO (getTime RealtimeCoarse) ] #if MIN_VERSION_base(4,11,0) , bench "GHC.Clock.getMonotonicTimeNSec" $ whnfIO getMonotonicTimeNSec #endif ] clock-0.8/cbits/0000755000000000000000000000000013460604655011757 5ustar0000000000000000clock-0.8/cbits/hs_clock_darwin.c0000644000000000000000000000155013460604655015255 0ustar0000000000000000#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__ */ clock-0.8/cbits/hs_clock_win32.c0000644000000000000000000000560713460604655014742 0ustar0000000000000000#ifdef _WIN32 #include #if defined(_MSC_VER) || defined(_MSC_EXTENSIONS) #define U64(x) x##Ui64 #else #define U64(x) x##ULL #endif #define DELTA_EPOCH_IN_100NS U64(116444736000000000) static long ticks_to_nanos(LONGLONG subsecond_time, LONGLONG frequency) { return (long)((1e9 * subsecond_time) / frequency); } static ULONGLONG to_quad_100ns(FILETIME ft) { ULARGE_INTEGER li; li.LowPart = ft.dwLowDateTime; li.HighPart = ft.dwHighDateTime; return li.QuadPart; } static void to_timespec_from_100ns(ULONGLONG t_100ns, long long *t) { t[0] = (long)(t_100ns / 10000000UL); t[1] = 100*(long)(t_100ns % 10000000UL); } /* See https://ghc.haskell.org/trac/ghc/ticket/15094 */ #if defined(_WIN32) && !defined(_WIN64) __attribute__((optimize("-fno-expensive-optimizations"))) #endif void hs_clock_win32_gettime_monotonic(long long* t) { LARGE_INTEGER time; static LARGE_INTEGER frequency; static int hasFreq = 0; QueryPerformanceCounter(&time); if (!hasFreq) { hasFreq = 1; QueryPerformanceFrequency(&frequency); } // seconds t[0] = time.QuadPart / frequency.QuadPart; // nanos = t[1] = ticks_to_nanos(time.QuadPart % frequency.QuadPart, frequency.QuadPart); } void hs_clock_win32_gettime_realtime(long long* t) { FILETIME ft; ULONGLONG tmp; GetSystemTimeAsFileTime(&ft); tmp = to_quad_100ns(ft); tmp -= DELTA_EPOCH_IN_100NS; to_timespec_from_100ns(tmp, t); } void hs_clock_win32_gettime_processtime(long long* t) { FILETIME creation_time, exit_time, kernel_time, user_time; ULONGLONG time; GetProcessTimes(GetCurrentProcess(), &creation_time, &exit_time, &kernel_time, &user_time); // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117 time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time); to_timespec_from_100ns(time, t); } void hs_clock_win32_gettime_threadtime(long long* t) { FILETIME creation_time, exit_time, kernel_time, user_time; ULONGLONG time; GetThreadTimes(GetCurrentThread(), &creation_time, &exit_time, &kernel_time, &user_time); // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117 time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time); to_timespec_from_100ns(time, t); } void hs_clock_win32_getres_monotonic(long long* t) { LARGE_INTEGER frequency; QueryPerformanceFrequency(&frequency); ULONGLONG resolution = U64(1000000000)/frequency.QuadPart; t[0] = resolution / U64(1000000000); t[1] = resolution % U64(1000000000); } void hs_clock_win32_getres_realtime(long long* t) { t[0] = 0; t[1] = 100; } void hs_clock_win32_getres_processtime(long long* t) { t[0] = 0; t[1] = 100; } void hs_clock_win32_getres_threadtime(long long* t) { t[0] = 0; t[1] = 100; } #endif /* _WIN32 */ clock-0.8/tests/0000755000000000000000000000000013460604655012015 5ustar0000000000000000clock-0.8/tests/test.hs0000644000000000000000000000333313460604655013332 0ustar0000000000000000import Test.Tasty import Test.Tasty.QuickCheck as QuickCheck import Data.Fixed import Data.List -- import Test.Tasty.HUnit as HUnit import System.Clock instance Arbitrary TimeSpec where arbitrary = do sec <- arbitrarySizedIntegral nan <- arbitrarySizedIntegral return $ TimeSpec sec nan main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests) tests :: TestTree tests = testGroup "All tests" [numInstanceTests, ordInstanceTests] numInstanceTests = testGroup "Num instance tests" [qcNumInstance] ordInstanceTests = testGroup "Ord instance tests" [qcOrdInstance] 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 ] qcOrdInstance = testGroup "QuickCheck" [ QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of integers" $ \ x -> sort (x :: [TimeSpec]) == map (fromInteger) (sort (map toNanoSecs x)) ]