{-# LINE 1 "System/Clock.hsc" #-}
-- | High-resolution, realtime clock and timer functions for Posix
{-# LINE 2 "System/Clock.hsc" #-}
--   systems. This module is being developed according to IEEE Std
--   1003.1-2008: <http://www.opengroup.org/onlinepubs/9699919799/>,
--   <http://www.opengroup.org/onlinepubs/9699919799/functions/clock_getres.html#>

{-# 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)


{-# LINE 36 "System/Clock.hsc" #-}

{-# LINE 37 "System/Clock.hsc" #-}
-- Due to missing define in FreeBSD 9.0 and 9.1
-- (http://lists.freebsd.org/pipermail/freebsd-stable/2013-September/075095.html).

{-# LINE 42 "System/Clock.hsc" #-}

{-# LINE 43 "System/Clock.hsc" #-}


{-# LINE 45 "System/Clock.hsc" #-}

-- | 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


{-# LINE 81 "System/Clock.hsc" #-}
    -- | (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

{-# LINE 88 "System/Clock.hsc" #-}


{-# LINE 90 "System/Clock.hsc" #-}
    -- | (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

{-# LINE 99 "System/Clock.hsc" #-}


{-# LINE 101 "System/Clock.hsc" #-}
    -- | (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

{-# LINE 106 "System/Clock.hsc" #-}


{-# LINE 108 "System/Clock.hsc" #-}
    -- | (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

{-# LINE 113 "System/Clock.hsc" #-}

  deriving (Eq, Enum, Generic, Read, Show, Typeable)


{-# LINE 129 "System/Clock.hsc" #-}
foreign import ccall clock_gettime :: Int32 -> Ptr TimeSpec -> IO ()
{-# LINE 130 "System/Clock.hsc" #-}
foreign import ccall clock_getres  :: Int32 -> Ptr TimeSpec -> IO ()
{-# LINE 131 "System/Clock.hsc" #-}

{-# LINE 132 "System/Clock.hsc" #-}


{-# LINE 141 "System/Clock.hsc" #-}
clockToConst :: Clock -> Int32
{-# LINE 142 "System/Clock.hsc" #-}
clockToConst Monotonic = 1
{-# LINE 143 "System/Clock.hsc" #-}
clockToConst  Realtime = 0
{-# LINE 144 "System/Clock.hsc" #-}
clockToConst ProcessCPUTime = 2
{-# LINE 145 "System/Clock.hsc" #-}
clockToConst  ThreadCPUTime = 3
{-# LINE 146 "System/Clock.hsc" #-}


{-# LINE 148 "System/Clock.hsc" #-}
clockToConst    MonotonicRaw = 4
{-# LINE 149 "System/Clock.hsc" #-}

{-# LINE 150 "System/Clock.hsc" #-}


{-# LINE 152 "System/Clock.hsc" #-}
clockToConst        Boottime = 7
{-# LINE 153 "System/Clock.hsc" #-}

{-# LINE 154 "System/Clock.hsc" #-}


{-# LINE 156 "System/Clock.hsc" #-}
clockToConst MonotonicCoarse = 6
{-# LINE 157 "System/Clock.hsc" #-}

{-# LINE 158 "System/Clock.hsc" #-}


{-# LINE 160 "System/Clock.hsc" #-}
clockToConst  RealtimeCoarse = 5
{-# LINE 161 "System/Clock.hsc" #-}

{-# LINE 162 "System/Clock.hsc" #-}


{-# LINE 164 "System/Clock.hsc" #-}

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


{-# LINE 185 "System/Clock.hsc" #-}
getTime clk = allocaAndPeek $! clock_gettime $! clockToConst clk

{-# LINE 187 "System/Clock.hsc" #-}


{-# LINE 196 "System/Clock.hsc" #-}
getRes clk = allocaAndPeek $! clock_getres $! clockToConst clk

{-# LINE 198 "System/Clock.hsc" #-}

-- | TimeSpec structure
data TimeSpec = TimeSpec
  { sec  :: {-# UNPACK #-} !Int64 -- ^ seconds
  , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds
  } deriving (Generic, Read, Show, Typeable)


{-# LINE 217 "System/Clock.hsc" #-}
instance Storable TimeSpec where
  sizeOf _ = (16)
{-# LINE 219 "System/Clock.hsc" #-}
  alignment _ = 8
{-# LINE 220 "System/Clock.hsc" #-}
  poke ptr ts = do
      let xs :: Int64 = fromIntegral $ sec ts
{-# LINE 222 "System/Clock.hsc" #-}
          xn :: Int64 = fromIntegral $ nsec ts
{-# LINE 223 "System/Clock.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (xs)
{-# LINE 224 "System/Clock.hsc" #-}
      (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (xn)
{-# LINE 225 "System/Clock.hsc" #-}
  peek ptr = do
      xs :: Int64 <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 227 "System/Clock.hsc" #-}
      xn :: Int64 <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 228 "System/Clock.hsc" #-}
      return $ TimeSpec (fromIntegral xs) (fromIntegral xn)

{-# LINE 230 "System/Clock.hsc" #-}

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