/usr/lib/hugs/packages/time/Data/Time/Clock/TAI.hs is in libhugs-time-bundled 98.200609.21-5.3ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | {-# OPTIONS -Wall -Werror #-}
-- | TAI and leap-second tables for converting to UTC: most people won't need this module.
module Data.Time.Clock.TAI
(
-- TAI arithmetic
AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime,
-- leap-second table type
LeapSecondTable,
-- conversion between UTC and TAI with table
utcDayLength,utcToTAITime,taiToUTCTime,
parseTAIUTCDATFile
) where
import Data.Time.LocalTime
import Data.Time.Calendar.Days
import Data.Time.Clock
import Data.Fixed
-- | AbsoluteTime is TAI, time as measured by a clock.
newtype AbsoluteTime = MkAbsoluteTime {unAbsoluteTime :: DiffTime} deriving (Eq,Ord)
instance Show AbsoluteTime where
show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently
-- | The epoch of TAI, which is
taiEpoch :: AbsoluteTime
taiEpoch = MkAbsoluteTime 0
-- | addAbsoluteTime a b = a + b
addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime t (MkAbsoluteTime a) = MkAbsoluteTime (a + t)
-- | diffAbsoluteTime a b = a - b
diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime (MkAbsoluteTime a) (MkAbsoluteTime b) = a - b
-- | TAI - UTC during this day.
-- No table is provided, as any program compiled with it would become
-- out of date in six months.
type LeapSecondTable = Day -> Integer
utcDayLength :: LeapSecondTable -> Day -> DiffTime
utcDayLength table day = realToFrac (86400 + (table (addDays 1 day)) - (table day))
dayStart :: LeapSecondTable -> Day -> AbsoluteTime
dayStart table day = MkAbsoluteTime (realToFrac ((toModifiedJulianDay day) * 86400 + (table day)))
utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime
utcToTAITime table (UTCTime day dtime) = MkAbsoluteTime (t + dtime) where
MkAbsoluteTime t = dayStart table day
taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime
taiToUTCTime table abstime = stable (ModifiedJulianDay (div' (unAbsoluteTime abstime) 86400)) where
stable day = if (day == day') then UTCTime day dtime else stable day' where
dayt = dayStart table day
dtime = diffAbsoluteTime abstime dayt
day' = addDays (div' dtime (utcDayLength table day)) day
-- | Parse the contents of a tai-utc.dat file.
-- This does not do any kind of validation and will return a bad table for input
-- not in the correct format.
parseTAIUTCDATFile :: String -> LeapSecondTable
parseTAIUTCDATFile ss = offsetlist 0 (parse (lines ss)) where
offsetlist :: Integer -> [(Day,Integer)] -> LeapSecondTable
offsetlist i [] _ = i
offsetlist i ((d0,_):_) d | d < d0 = i
offsetlist _ ((_,i0):xx) d = offsetlist i0 xx d
parse :: [String] -> [(Day,Integer)]
parse [] = []
parse (a:as) = let
ps = parse as
in case matchLine a of
Just di -> di:ps
Nothing -> ps
matchLine :: String -> Maybe (Day,Integer)
matchLine s = do
check0S s
(d,s') <- findJD s
i <- findOffset s'
return (d,i)
-- a bit fragile
check0S :: String -> Maybe ()
check0S "X 0.0 S" = Just ()
check0S [] = Nothing
check0S (_:cs) = check0S cs
findJD :: String -> Maybe (Day,String)
findJD ('=':'J':'D':s) = do
d <- getInteger '5' s
return (ModifiedJulianDay (d - 2400000),s)
findJD [] = Nothing
findJD (_:cs) = findJD cs
findOffset :: String -> Maybe Integer
findOffset ('T':'A':'I':'-':'U':'T':'C':'=':s) = getInteger '0' s
findOffset [] = Nothing
findOffset (_:cs) = findOffset cs
getInteger :: Char -> String -> Maybe Integer
getInteger p s = do
digits <- getDigits p s
fromDigits 0 digits
getDigits :: Char -> String -> Maybe String
getDigits p (' ':s) = getDigits p s
getDigits p (c:cs) | c >= '0' && c <= '9' = do
s <- getDigits p cs
return (c:s)
getDigits p ('.':p1:_) = if p == p1 then Just [] else Nothing
getDigits _ _ = Nothing
fromDigits :: Integer -> String -> Maybe Integer
fromDigits i [] = Just i
fromDigits i (c:cs) | c >= '0' && c <= '9' = fromDigits ((i * 10) + (fromIntegral ((fromEnum c) - (fromEnum '0')))) cs
fromDigits _ _ = Nothing
-- typical line format:
-- 1972 JAN 1 =JD 2441317.5 TAI-UTC= 10.0 S + (MJD - 41317.) X 0.0 S
-- 1972 JUL 1 =JD 2441499.5 TAI-UTC= 11.0 S + (MJD - 41317.) X 0.0 S
|