time 1.6.0.1 → 1.7
raw patch · 10 files changed
+121/−287 lines, 10 filesdep ~time
Dependency ranges changed: time
Files
- changelog.md +3/−0
- configure.ac +1/−1
- lib/Data/Time/Clock/TAI.hs +31/−88
- test/Test/TAI_UTC_DAT.hs +0/−42
- test/Test/TestParseDAT.hs +0/−53
- test/Test/TestParseDAT_Ref.hs +0/−95
- test/Test/TestTAI.hs +60/−0
- test/Test/TestUtil.hs +20/−0
- test/Test/Tests.hs +2/−2
- time.cabal +4/−6
changelog.md view
@@ -1,5 +1,8 @@ # Change Log +## [1.7]+- Data.Time.Clock.TAI: change LeapSecondTable to LeapSecondMap with Maybe type; remove parseTAIUTCDATFile+ ## [1.6.0.1] - Get building with earlier GHC versions - Set lower bound of base correctly
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell time package], [1.6.0.1], [ashley@semantic.org], [time])+AC_INIT([Haskell time package], [1.7], [ashley@semantic.org], [time]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h])
lib/Data/Time/Clock/TAI.hs view
@@ -1,24 +1,23 @@ {-# OPTIONS -fno-warn-unused-imports #-} #include "HsConfigure.h"--- | TAI and leap-second tables for converting to UTC: most people won't need this module.+-- | TAI and leap-second maps 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,+ -- leap-second map type+ LeapSecondMap, - -- conversion between UTC and TAI with table+ -- conversion between UTC and TAI with map utcDayLength,utcToTAITime,taiToUTCTime,-- parseTAIUTCDATFile ) where import Data.Time.LocalTime import Data.Time.Calendar.Days import Data.Time.Clock import Control.DeepSeq+import Data.Maybe import Data.Typeable import Data.Fixed #if LANGUAGE_Rank2Types@@ -26,7 +25,7 @@ #endif -- | AbsoluteTime is TAI, time as measured by a clock.-newtype AbsoluteTime = MkAbsoluteTime {unAbsoluteTime :: DiffTime} deriving (Eq,Ord+newtype AbsoluteTime = MkAbsoluteTime DiffTime deriving (Eq,Ord #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types #if HAS_DataPico@@ -40,7 +39,7 @@ rnf (MkAbsoluteTime a) = rnf a instance Show AbsoluteTime where- show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently+ show t = show (utcToLocalTime utc (fromJust (taiToUTCTime (const (Just 0)) t))) ++ " TAI" -- ugly, but standard apparently -- | The epoch of TAI, which is 1858-11-17 00:00:00 TAI. taiEpoch :: AbsoluteTime@@ -57,87 +56,31 @@ -- | 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+type LeapSecondMap = Day -> Maybe Int - 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+utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime+utcDayLength lsmap day = do+ i0 <- lsmap day+ i1 <- lsmap $ addDays 1 day+ return $ realToFrac (86400 + i1 - i0) +dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime+dayStart lsmap day = do+ i <- lsmap day+ return $ addAbsoluteTime (realToFrac $ (toModifiedJulianDay day) * 86400 + toInteger i) taiEpoch - 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+utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime+utcToTAITime lsmap (UTCTime day dtime) = do+ t <- dayStart lsmap day+ return $ addAbsoluteTime dtime t --- 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+taiToUTCTime :: LeapSecondMap -> AbsoluteTime -> Maybe UTCTime+taiToUTCTime lsmap abstime = let+ stable day = do+ dayt <- dayStart lsmap day+ len <- utcDayLength lsmap day+ let+ dtime = diffAbsoluteTime abstime dayt+ day' = addDays (div' dtime len) day+ if day == day' then return (UTCTime day dtime) else stable day'+ in stable $ ModifiedJulianDay $ div' (diffAbsoluteTime abstime taiEpoch) 86400
− test/Test/TAI_UTC_DAT.hs
@@ -1,42 +0,0 @@-module Test.TAI_UTC_DAT where--taiUTC_DAT :: String-taiUTC_DAT =- unlines- [ "1961 JAN 1 =JD 2437300.5 TAI-UTC= 1.4228180 S + (MJD - 37300.) X 0.001296 S"- , "1961 AUG 1 =JD 2437512.5 TAI-UTC= 1.3728180 S + (MJD - 37300.) X 0.001296 S"- , "1962 JAN 1 =JD 2437665.5 TAI-UTC= 1.8458580 S + (MJD - 37665.) X 0.0011232S"- , "1963 NOV 1 =JD 2438334.5 TAI-UTC= 1.9458580 S + (MJD - 37665.) X 0.0011232S"- , "1964 JAN 1 =JD 2438395.5 TAI-UTC= 3.2401300 S + (MJD - 38761.) X 0.001296 S"- , "1964 APR 1 =JD 2438486.5 TAI-UTC= 3.3401300 S + (MJD - 38761.) X 0.001296 S"- , "1964 SEP 1 =JD 2438639.5 TAI-UTC= 3.4401300 S + (MJD - 38761.) X 0.001296 S"- , "1965 JAN 1 =JD 2438761.5 TAI-UTC= 3.5401300 S + (MJD - 38761.) X 0.001296 S"- , "1965 MAR 1 =JD 2438820.5 TAI-UTC= 3.6401300 S + (MJD - 38761.) X 0.001296 S"- , "1965 JUL 1 =JD 2438942.5 TAI-UTC= 3.7401300 S + (MJD - 38761.) X 0.001296 S"- , "1965 SEP 1 =JD 2439004.5 TAI-UTC= 3.8401300 S + (MJD - 38761.) X 0.001296 S"- , "1966 JAN 1 =JD 2439126.5 TAI-UTC= 4.3131700 S + (MJD - 39126.) X 0.002592 S"- , "1968 FEB 1 =JD 2439887.5 TAI-UTC= 4.2131700 S + (MJD - 39126.) X 0.002592 S"- , "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"- , "1973 JAN 1 =JD 2441683.5 TAI-UTC= 12.0 S + (MJD - 41317.) X 0.0 S"- , "1974 JAN 1 =JD 2442048.5 TAI-UTC= 13.0 S + (MJD - 41317.) X 0.0 S"- , "1975 JAN 1 =JD 2442413.5 TAI-UTC= 14.0 S + (MJD - 41317.) X 0.0 S"- , "1976 JAN 1 =JD 2442778.5 TAI-UTC= 15.0 S + (MJD - 41317.) X 0.0 S"- , "1977 JAN 1 =JD 2443144.5 TAI-UTC= 16.0 S + (MJD - 41317.) X 0.0 S"- , "1978 JAN 1 =JD 2443509.5 TAI-UTC= 17.0 S + (MJD - 41317.) X 0.0 S"- , "1979 JAN 1 =JD 2443874.5 TAI-UTC= 18.0 S + (MJD - 41317.) X 0.0 S"- , "1980 JAN 1 =JD 2444239.5 TAI-UTC= 19.0 S + (MJD - 41317.) X 0.0 S"- , "1981 JUL 1 =JD 2444786.5 TAI-UTC= 20.0 S + (MJD - 41317.) X 0.0 S"- , "1982 JUL 1 =JD 2445151.5 TAI-UTC= 21.0 S + (MJD - 41317.) X 0.0 S"- , "1983 JUL 1 =JD 2445516.5 TAI-UTC= 22.0 S + (MJD - 41317.) X 0.0 S"- , "1985 JUL 1 =JD 2446247.5 TAI-UTC= 23.0 S + (MJD - 41317.) X 0.0 S"- , "1988 JAN 1 =JD 2447161.5 TAI-UTC= 24.0 S + (MJD - 41317.) X 0.0 S"- , "1990 JAN 1 =JD 2447892.5 TAI-UTC= 25.0 S + (MJD - 41317.) X 0.0 S"- , "1991 JAN 1 =JD 2448257.5 TAI-UTC= 26.0 S + (MJD - 41317.) X 0.0 S"- , "1992 JUL 1 =JD 2448804.5 TAI-UTC= 27.0 S + (MJD - 41317.) X 0.0 S"- , "1993 JUL 1 =JD 2449169.5 TAI-UTC= 28.0 S + (MJD - 41317.) X 0.0 S"- , "1994 JUL 1 =JD 2449534.5 TAI-UTC= 29.0 S + (MJD - 41317.) X 0.0 S"- , "1996 JAN 1 =JD 2450083.5 TAI-UTC= 30.0 S + (MJD - 41317.) X 0.0 S"- , "1997 JUL 1 =JD 2450630.5 TAI-UTC= 31.0 S + (MJD - 41317.) X 0.0 S"- , "1999 JAN 1 =JD 2451179.5 TAI-UTC= 32.0 S + (MJD - 41317.) X 0.0 S"- , "2006 JAN 1 =JD 2453736.5 TAI-UTC= 33.0 S + (MJD - 41317.) X 0.0 S" ]
− test/Test/TestParseDAT.hs
@@ -1,53 +0,0 @@-module Test.TestParseDAT where--import Data.Time-import Data.Time.Clock.TAI-import Test.TestUtil-import Test.TestParseDAT_Ref-import Test.TAI_UTC_DAT--tods :: [TimeOfDay]-tods = [- TimeOfDay 0 0 0,- TimeOfDay 0 0 0.5,- TimeOfDay 0 0 1,- TimeOfDay 0 0 1.5,- TimeOfDay 0 0 2,- TimeOfDay 23 59 28,- TimeOfDay 23 59 28.5,- TimeOfDay 23 59 29,- TimeOfDay 23 59 29.5,- TimeOfDay 23 59 30,- TimeOfDay 23 59 30.5,- TimeOfDay 23 59 31,- TimeOfDay 23 59 31.5,- TimeOfDay 23 59 32,- TimeOfDay 23 59 59,- TimeOfDay 23 59 59.5,- TimeOfDay 23 59 60,- TimeOfDay 23 59 60.5- ]--times :: [LocalTime]-times =- fmap (LocalTime (fromGregorian 1998 04 02)) tods ++- fmap (LocalTime (fromGregorian 1998 12 30)) tods ++- fmap (LocalTime (fromGregorian 1998 12 31)) tods ++- fmap (LocalTime (fromGregorian 1999 01 01)) tods ++- fmap (LocalTime (fromGregorian 1999 01 02)) tods--testParseDAT :: Test-testParseDAT = pureTest "testParseDAT" $ diff testParseDAT_Ref parseDAT where- parseDAT =- let lst = parseTAIUTCDATFile taiUTC_DAT in- unlines $ map- (\lt ->- let- utcTime = localTimeToUTC utc lt- taiTime = utcToTAITime lst utcTime- utcTime' = taiToUTCTime lst taiTime- in if utcTime == utcTime'- then unwords [show utcTime, "==", show taiTime]- else unwords [ "correction:", show utcTime, "->", show taiTime, "->", show utcTime']- )- times
− test/Test/TestParseDAT_Ref.hs
@@ -1,95 +0,0 @@-module Test.TestParseDAT_Ref where--testParseDAT_Ref :: String-testParseDAT_Ref =- unlines- [ "1998-04-02 00:00:00 UTC == 1998-04-02 00:00:31 TAI"- , "1998-04-02 00:00:00.5 UTC == 1998-04-02 00:00:31.5 TAI"- , "1998-04-02 00:00:01 UTC == 1998-04-02 00:00:32 TAI"- , "1998-04-02 00:00:01.5 UTC == 1998-04-02 00:00:32.5 TAI"- , "1998-04-02 00:00:02 UTC == 1998-04-02 00:00:33 TAI"- , "1998-04-02 23:59:28 UTC == 1998-04-02 23:59:59 TAI"- , "1998-04-02 23:59:28.5 UTC == 1998-04-02 23:59:59.5 TAI"- , "1998-04-02 23:59:29 UTC == 1998-04-03 00:00:00 TAI"- , "1998-04-02 23:59:29.5 UTC == 1998-04-03 00:00:00.5 TAI"- , "1998-04-02 23:59:30 UTC == 1998-04-03 00:00:01 TAI"- , "1998-04-02 23:59:30.5 UTC == 1998-04-03 00:00:01.5 TAI"- , "1998-04-02 23:59:31 UTC == 1998-04-03 00:00:02 TAI"- , "1998-04-02 23:59:31.5 UTC == 1998-04-03 00:00:02.5 TAI"- , "1998-04-02 23:59:32 UTC == 1998-04-03 00:00:03 TAI"- , "1998-04-02 23:59:59 UTC == 1998-04-03 00:00:30 TAI"- , "1998-04-02 23:59:59.5 UTC == 1998-04-03 00:00:30.5 TAI"- , "correction: 1998-04-02 23:59:60 UTC -> 1998-04-03 00:00:31 TAI -> 1998-04-03 00:00:00 UTC"- , "correction: 1998-04-02 23:59:60.5 UTC -> 1998-04-03 00:00:31.5 TAI -> 1998-04-03 00:00:00.5 UTC"- , "1998-12-30 00:00:00 UTC == 1998-12-30 00:00:31 TAI"- , "1998-12-30 00:00:00.5 UTC == 1998-12-30 00:00:31.5 TAI"- , "1998-12-30 00:00:01 UTC == 1998-12-30 00:00:32 TAI"- , "1998-12-30 00:00:01.5 UTC == 1998-12-30 00:00:32.5 TAI"- , "1998-12-30 00:00:02 UTC == 1998-12-30 00:00:33 TAI"- , "1998-12-30 23:59:28 UTC == 1998-12-30 23:59:59 TAI"- , "1998-12-30 23:59:28.5 UTC == 1998-12-30 23:59:59.5 TAI"- , "1998-12-30 23:59:29 UTC == 1998-12-31 00:00:00 TAI"- , "1998-12-30 23:59:29.5 UTC == 1998-12-31 00:00:00.5 TAI"- , "1998-12-30 23:59:30 UTC == 1998-12-31 00:00:01 TAI"- , "1998-12-30 23:59:30.5 UTC == 1998-12-31 00:00:01.5 TAI"- , "1998-12-30 23:59:31 UTC == 1998-12-31 00:00:02 TAI"- , "1998-12-30 23:59:31.5 UTC == 1998-12-31 00:00:02.5 TAI"- , "1998-12-30 23:59:32 UTC == 1998-12-31 00:00:03 TAI"- , "1998-12-30 23:59:59 UTC == 1998-12-31 00:00:30 TAI"- , "1998-12-30 23:59:59.5 UTC == 1998-12-31 00:00:30.5 TAI"- , "correction: 1998-12-30 23:59:60 UTC -> 1998-12-31 00:00:31 TAI -> 1998-12-31 00:00:00 UTC"- , "correction: 1998-12-30 23:59:60.5 UTC -> 1998-12-31 00:00:31.5 TAI -> 1998-12-31 00:00:00.5 UTC"- , "1998-12-31 00:00:00 UTC == 1998-12-31 00:00:31 TAI"- , "1998-12-31 00:00:00.5 UTC == 1998-12-31 00:00:31.5 TAI"- , "1998-12-31 00:00:01 UTC == 1998-12-31 00:00:32 TAI"- , "1998-12-31 00:00:01.5 UTC == 1998-12-31 00:00:32.5 TAI"- , "1998-12-31 00:00:02 UTC == 1998-12-31 00:00:33 TAI"- , "1998-12-31 23:59:28 UTC == 1998-12-31 23:59:59 TAI"- , "1998-12-31 23:59:28.5 UTC == 1998-12-31 23:59:59.5 TAI"- , "1998-12-31 23:59:29 UTC == 1999-01-01 00:00:00 TAI"- , "1998-12-31 23:59:29.5 UTC == 1999-01-01 00:00:00.5 TAI"- , "1998-12-31 23:59:30 UTC == 1999-01-01 00:00:01 TAI"- , "1998-12-31 23:59:30.5 UTC == 1999-01-01 00:00:01.5 TAI"- , "1998-12-31 23:59:31 UTC == 1999-01-01 00:00:02 TAI"- , "1998-12-31 23:59:31.5 UTC == 1999-01-01 00:00:02.5 TAI"- , "1998-12-31 23:59:32 UTC == 1999-01-01 00:00:03 TAI"- , "1998-12-31 23:59:59 UTC == 1999-01-01 00:00:30 TAI"- , "1998-12-31 23:59:59.5 UTC == 1999-01-01 00:00:30.5 TAI"- , "1998-12-31 23:59:60 UTC == 1999-01-01 00:00:31 TAI"- , "1998-12-31 23:59:60.5 UTC == 1999-01-01 00:00:31.5 TAI"- , "1999-01-01 00:00:00 UTC == 1999-01-01 00:00:32 TAI"- , "1999-01-01 00:00:00.5 UTC == 1999-01-01 00:00:32.5 TAI"- , "1999-01-01 00:00:01 UTC == 1999-01-01 00:00:33 TAI"- , "1999-01-01 00:00:01.5 UTC == 1999-01-01 00:00:33.5 TAI"- , "1999-01-01 00:00:02 UTC == 1999-01-01 00:00:34 TAI"- , "1999-01-01 23:59:28 UTC == 1999-01-02 00:00:00 TAI"- , "1999-01-01 23:59:28.5 UTC == 1999-01-02 00:00:00.5 TAI"- , "1999-01-01 23:59:29 UTC == 1999-01-02 00:00:01 TAI"- , "1999-01-01 23:59:29.5 UTC == 1999-01-02 00:00:01.5 TAI"- , "1999-01-01 23:59:30 UTC == 1999-01-02 00:00:02 TAI"- , "1999-01-01 23:59:30.5 UTC == 1999-01-02 00:00:02.5 TAI"- , "1999-01-01 23:59:31 UTC == 1999-01-02 00:00:03 TAI"- , "1999-01-01 23:59:31.5 UTC == 1999-01-02 00:00:03.5 TAI"- , "1999-01-01 23:59:32 UTC == 1999-01-02 00:00:04 TAI"- , "1999-01-01 23:59:59 UTC == 1999-01-02 00:00:31 TAI"- , "1999-01-01 23:59:59.5 UTC == 1999-01-02 00:00:31.5 TAI"- , "correction: 1999-01-01 23:59:60 UTC -> 1999-01-02 00:00:32 TAI -> 1999-01-02 00:00:00 UTC"- , "correction: 1999-01-01 23:59:60.5 UTC -> 1999-01-02 00:00:32.5 TAI -> 1999-01-02 00:00:00.5 UTC"- , "1999-01-02 00:00:00 UTC == 1999-01-02 00:00:32 TAI"- , "1999-01-02 00:00:00.5 UTC == 1999-01-02 00:00:32.5 TAI"- , "1999-01-02 00:00:01 UTC == 1999-01-02 00:00:33 TAI"- , "1999-01-02 00:00:01.5 UTC == 1999-01-02 00:00:33.5 TAI"- , "1999-01-02 00:00:02 UTC == 1999-01-02 00:00:34 TAI"- , "1999-01-02 23:59:28 UTC == 1999-01-03 00:00:00 TAI"- , "1999-01-02 23:59:28.5 UTC == 1999-01-03 00:00:00.5 TAI"- , "1999-01-02 23:59:29 UTC == 1999-01-03 00:00:01 TAI"- , "1999-01-02 23:59:29.5 UTC == 1999-01-03 00:00:01.5 TAI"- , "1999-01-02 23:59:30 UTC == 1999-01-03 00:00:02 TAI"- , "1999-01-02 23:59:30.5 UTC == 1999-01-03 00:00:02.5 TAI"- , "1999-01-02 23:59:31 UTC == 1999-01-03 00:00:03 TAI"- , "1999-01-02 23:59:31.5 UTC == 1999-01-03 00:00:03.5 TAI"- , "1999-01-02 23:59:32 UTC == 1999-01-03 00:00:04 TAI"- , "1999-01-02 23:59:59 UTC == 1999-01-03 00:00:31 TAI"- , "1999-01-02 23:59:59.5 UTC == 1999-01-03 00:00:31.5 TAI"- , "correction: 1999-01-02 23:59:60 UTC -> 1999-01-03 00:00:32 TAI -> 1999-01-03 00:00:00 UTC"- , "correction: 1999-01-02 23:59:60.5 UTC -> 1999-01-03 00:00:32.5 TAI -> 1999-01-03 00:00:00.5 UTC" ]
+ test/Test/TestTAI.hs view
@@ -0,0 +1,60 @@+module Test.TestTAI(testTAI) where++import Data.Time+import Data.Time.Clock.TAI+import Test.TestUtil+++sampleLeapSecondMap :: LeapSecondMap+sampleLeapSecondMap d | d < fromGregorian 1972 1 1 = Nothing+sampleLeapSecondMap d | d < fromGregorian 1972 7 1 = Just 10+sampleLeapSecondMap d | d < fromGregorian 1975 1 1 = Just 11+sampleLeapSecondMap _ = Nothing++testTAI :: TestTree;+testTAI = testGroup "leap second transition" $ let+ dayA = fromGregorian 1972 6 30+ dayB = fromGregorian 1972 7 1++ utcTime1 = UTCTime dayA 86399+ utcTime2 = UTCTime dayA 86400+ utcTime3 = UTCTime dayB 0++ mAbsTime1 = utcToTAITime sampleLeapSecondMap utcTime1+ mAbsTime2 = utcToTAITime sampleLeapSecondMap utcTime2+ mAbsTime3 = utcToTAITime sampleLeapSecondMap utcTime3+ in+ [+ testCase "mapping" $ do+ assertEqual "dayA" (Just 10) $ sampleLeapSecondMap dayA+ assertEqual "dayB" (Just 11) $ sampleLeapSecondMap dayB+ ,+ testCase "day length" $ do+ assertEqual "dayA" (Just 86401) $ utcDayLength sampleLeapSecondMap dayA+ assertEqual "dayB" (Just 86400) $ utcDayLength sampleLeapSecondMap dayB+ ,+ testCase "differences" $ do+ absTime1 <- assertJust mAbsTime1+ absTime2 <- assertJust mAbsTime2+ absTime3 <- assertJust mAbsTime3+ assertEqual "absTime2 - absTime1" 1 $ diffAbsoluteTime absTime2 absTime1+ assertEqual "absTime3 - absTime2" 1 $ diffAbsoluteTime absTime3 absTime2+ ,+ testGroup "round-trip"+ [+ testCase "1" $ do+ absTime <- assertJust mAbsTime1+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime1 utcTime+ ,+ testCase "2" $ do+ absTime <- assertJust mAbsTime2+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime2 utcTime+ ,+ testCase "3" $ do+ absTime <- assertJust mAbsTime3+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime3 utcTime+ ]+ ]
test/Test/TestUtil.hs view
@@ -37,3 +37,23 @@ diff expected found | expected == found = Pass diff expected found = Fail ("expected " ++ (show expected) ++ " but found " ++ (show found)) ++-- for tasty-like test code++type TestTree = Test+type Assertion = Either String ()++testCase :: String -> Assertion -> Test+testCase name (Right ()) = pureTest name Pass+testCase name (Left s) = pureTest name (Fail s)++assertFailure :: String -> Either String a+assertFailure = Left++assertEqual :: (Show a,Eq a) => String -> a -> a -> Assertion+assertEqual _ expected found | expected == found = return ()+assertEqual name expected found = assertFailure $ name ++ ": expected " ++ (show expected) ++ " but found " ++ (show found)++assertJust :: Maybe a -> Either String a+assertJust (Just a) = return a+assertJust Nothing = assertFailure "Nothing"
test/Test/Tests.hs view
@@ -10,8 +10,8 @@ import Test.TestEaster import Test.TestFormat import Test.TestMonthDay-import Test.TestParseDAT import Test.TestParseTime+import Test.TestTAI import Test.TestTime import Test.TestTimeZone import Test.TestValid@@ -25,8 +25,8 @@ , testEaster , testFormat , testMonthDay- , testParseDAT , testParseTime+ , testTAI , testTime , testTimeZone , testValid ]
time.cabal view
@@ -1,5 +1,5 @@ name: time-version: 1.6.0.1+version: 1.7 stability: stable license: BSD3 license-file: LICENSE@@ -100,7 +100,7 @@ ghc-options: -Wall -fwarn-tabs build-depends: base,- time == 1.6.0.1+ time == 1.7 main-is: ShowDefaultTZAbbreviations.hs test-suite tests@@ -122,7 +122,7 @@ build-depends: base, deepseq,- time == 1.6.0.1,+ time == 1.7, QuickCheck >= 2.5.1, test-framework >= 0.8, test-framework-quickcheck2 >= 0.3,@@ -132,9 +132,6 @@ Test.Tests Test.TestTime Test.TestTimeRef- Test.TestParseDAT- Test.TAI_UTC_DAT- Test.TestParseDAT_Ref Test.TestParseTime Test.TestMonthDay Test.TestMonthDayRef@@ -143,6 +140,7 @@ Test.TestEasterRef Test.TestCalendars Test.TestCalendarsRef+ Test.TestTAI Test.TestTimeZone Test.TestValid Test.LongWeekYears