1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3module Data.Time.Clock.System.Compat (
4    systemEpochDay,
5    SystemTime(..),
6    truncateSystemTimeLeapSecond,
7    getSystemTime,
8    systemToUTCTime,
9    utcToSystemTime,
10    systemToTAITime,
11    ) where
12
13import Data.Time.Orphans ()
14
15#if MIN_VERSION_time(1,8,0)
16import Data.Time.Clock.System
17#else
18
19import Control.DeepSeq (NFData (..))
20import Data.Int (Int64)
21import Data.Word (Word32)
22import Data.Typeable (Typeable)
23import Data.Data (Data)
24
25import Data.Time.Clock.TAI.Compat
26import Data.Time.Clock.POSIX
27import Data.Time.Compat
28
29-- | 'SystemTime' is time returned by system clock functions.
30-- Its semantics depends on the clock function, but the epoch is typically the beginning of 1970.
31-- Note that 'systemNanoseconds' of 1E9 to 2E9-1 can be used to represent leap seconds.
32data SystemTime = MkSystemTime
33    { systemSeconds ::     {-# UNPACK #-} !Int64
34    , systemNanoseconds :: {-# UNPACK #-} !Word32
35    } deriving (Eq,Ord,Show,Typeable,Data)
36
37instance NFData SystemTime where
38    rnf a = a `seq` ()
39
40-- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.
41-- 'getSystemTime' is typically much faster than 'getCurrentTime'.
42getSystemTime :: IO SystemTime
43
44
45-- Use gettimeofday
46getSystemTime = do
47    t <- getPOSIXTime
48    let secs = truncate t
49    let nsecs = truncate $ 1000000000 * (t - fromIntegral secs)
50    return (MkSystemTime secs nsecs)
51
52-- | Map leap-second values to the start of the following second.
53-- The resulting 'systemNanoseconds' will always be in the range 0 to 1E9-1.
54truncateSystemTimeLeapSecond :: SystemTime -> SystemTime
55truncateSystemTimeLeapSecond (MkSystemTime seconds nanoseconds) | nanoseconds >= 1000000000 = MkSystemTime (succ seconds) 0
56truncateSystemTimeLeapSecond t = t
57
58-- | Convert 'SystemTime' to 'UTCTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC.
59systemToUTCTime :: SystemTime -> UTCTime
60systemToUTCTime (MkSystemTime seconds nanoseconds) = let
61    days :: Int64
62    timeSeconds :: Int64
63    (days, timeSeconds) = seconds `divMod` 86400
64
65    day :: Day
66    day = addDays (fromIntegral days) systemEpochDay
67
68    timeNanoseconds :: Int64
69    timeNanoseconds = timeSeconds * 1000000000 + (fromIntegral nanoseconds)
70
71    timePicoseconds :: Int64
72    timePicoseconds = timeNanoseconds * 1000
73
74    time :: DiffTime
75    time = picosecondsToDiffTime $ fromIntegral timePicoseconds
76    in UTCTime day time
77
78-- | Convert 'UTCTime' to 'SystemTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC.
79utcToSystemTime :: UTCTime -> SystemTime
80utcToSystemTime (UTCTime day time) = let
81    days :: Int64
82    days = fromIntegral $ diffDays day systemEpochDay
83
84    timePicoseconds :: Int64
85    timePicoseconds = fromIntegral $ diffTimeToPicoseconds time
86
87    timeNanoseconds :: Int64
88    timeNanoseconds = timePicoseconds `div` 1000
89
90    timeSeconds :: Int64
91    nanoseconds :: Int64
92    (timeSeconds,nanoseconds) = if timeNanoseconds >= 86400000000000 then (86399,timeNanoseconds - 86399000000000) else timeNanoseconds `divMod` 1000000000
93
94    seconds :: Int64
95    seconds = days * 86400 + timeSeconds
96
97    in MkSystemTime seconds $ fromIntegral nanoseconds
98
99systemEpochAbsolute :: AbsoluteTime
100systemEpochAbsolute = taiNominalDayStart systemEpochDay
101
102-- | Convert 'SystemTime' to 'AbsoluteTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' TAI.
103systemToTAITime :: SystemTime -> AbsoluteTime
104systemToTAITime (MkSystemTime s ns) = let
105    diff :: DiffTime
106    diff = (fromIntegral s) + (fromIntegral ns) * 1E-9
107    in addAbsoluteTime diff systemEpochAbsolute
108
109-- | The day of the epoch of 'SystemTime', 1970-01-01
110systemEpochDay :: Day
111systemEpochDay = ModifiedJulianDay 40587
112
113#endif
114