{-# LINE 1 "System/Time/Monotonic/Direct.hsc" #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LINE 2 "System/Time/Monotonic/Direct.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- |
-- Module:      System.Time.Monotonic.Direct
-- Copyright:   (c) Joseph Adams 2012
-- License:     BSD3
-- Maintainer:  joeyadams3.14159@gmail.com
-- Portability: Tested on Linux and Windows
--
-- This module provides more direct access to the system's monotonic clock,
-- but provides less protection against wraparound.
--
-- More specifically, in the higher-level "System.Time.Monotonic" API,
-- 'System.Time.Monotonic.Clock' updates its internal disposition every time
-- 'System.Time.Monotonic.clockGetTime' is called.  The only way to get a
-- wraparound issue with the higher-level API is to call
-- 'System.Time.Monotonic.clockGetTime' very seldomly (e.g. less than once
-- every 24.8 days, if @GetTickCount@ is being used).
module System.Time.Monotonic.Direct (
    getSystemClock,
    SomeSystemClock(..),
    SystemClock(..),

    -- * Implementation(s)
    -- | The set of definitions below is platform-dependent.


{-# LINE 33 "System/Time/Monotonic/Direct.hsc" #-}
    systemClock_MONOTONIC,
    CTimeSpec,

{-# LINE 36 "System/Time/Monotonic/Direct.hsc" #-}
) where

import Data.Bits        (isSigned)
import Data.Int
import Data.Time.Clock  (DiffTime)
import Data.Word
import Foreign          (Ptr, FunPtr, allocaBytes, nullFunPtr, peekByteOff)


{-# LINE 48 "System/Time/Monotonic/Direct.hsc" #-}
import Foreign.C

{-# LINE 50 "System/Time/Monotonic/Direct.hsc" #-}

{-# LINE 51 "System/Time/Monotonic/Direct.hsc" #-}

-- | Existentially-quantified wrapper around 'SystemClock'
data SomeSystemClock = forall time cumtime.
                       SomeSystemClock (SystemClock time cumtime)

instance Show SomeSystemClock where
    showsPrec d (SomeSystemClock sc)
        = showParen (d > 10)
        $ showString "SomeSystemClock "
        . showsPrec 11 (systemClockName sc)

-- | A 'SystemClock' is a driver module used by 'System.Time.Monotonic.Clock'
-- to access a particular implementation of monotonic time support.
--
--  * @time@: Type of value returned by the system's time-getting function.
--
--  * @cumtime@: Type for accumulating differences between consecutive(-ish)
--    calls to 'systemClockGetTime', in case @time@ wraps around.
--    The reason we don't simply use 'DiffTime' is this: if the implementation
--    has to divide the result by a clock frequency, it could end up with a
--    number that is not an integral number of picoseconds.  Truncating to
--    'DiffTime' would lose precision, and that precision loss could add up, at
--    least in theory.
data SystemClock time cumtime = SystemClock
    { systemClockGetTime     :: IO time
    , systemClockDiffTime    :: time -> time -> cumtime
        -- ^ @systemClockDiffTime new old@ returns the amount of time that has
        -- elapsed between two calls to @systemClockGetTime@.
        --
        -- >systemClockDiffTime new old = new - old
        --
        -- This function should handle wraparound properly.  Also, bear in mind
        -- that @new@ may be earlier than @old@.  This can happen if multiple
        -- threads are accessing a 'System.Time.Monotonic.Clock'
        -- simultaneously.
        --
        -- Lastly, @systemClockDiffTime@ should not truncate precision in
        -- conversion to cumtime.  Otherwise, repeated calls to
        -- 'System.Time.Monotonic.clockGetTime' could degrade accuracy, due to
        -- lost precision adding up.
    , systemClockZeroCumTime :: cumtime
        -- ^ The number @0@.
    , systemClockAddCumTime  :: cumtime -> cumtime -> cumtime
        -- ^ Add two @cumtime@ values.  This should not overflow or lose
        -- precision.
    , systemClockCumToDiff   :: cumtime -> DiffTime
        -- ^ Convert a cumulative total of 'systemClockDiffTime' results to
        -- 'DiffTime'.  This may truncate precision if it needs to.
    , systemClockName        :: String
        -- ^ Label identifying this clock, like
        -- @\"clock_gettime(CLOCK_MONOTONIC)\"@ or
        -- @\"GetTickCount\"@.  This label is used for the 'Show'
        -- instances of 'SystemClock' and 'SomeSystemClock', and for
        -- 'System.Time.Monotonic.clockDriverName'.
    }

instance Show (SystemClock time cumtime) where
    showsPrec d sc
        = showParen (d > 10)
        $ showString "SystemClock "
        . showsPrec 11 (systemClockName sc)

-- | Return a module used for accessing the system's monotonic clock.  The
-- reason this is an 'IO' action, rather than simply a 'SystemClock' value, is
-- that the implementation may need to make a system call to determine what
-- monotonic time source to use, and how to use it.
getSystemClock :: IO SomeSystemClock

{-# LINE 125 "System/Time/Monotonic/Direct.hsc" #-}
getSystemClock =
    return $ SomeSystemClock systemClock_MONOTONIC

{-# LINE 128 "System/Time/Monotonic/Direct.hsc" #-}


{-# LINE 240 "System/Time/Monotonic/Direct.hsc" #-}

type Time_t = Int32
{-# LINE 242 "System/Time/Monotonic/Direct.hsc" #-}

data CTimeSpec = CTimeSpec
    { tv_sec    :: !Time_t
        -- ^ seconds
    , tv_nsec   :: !CLong
        -- ^ nanoseconds.  1 second = 10^9 nanoseconds
    }
    deriving Show

diffCTimeSpec :: CTimeSpec -> CTimeSpec -> DiffTime
diffCTimeSpec a b
  = diffCTime (tv_sec a) (tv_sec b)
  + fromIntegral (tv_nsec a - tv_nsec b) / 1000000000

diffCTime :: Time_t -> Time_t -> DiffTime
diffCTime a b
    | isSigned a = fromIntegral (a - b)
    | otherwise  = error "System.Time.Monotonic.Direct: time_t is unsigned"
        -- time_t is supposed to be signed on POSIX systems.
        -- If a is earlier than b, unsigned subtraction will produce an
        -- enormous result.

peekCTimeSpec :: Ptr CTimeSpec -> IO CTimeSpec
peekCTimeSpec ptr = do
    sec  <- (\hsc_ptr -> peekByteOff hsc_ptr 0)  ptr
{-# LINE 267 "System/Time/Monotonic/Direct.hsc" #-}
    nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 268 "System/Time/Monotonic/Direct.hsc" #-}
    return CTimeSpec { tv_sec  = sec
                     , tv_nsec = nsec
                     }

-- | Uses @clock_gettime@ with @CLOCK_MONOTONIC@.
--
-- /Warning:/ on Linux, this clock stops when the computer is suspended.
-- See <http://lwn.net/Articles/434239/>.
systemClock_MONOTONIC :: SystemClock CTimeSpec DiffTime
systemClock_MONOTONIC =
    SystemClock
    { systemClockGetTime     = clock_gettime 1
{-# LINE 280 "System/Time/Monotonic/Direct.hsc" #-}
    , systemClockDiffTime    = diffCTimeSpec
    , systemClockZeroCumTime = 0
    , systemClockAddCumTime  = (+)
    , systemClockCumToDiff   = id
    , systemClockName        = "clock_gettime(CLOCK_MONOTONIC)"
    }

-- CLOCK_MONOTONIC_RAW is more reliable, but requires
-- a recent kernel and glibc.
--
-- -- | @clock_gettime(CLOCK_MONOTONIC_RAW)@
-- systemClock_MONOTONIC_RAW :: SystemClock CTimeSpec
-- systemClock_MONOTONIC_RAW =
--     SystemClock
--     { systemClockGetTime    = clock_gettime #{const CLOCK_MONOTONIC_RAW}
--     , systemClockDiffTime   = diffCTimeSpec
--     , systemClockAddCumTime = (+)
--     , systemClockCumToDiff  = id
--     , systemClockName       = "clock_gettime(CLOCK_MONOTONIC_RAW)"
--     }

clock_gettime :: Int32 -> IO CTimeSpec
{-# LINE 302 "System/Time/Monotonic/Direct.hsc" #-}
clock_gettime clk_id =
    allocaBytes (8) $ \ptr -> do
{-# LINE 304 "System/Time/Monotonic/Direct.hsc" #-}
        throwErrnoIfMinus1_ "clock_gettime" $
            c_clock_gettime clk_id ptr
        peekCTimeSpec ptr

foreign import ccall "time.h clock_gettime"
    c_clock_gettime :: Int32
{-# LINE 310 "System/Time/Monotonic/Direct.hsc" #-}
                    -> Ptr CTimeSpec
                    -> IO CInt


{-# LINE 314 "System/Time/Monotonic/Direct.hsc" #-}