-- | Fast access to the system clock.
module Data.Time.Clock.System
(
    systemEpochDay,
    SystemTime(..),
    truncateSystemTimeLeapSecond,
    getSystemTime,
    systemToUTCTime,
    utcToSystemTime,
    systemToTAITime,
) where

import Data.Time.Clock.Internal.AbsoluteTime
import Data.Time.Clock.Internal.DiffTime
import Data.Time.Clock.Internal.SystemTime
import Data.Time.Clock.Internal.UTCTime
import Data.Time.Calendar.Days
import Data.Int (Int64)


-- | Map leap-second values to the start of the following second.
-- The resulting 'systemNanoseconds' will always be in the range 0 to 1E9-1.
truncateSystemTimeLeapSecond :: SystemTime -> SystemTime
truncateSystemTimeLeapSecond :: SystemTime -> SystemTime
truncateSystemTimeLeapSecond (MkSystemTime Int64
seconds Word32
nanoseconds) | Word32
nanoseconds Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
1000000000 = Int64 -> Word32 -> SystemTime
MkSystemTime (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
seconds) Word32
0
truncateSystemTimeLeapSecond SystemTime
t = SystemTime
t

-- | Convert 'SystemTime' to 'UTCTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC.
systemToUTCTime :: SystemTime -> UTCTime
systemToUTCTime :: SystemTime -> UTCTime
systemToUTCTime (MkSystemTime Int64
seconds Word32
nanoseconds) = let
    days :: Int64
    timeSeconds :: Int64
    (Int64
days, Int64
timeSeconds) = Int64
seconds Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
86400

    day :: Day
    day :: Day
day = Integer -> Day -> Day
addDays (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
days) Day
systemEpochDay

    timeNanoseconds :: Int64
    timeNanoseconds :: Int64
timeNanoseconds = Int64
timeSeconds Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nanoseconds)

    timePicoseconds :: Int64
    timePicoseconds :: Int64
timePicoseconds = Int64
timeNanoseconds Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000

    time :: DiffTime
    time :: DiffTime
time = Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
timePicoseconds
    in Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
time

-- | Convert 'UTCTime' to 'SystemTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC.
utcToSystemTime :: UTCTime -> SystemTime
utcToSystemTime :: UTCTime -> SystemTime
utcToSystemTime (UTCTime Day
day DiffTime
time) = let
    days :: Int64
    days :: Int64
days = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> Integer -> Int64
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
day Day
systemEpochDay

    timePicoseconds :: Int64
    timePicoseconds :: Int64
timePicoseconds = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> Integer -> Int64
forall a b. (a -> b) -> a -> b
$ DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time

    timeNanoseconds :: Int64
    timeNanoseconds :: Int64
timeNanoseconds = Int64
timePicoseconds Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000

    timeSeconds :: Int64
    nanoseconds :: Int64
    (Int64
timeSeconds,Int64
nanoseconds) = if Int64
timeNanoseconds Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
86400000000000 then (Int64
86399,Int64
timeNanoseconds Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
86399000000000) else Int64
timeNanoseconds Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
1000000000

    seconds :: Int64
    seconds :: Int64
seconds = Int64
days Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
86400 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
timeSeconds

    in Int64 -> Word32 -> SystemTime
MkSystemTime Int64
seconds (Word32 -> SystemTime) -> Word32 -> SystemTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nanoseconds

systemEpochAbsolute :: AbsoluteTime
systemEpochAbsolute :: AbsoluteTime
systemEpochAbsolute = Day -> AbsoluteTime
taiNominalDayStart Day
systemEpochDay

-- | Convert 'SystemTime' to 'AbsoluteTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' TAI.
systemToTAITime :: SystemTime -> AbsoluteTime
systemToTAITime :: SystemTime -> AbsoluteTime
systemToTAITime (MkSystemTime Int64
s Word32
ns) = let
    diff :: DiffTime
    diff :: DiffTime
diff = (Int64 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ (Word32 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ns) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
1E-9
    in DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime DiffTime
diff AbsoluteTime
systemEpochAbsolute

-- | The day of the epoch of 'SystemTime', 1970-01-01
systemEpochDay :: Day
systemEpochDay :: Day
systemEpochDay = Integer -> Day
ModifiedJulianDay Integer
40587