-- |
-- Module: System.Time.Monotonic
-- Copyright: (c) Joseph Adams 2012
-- License: BSD3
-- Maintainer: joeyadams3.14159@gmail.com
-- Portability: Tested on Linux and Windows.
--
-- This module provides a platform-independent API for using the system's
-- monotonic clock.
--
-- Known issues:
--
-- * On Windows XP, this uses @GetTickCount@, which has a 49.7 day wraparound.
-- 'Clock' works around this problem, but the workaround only works if
-- 'clockGetTime' is called at least once every 24.8 days.
--
-- * On Linux, this uses @clock_gettime@ with @CLOCK_MONOTONIC@,
-- which (unfortunately) stops when the computer is suspended. Thus,
-- 'clockGetTime' will not include time spent sleeping. Do not rely on this
-- behavior, as it may be fixed in a future version of this library.
{-# LANGUAGE ExistentialQuantification #-}
module System.Time.Monotonic (
-- * Clock
Clock,
newClock,
clockGetTime,
-- ** Drivers
newClockWithDriver,
clockDriverName,
-- * Utilities
delay,
) where
import System.Time.Monotonic.Direct
import Control.Concurrent (threadDelay)
import Data.IORef
import Data.Time.Clock (DiffTime)
data Clock = forall time cumtime.
Clock !(SystemClock time cumtime) !(IORef (ClockData time cumtime))
-- We can't have the Eq instance because the time type is existentially
-- quantified, meaning the equality below would have to compare two IORefs of
-- different value type. If we really wanted it, we could add a dummy IORef,
-- use Typeable, or perhaps even use unsafeCoerce.
--
-- instance Eq Clock where
-- Clock _ a == Clock _ b = a == b
-- | The cumulative amount of time since 'newClock' was called, paired with the
-- return value of 'systemClockGetTime', at a given point in time.
--
-- The disposition between the @cumtime@ and the @time@ is set when 'newClock'
-- is called, and remains constant for the lifetime of the 'Clock'.
-- 'clockGetTime' merely increments both quantities by the same amount.
-- Therefore, calling 'clockGetTime' frequently should not degrade the accuracy
-- of the clock.
data ClockData time cumtime = ClockData !cumtime !time
-- | Create a new 'Clock'. The result of 'clockGetTime' is based on the time
-- 'newClock' was called.
newClock :: IO Clock
newClock = newClockWithDriver =<< getSystemClock
-- | Return the amount of time that has elapsed since the clock was created
-- with 'newClock'.
clockGetTime :: Clock -> IO DiffTime
clockGetTime (Clock clock ref) = do
st2 <- systemClockGetTime clock
t2 <- atomicModifyIORef ref $
\(ClockData t1 st1) ->
let t2 = t1 `plus` (st2 `minus` st1)
in (ClockData t2 st2, t2)
let t2d = systemClockCumToDiff clock t2
t2 `seq` t2d `seq` return t2d
where
plus = systemClockAddCumTime clock
minus = systemClockDiffTime clock
-- | Variant of 'newClock' that uses the given driver. This can be used if you
-- want to use a different time source than the default.
--
-- @'newClock' = 'newClockWithDriver' =<< 'getSystemClock'@
newClockWithDriver :: SomeSystemClock -> IO Clock
newClockWithDriver (SomeSystemClock clock) = do
st <- systemClockGetTime clock
ref <- newIORef (ClockData (systemClockZeroCumTime clock) st)
return (Clock clock ref)
-- | Return a string identifying the time source, such as
-- @\"clock_gettime(CLOCK_MONOTONIC)\"@ or
-- @\"GetTickCount\"@.
clockDriverName :: Clock -> String
clockDriverName (Clock clock _) = systemClockName clock
-- | Variant of 'threadDelay' for 'DiffTime'.
delay :: DiffTime -> IO ()
delay difftime =
loop $ ceiling $ difftime * 1000000
where
loop :: Integer -> IO ()
loop usec
| usec <= maxWait = wait usec
| otherwise = wait maxWait
>> loop (usec - maxWait)
-- maxWait is 100 seconds. 2^31-1 microseconds is about 2147 seconds.
-- This gives the implementation of 'threadDelay' plenty of leeway if it
-- needs to do some arithmetic on the time value first.
maxWait = 100000000
wait usec = case fromIntegral usec of
n | n > 0 -> threadDelay n
| otherwise -> return ()
-- Guard against negative argument to threadDelay,
-- for earlier versions of base.
-- See http://hackage.haskell.org/trac/ghc/ticket/2892