Timing.hs

{-# LANGUAGE NoImplicitPrelude #-}

-- | This modules exports types and functions related to timing.

module Imj.Timing
    ( -- * KeyTime
    {- | A wrapper type on 'SystemTime' -}
      KeyTime(..)
    , addDuration
    -- * SystemTime / DiffTime utilities
    , addToSystemTime
    , diffSystemTime
    , diffTimeSecToMicros
    , floatSecondsToDiffTime
    -- * Reexports
    , SystemTime(..)
    , DiffTime
    , getSystemTime
    ) where

import           Imj.Prelude
import           Prelude(Integer)

import           Data.Int(Int64)
import           Data.Time(DiffTime, diffTimeToPicoseconds,
                           secondsToDiffTime, picosecondsToDiffTime)
import           Data.Time.Clock.System
                          (getSystemTime, SystemTime(..) )

-- | Adds a 'DiffTime' to a 'SystemTime'
addToSystemTime :: DiffTime -> SystemTime -> SystemTime
addToSystemTime diff t =
  let d = diffTimeToSystemTime diff
  in sumSystemTimes d t

-- | Returns t1-t2
diffSystemTime :: SystemTime
               -- ^ t1
               -> SystemTime
               -- ^ t2
               -> DiffTime
diffSystemTime (MkSystemTime s1 ns1) (MkSystemTime s2 ns2) =
  let -- ns1 and ns2 are Word32, which is an unsigned type.
      -- To avoid underflowing Word32, to compute their difference, we use
      -- the next bigger signed type : Int64.
      ns1', ns2' :: Int64
      ns1' = fromIntegral ns1
      ns2' = fromIntegral ns2
      nsDiff = ns1' - ns2'
  in secondsToDiffTime (fromIntegral $ s1 - s2) +
     picosecondsToDiffTime (fromIntegral nsDiff * 1000)

sumSystemTimes :: SystemTime -> SystemTime -> SystemTime
sumSystemTimes (MkSystemTime s1 ns1) (MkSystemTime s2 ns2) =
  let s = s1 + s2
      ns = ns1 + ns2 -- no overflow, even if both contain leap seconds because 2^32 > 4 * 1000000000
      (addS, nanoseconds) = ns `quotRem` 1000000000
  in MkSystemTime (s + fromIntegral addS) nanoseconds


picoToNano :: Integer -> Integer
picoToNano i = quot i 1000

diffTimeToSystemTime :: DiffTime -> SystemTime
diffTimeToSystemTime diff =
  let nanoDiff :: Integer
      nanoDiff = picoToNano $ diffTimeToPicoseconds diff
      -- using divMod with a positive divisor,
      -- nanoseconds is guaranteed to be positive, seconds may be negative
      (seconds, nanoseconds) = nanoDiff `divMod` 1000000000
  in MkSystemTime (fromIntegral seconds) (fromIntegral nanoseconds)

-- | Represents deadlines and event times.
newtype KeyTime = KeyTime SystemTime deriving(Eq, Ord, Show)

-- | Convert a 'DiffTime' to a number of microseconds.
diffTimeSecToMicros :: DiffTime -> Int
diffTimeSecToMicros t = floor (t * 10^(6 :: Int))

microSecondsPerSecond :: Integer
microSecondsPerSecond = 1000000

-- | Converts a duration expressed in seconds using a 'Float' to a 'DiffTime'
--  which has picosecond resolution.
floatSecondsToDiffTime :: Float -> DiffTime
floatSecondsToDiffTime f = microsecondsToDiffTime $ floor (f*fromIntegral microSecondsPerSecond)

microsecondsToDiffTime :: Integer -> DiffTime
microsecondsToDiffTime x = fromRational (x % fromIntegral microSecondsPerSecond)

-- | Adds a 'DiffTime' to a 'KeyTime'.
addDuration :: DiffTime -> KeyTime -> KeyTime
addDuration durationSeconds (KeyTime t) =
  KeyTime $ addToSystemTime durationSeconds t