{-# LANGUAGE Safe #-}
module Data.Time.Clock.System
( systemEpochDay
, SystemTime(..)
, truncateSystemTimeLeapSecond
, getSystemTime
, systemToUTCTime
, utcToSystemTime
, systemToTAITime
) where
import Data.Int (Int64)
import Data.Time.Calendar.Days
import Data.Time.Clock.Internal.AbsoluteTime
import Data.Time.Clock.Internal.DiffTime
import Data.Time.Clock.Internal.SystemTime
import Data.Time.Clock.Internal.UTCTime
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
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
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
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
systemEpochDay :: Day
systemEpochDay :: Day
systemEpochDay = Integer -> Day
ModifiedJulianDay Integer
40587