641b58fed19b7424922537d1515ca268c34f5949
[packages/time.git] / lib / Data / Time / Clock / TAI.hs
1 {-# OPTIONS -fno-warn-orphans #-}
2 -- | TAI and leap-second maps for converting to UTC: most people won't need this module.
3 module Data.Time.Clock.TAI
4 (
5 -- TAI arithmetic
6 module Data.Time.Clock.Internal.AbsoluteTime,
7
8 -- leap-second map type
9 LeapSecondMap,
10
11 -- conversion between UTC and TAI with map
12 utcDayLength,utcToTAITime,taiToUTCTime,
13
14 taiClock,
15 ) where
16
17 import Data.Time.Clock.Internal.AbsoluteTime
18 import Data.Time.LocalTime
19 import Data.Time.Calendar.Days
20 import Data.Time.Clock.Internal.SystemTime
21 import Data.Time.Clock.System
22 import Data.Time.Clock
23 import Data.Maybe
24 import Data.Fixed
25
26 instance Show AbsoluteTime where
27 show t = show (utcToLocalTime utc (fromJust (taiToUTCTime (const (Just 0)) t))) ++ " TAI" -- ugly, but standard apparently
28
29 -- | TAI - UTC during this day.
30 -- No table is provided, as any program compiled with it would become
31 -- out of date in six months.
32 type LeapSecondMap = Day -> Maybe Int
33
34 utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime
35 utcDayLength lsmap day = do
36 i0 <- lsmap day
37 i1 <- lsmap $ addDays 1 day
38 return $ realToFrac (86400 + i1 - i0)
39
40 dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime
41 dayStart lsmap day = do
42 i <- lsmap day
43 return $ addAbsoluteTime (realToFrac $ (toModifiedJulianDay day) * 86400 + toInteger i) taiEpoch
44
45 utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime
46 utcToTAITime lsmap (UTCTime day dtime) = do
47 t <- dayStart lsmap day
48 return $ addAbsoluteTime dtime t
49
50 taiToUTCTime :: LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
51 taiToUTCTime lsmap abstime = let
52 stable day = do
53 dayt <- dayStart lsmap day
54 len <- utcDayLength lsmap day
55 let
56 dtime = diffAbsoluteTime abstime dayt
57 day' = addDays (div' dtime len) day
58 if day == day' then return (UTCTime day dtime) else stable day'
59 in stable $ ModifiedJulianDay $ div' (diffAbsoluteTime abstime taiEpoch) 86400
60
61 -- | TAI clock, if it exists. Note that it is unlikely to be set correctly, without due care and attention.
62 taiClock :: Maybe (DiffTime,IO AbsoluteTime)
63 taiClock = fmap (fmap (fmap systemToTAITime)) getTAISystemTime