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