diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,12 @@ # Change Log +## [1.8] +- Added SystemTime +- Data.Time.Format: allow padding widths in specifiers for formatting (but not parsing) +- Test: use tasty, general clean-up +- Test: separate out UNIX-specific tests, so the others can be run on Windows +- Clean up haddock. + ## [1.7.0.1] - Fix bounds issue in .cabal file diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT([Haskell time package], [1.7.0.1], [ashley@semantic.org], [time]) +AC_INIT([Haskell time package], [1.8], [ashley@semantic.org], [time]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h]) diff --git a/lib/Data/Time/Calendar/Gregorian.hs b/lib/Data/Time/Calendar/Gregorian.hs --- a/lib/Data/Time/Calendar/Gregorian.hs +++ b/lib/Data/Time/Calendar/Gregorian.hs @@ -20,27 +20,27 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31). +-- | Convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31). toGregorian :: Day -> (Integer,Int,Int) toGregorian date = (year,month,day) where (year,yd) = toOrdinalDate date (month,day) = dayOfYearToMonthAndDay (isLeapYear year) yd --- | convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). +-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will be clipped to the correct range, month first, then day. fromGregorian :: Integer -> Int -> Int -> Day fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day) --- | convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). +-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will return Nothing fromGregorianValid :: Integer -> Int -> Int -> Maybe Day fromGregorianValid year month day = do doy <- monthAndDayToDayOfYearValid (isLeapYear year) month day fromOrdinalDateValid year doy --- | show in ISO 8601 format (yyyy-mm-dd) +-- | Show in ISO 8601 format (yyyy-mm-dd) showGregorian :: Day -> String -showGregorian date = (show4 (Just '0') y) ++ "-" ++ (show2 (Just '0') m) ++ "-" ++ (show2 (Just '0') d) where +showGregorian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where (y,m,d) = toGregorian date -- | The number of days in a given month according to the proleptic Gregorian calendar. First argument is year, second is month. diff --git a/lib/Data/Time/Calendar/Julian.hs b/lib/Data/Time/Calendar/Julian.hs --- a/lib/Data/Time/Calendar/Julian.hs +++ b/lib/Data/Time/Calendar/Julian.hs @@ -15,27 +15,27 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31). +-- | Convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31). toJulian :: Day -> (Integer,Int,Int) toJulian date = (year,month,day) where (year,yd) = toJulianYearAndDay date (month,day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd --- | convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31). +-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will be clipped to the correct range, month first, then day. fromJulian :: Integer -> Int -> Int -> Day fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day) --- | convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31). +-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31). -- Invalid values will return Nothing. fromJulianValid :: Integer -> Int -> Int -> Maybe Day fromJulianValid year month day = do doy <- monthAndDayToDayOfYearValid (isJulianLeapYear year) month day fromJulianYearAndDayValid year doy --- | show in ISO 8601 format (yyyy-mm-dd) +-- | Show in ISO 8601 format (yyyy-mm-dd) showJulian :: Day -> String -showJulian date = (show4 (Just '0') y) ++ "-" ++ (show2 (Just '0') m) ++ "-" ++ (show2 (Just '0') d) where +showJulian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where (y,m,d) = toJulian date -- | The number of days in a given month according to the proleptic Julian calendar. First argument is year, second is month. diff --git a/lib/Data/Time/Calendar/JulianYearDay.hs b/lib/Data/Time/Calendar/JulianYearDay.hs --- a/lib/Data/Time/Calendar/JulianYearDay.hs +++ b/lib/Data/Time/Calendar/JulianYearDay.hs @@ -8,7 +8,7 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | convert to proleptic Julian year and day format. First element of result is year (proleptic Julian calendar), +-- | Convert to proleptic Julian year and day format. First element of result is year (proleptic Julian calendar), -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. toJulianYearAndDay :: Day -> (Integer,Int) toJulianYearAndDay (ModifiedJulianDay mjd) = (year,yd) where @@ -19,14 +19,14 @@ yd = fromInteger (d - (y * 365) + 1) year = quad * 4 + y + 1 --- | convert from proleptic Julian year and day format. +-- | Convert from proleptic Julian year and day format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). fromJulianYearAndDay :: Integer -> Int -> Day fromJulianYearAndDay year day = ModifiedJulianDay mjd where y = year - 1 mjd = (fromIntegral (clip 1 (if isJulianLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - 678578 --- | convert from proleptic Julian year and day format. +-- | Convert from proleptic Julian year and day format. -- Invalid day numbers will return Nothing fromJulianYearAndDayValid :: Integer -> Int -> Maybe Day fromJulianYearAndDayValid year day = do @@ -36,9 +36,9 @@ mjd = (fromIntegral day') + (365 * y) + (div y 4) - 678578 return (ModifiedJulianDay mjd) --- | show in proleptic Julian year and day format (yyyy-ddd) +-- | Show in proleptic Julian year and day format (yyyy-ddd) showJulianYearAndDay :: Day -> String -showJulianYearAndDay date = (show4 (Just '0') y) ++ "-" ++ (show3 (Just '0') d) where +showJulianYearAndDay date = (show4 y) ++ "-" ++ (show3 d) where (y,d) = toJulianYearAndDay date -- | Is this year a leap year according to the proleptic Julian calendar? diff --git a/lib/Data/Time/Calendar/MonthDay.hs b/lib/Data/Time/Calendar/MonthDay.hs --- a/lib/Data/Time/Calendar/MonthDay.hs +++ b/lib/Data/Time/Calendar/MonthDay.hs @@ -5,8 +5,8 @@ import Data.Time.Calendar.Private --- | convert month and day in the Gregorian or Julian calendars to day of year. --- First arg is leap year flag +-- | Convert month and day in the Gregorian or Julian calendars to day of year. +-- First arg is leap year flag. monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where month' = clip 1 12 month @@ -14,8 +14,8 @@ month'' = fromIntegral month' k = if month' <= 2 then 0 else if isLeap then -1 else -2 --- | convert month and day in the Gregorian or Julian calendars to day of year. --- First arg is leap year flag +-- | Convert month and day in the Gregorian or Julian calendars to day of year. +-- First arg is leap year flag. monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int monthAndDayToDayOfYearValid isLeap month day = do month' <- clipValid 1 12 month @@ -26,8 +26,8 @@ k = if month' <= 2 then 0 else if isLeap then -1 else -2 return ((div (367 * month'' - 362) 12) + k + day'') --- | convert day of year in the Gregorian or Julian calendars to month and day. --- First arg is leap year flag +-- | Convert day of year in the Gregorian or Julian calendars to month and day. +-- First arg is leap year flag. dayOfYearToMonthAndDay :: Bool -> Int -> (Int,Int) dayOfYearToMonthAndDay isLeap yd = findMonthDay (monthLengths isLeap) (clip 1 (if isLeap then 366 else 365) yd) @@ -35,8 +35,8 @@ findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n)) findMonthDay _ yd = (1,yd) --- | the length of a given month in the Gregorian or Julian calendars. --- First arg is leap year flag +-- | The length of a given month in the Gregorian or Julian calendars. +-- First arg is leap year flag. monthLength :: Bool -> Int -> Int monthLength isLeap month' = monthLength' isLeap (clip 1 12 month') diff --git a/lib/Data/Time/Calendar/OrdinalDate.hs b/lib/Data/Time/Calendar/OrdinalDate.hs --- a/lib/Data/Time/Calendar/OrdinalDate.hs +++ b/lib/Data/Time/Calendar/OrdinalDate.hs @@ -4,7 +4,7 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar), +-- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar), -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31. toOrdinalDate :: Day -> (Integer,Int) toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where @@ -19,15 +19,15 @@ yd = fromInteger (d - (y * 365) + 1) year = quadcent * 400 + cent * 100 + quad * 4 + y + 1 --- | convert from ISO 8601 Ordinal Date format. +-- | Convert from ISO 8601 Ordinal Date format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). fromOrdinalDate :: Integer -> Int -> Day fromOrdinalDate year day = ModifiedJulianDay mjd where y = year - 1 mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576 --- | convert from ISO 8601 Ordinal Date format. --- Invalid day numbers return Nothing +-- | Convert from ISO 8601 Ordinal Date format. +-- Invalid day numbers return 'Nothing' fromOrdinalDateValid :: Integer -> Int -> Maybe Day fromOrdinalDateValid year day = do day' <- clipValid 1 (if isLeapYear year then 366 else 365) day @@ -36,9 +36,9 @@ mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576 return (ModifiedJulianDay mjd) --- | show in ISO 8601 Ordinal Date format (yyyy-ddd) +-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd) showOrdinalDate :: Day -> String -showOrdinalDate date = (show4 (Just '0') y) ++ "-" ++ (show3 (Just '0') d) where +showOrdinalDate date = (show4 y) ++ "-" ++ (show3 d) where (y,d) = toOrdinalDate date -- | Is this year a leap year according to the proleptic Gregorian calendar? @@ -46,8 +46,8 @@ isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0)) -- | Get the number of the Monday-starting week in the year and the day of the week. --- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as \"%W\" in 'Data.Time.Format.formatTime'). --- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime'). +-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). +-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). mondayStartWeek :: Day -> (Int,Int) mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where yd = snd (toOrdinalDate date) @@ -55,8 +55,8 @@ k = d - (toInteger yd) -- | Get the number of the Sunday-starting week in the year and the day of the week. --- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as \"%U\" in 'Data.Time.Format.formatTime'). --- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime'). +-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). +-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). sundayStartWeek :: Day -> (Int,Int) sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where yd = snd (toOrdinalDate date) @@ -66,11 +66,11 @@ -- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year, -- the number of the Monday-starting week, and the day of the week. -- The first Monday is the first day of week 1, any earlier days in the year --- are week 0 (as \"%W\" in 'Data.Time.Format.formatTime'). +-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). fromMondayStartWeek :: Integer -- ^ Year. - -> Int -- ^ Monday-starting week number (as \"%W\" in 'Data.Time.Format.formatTime'). + -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime'). -> Int -- ^ Day of week. - -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime'). + -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). -> Day fromMondayStartWeek year w d = let -- first day of the year @@ -91,9 +91,9 @@ in addDays zbYearDay firstDay fromMondayStartWeekValid :: Integer -- ^ Year. - -> Int -- ^ Monday-starting week number (as \"%W\" in 'Data.Time.Format.formatTime'). + -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime'). -> Int -- ^ Day of week. - -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime'). + -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime'). -> Maybe Day fromMondayStartWeekValid year w d = do d' <- clipValid 1 7 d @@ -119,11 +119,11 @@ -- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and -- the number of the day of a Sunday-starting week. -- The first Sunday is the first day of week 1, any earlier days in the --- year are week 0 (as \"%U\" in 'Data.Time.Format.formatTime'). +-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). fromSundayStartWeek :: Integer -- ^ Year. - -> Int -- ^ Sunday-starting week number (as \"%U\" in 'Data.Time.Format.formatTime'). + -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime'). -> Int -- ^ Day of week - -- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime'). + -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). -> Day fromSundayStartWeek year w d = let -- first day of the year @@ -144,9 +144,9 @@ in addDays zbYearDay firstDay fromSundayStartWeekValid :: Integer -- ^ Year. - -> Int -- ^ Sunday-starting week number (as \"%U\" in 'Data.Time.Format.formatTime'). + -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime'). -> Int -- ^ Day of week. - -- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime'). + -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). -> Maybe Day fromSundayStartWeekValid year w d = do d' <- clipValid 0 6 d diff --git a/lib/Data/Time/Calendar/Private.hs b/lib/Data/Time/Calendar/Private.hs --- a/lib/Data/Time/Calendar/Private.hs +++ b/lib/Data/Time/Calendar/Private.hs @@ -3,35 +3,29 @@ import Data.Fixed -type NumericPadOption = Maybe Char - -pad1 :: NumericPadOption -> String -> String -pad1 (Just c) s = c:s -pad1 _ s = s +data PadOption = Pad Int Char | NoPad -padN :: Int -> Char -> String -> String -padN i _ s | i <= 0 = s -padN i c s = (replicate i c) ++ s +showPadded :: PadOption -> String -> String +showPadded NoPad s = s +showPadded (Pad i c) s = replicate (i - length s) c ++ s -show2Fixed :: NumericPadOption -> Pico -> String -show2Fixed opt x | x < 10 = pad1 opt (showFixed True x) -show2Fixed _ x = showFixed True x +showPaddedNum :: (Num t,Ord t,Show t) => PadOption -> t -> String +showPaddedNum NoPad i = show i +showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) +showPaddedNum pad i = showPadded pad $ show i -showPaddedMin :: (Num t,Ord t,Show t) => Int -> NumericPadOption -> t -> String -showPaddedMin _ Nothing i = show i -showPaddedMin pl opt i | i < 0 = '-':(showPaddedMin pl opt (negate i)) -showPaddedMin pl (Just c) i = - let s = show i in - padN (pl - (length s)) c s +show2Fixed :: Pico -> String +show2Fixed x | x < 10 = '0':(showFixed True x) +show2Fixed x = showFixed True x -show2 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String -show2 = showPaddedMin 2 +show2 :: (Num t,Ord t,Show t) => t -> String +show2 = showPaddedNum $ Pad 2 '0' -show3 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String -show3 = showPaddedMin 3 +show3 :: (Num t,Ord t,Show t) => t -> String +show3 = showPaddedNum $ Pad 3 '0' -show4 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String -show4 = showPaddedMin 4 +show4 :: (Num t,Ord t,Show t) => t -> String +show4 = showPaddedNum $ Pad 4 '0' mod100 :: (Integral i) => i -> i mod100 x = mod x 100 diff --git a/lib/Data/Time/Calendar/WeekDate.hs b/lib/Data/Time/Calendar/WeekDate.hs --- a/lib/Data/Time/Calendar/WeekDate.hs +++ b/lib/Data/Time/Calendar/WeekDate.hs @@ -5,7 +5,7 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday). +-- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday). -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday. -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year. toWeekDate :: Day -> (Integer,Int,Int) @@ -23,7 +23,7 @@ else (y0, 52) w0 -> (y0, w0) --- | convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). +-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will be clipped to the correct range. fromWeekDate :: Integer -> Int -> Int -> Day fromWeekDate y w d = ModifiedJulianDay (k - (mod k 7) + (toInteger (((clip 1 (if longYear then 53 else 52) w) * 7) + (clip 1 7 d))) - 10) where @@ -32,7 +32,7 @@ (_,53,_) -> True _ -> False --- | convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). +-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will return Nothing. fromWeekDateValid :: Integer -> Int -> Int -> Maybe Day fromWeekDateValid y w d = do @@ -46,7 +46,7 @@ k = toModifiedJulianDay (fromOrdinalDate y 6) return (ModifiedJulianDay (k - (mod k 7) + (toInteger ((w' * 7) + d')) - 10)) --- | show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). +-- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). showWeekDate :: Day -> String -showWeekDate date = (show4 (Just '0') y) ++ "-W" ++ (show2 (Just '0') w) ++ "-" ++ (show d) where +showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d) where (y,w,d) = toWeekDate date diff --git a/lib/Data/Time/Clock.hs b/lib/Data/Time/Clock.hs --- a/lib/Data/Time/Clock.hs +++ b/lib/Data/Time/Clock.hs @@ -1,15 +1,21 @@ -- | Types and functions for UTC and UT1 module Data.Time.Clock ( - module Data.Time.Clock.Scale, - module Data.Time.Clock.UTC, - module Data.Time.Clock.UTCDiff, - getCurrentTime + module Data.Time.Clock.Internal.UniversalTime, + module Data.Time.Clock.Internal.DiffTime, + module Data.Time.Clock.Internal.UTCTime, + module Data.Time.Clock.Internal.NominalDiffTime, + module Data.Time.Clock.Internal.UTCDiff, + getCurrentTime, + getTime_resolution ) where -import Data.Time.Clock.Scale -import Data.Time.Clock.UTCDiff -import Data.Time.Clock.UTC +import Data.Time.Clock.Internal.UniversalTime +import Data.Time.Clock.Internal.DiffTime +import Data.Time.Clock.Internal.SystemTime +import Data.Time.Clock.Internal.UTCDiff +import Data.Time.Clock.Internal.NominalDiffTime +import Data.Time.Clock.Internal.UTCTime import Data.Time.Clock.POSIX import Data.Time.Format.Parse() import Data.Time.LocalTime() diff --git a/lib/Data/Time/Clock/CTimespec.hsc b/lib/Data/Time/Clock/CTimespec.hsc deleted file mode 100644 --- a/lib/Data/Time/Clock/CTimespec.hsc +++ /dev/null @@ -1,41 +0,0 @@ --- #hide -module Data.Time.Clock.CTimespec where - -#include "HsTimeConfig.h" - -#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME - -#if __GLASGOW_HASKELL__ >= 709 -import Foreign -#else -import Foreign.Safe -#endif -import Foreign.C - -#include - -data CTimespec = MkCTimespec CTime CLong - -instance Storable CTimespec where - sizeOf _ = #{size struct timespec} - alignment _ = alignment (undefined :: CLong) - peek p = do - s <- #{peek struct timespec, tv_sec } p - ns <- #{peek struct timespec, tv_nsec} p - return (MkCTimespec s ns) - poke p (MkCTimespec s ns) = do - #{poke struct timespec, tv_sec } p s - #{poke struct timespec, tv_nsec} p ns - -foreign import ccall unsafe "time.h clock_gettime" - clock_gettime :: #{type clockid_t} -> Ptr CTimespec -> IO CInt - --- | Get the current POSIX time from the system clock. -getCTimespec :: IO CTimespec -getCTimespec = alloca (\ptspec -> do - throwErrnoIfMinus1_ "clock_gettime" $ - clock_gettime #{const CLOCK_REALTIME} ptspec - peek ptspec - ) - -#endif diff --git a/lib/Data/Time/Clock/CTimeval.hs b/lib/Data/Time/Clock/CTimeval.hs deleted file mode 100644 --- a/lib/Data/Time/Clock/CTimeval.hs +++ /dev/null @@ -1,36 +0,0 @@ --- #hide -module Data.Time.Clock.CTimeval where - -#ifndef mingw32_HOST_OS --- All Unix-specific, this - -#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 -import Foreign -#else -import Foreign.Safe -#endif -import Foreign.C - -data CTimeval = MkCTimeval CLong CLong - -instance Storable CTimeval where - sizeOf _ = (sizeOf (undefined :: CLong)) * 2 - alignment _ = alignment (undefined :: CLong) - peek p = do - s <- peekElemOff (castPtr p) 0 - mus <- peekElemOff (castPtr p) 1 - return (MkCTimeval s mus) - poke p (MkCTimeval s mus) = do - pokeElemOff (castPtr p) 0 s - pokeElemOff (castPtr p) 1 mus - -foreign import ccall unsafe "time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt - --- | Get the current POSIX time from the system clock. -getCTimeval :: IO CTimeval -getCTimeval = with (MkCTimeval 0 0) (\ptval -> do - throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptval nullPtr - peek ptval - ) - -#endif diff --git a/lib/Data/Time/Clock/Internal/AbsoluteTime.hs b/lib/Data/Time/Clock/Internal/AbsoluteTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/AbsoluteTime.hs @@ -0,0 +1,47 @@ +-- {-# OPTIONS -fno-warn-unused-imports #-} +#include "HsConfigure.h" +-- | TAI and leap-second maps for converting to UTC: most people won't need this module. +module Data.Time.Clock.Internal.AbsoluteTime +( + -- TAI arithmetic + AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime, + taiNominalDayStart, +) where + +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Control.DeepSeq +import Data.Time.Calendar.Days +import Data.Time.Clock.Internal.DiffTime + + +-- | AbsoluteTime is TAI, time as measured by a clock. +newtype AbsoluteTime = MkAbsoluteTime DiffTime deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + ,Data, Typeable +#endif +#endif +#endif + ) + +instance NFData AbsoluteTime where + rnf (MkAbsoluteTime a) = rnf a + +-- | The epoch of TAI, which is 1858-11-17 00:00:00 TAI. +taiEpoch :: AbsoluteTime +taiEpoch = MkAbsoluteTime 0 + +taiNominalDayStart :: Day -> AbsoluteTime +taiNominalDayStart day = MkAbsoluteTime $ realToFrac $ (toModifiedJulianDay day) * 86400 + +-- | 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 diff --git a/lib/Data/Time/Clock/Internal/CTimespec.hsc b/lib/Data/Time/Clock/Internal/CTimespec.hsc new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/CTimespec.hsc @@ -0,0 +1,76 @@ +module Data.Time.Clock.Internal.CTimespec where + +#include "HsTimeConfig.h" + +#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME + +#if __GLASGOW_HASKELL__ >= 709 +import Foreign +#else +import Foreign.Safe +#endif +import Foreign.C +import System.IO.Unsafe + +#include + +type ClockID = #{type clockid_t} + +data CTimespec = MkCTimespec CTime CLong + +instance Storable CTimespec where + sizeOf _ = #{size struct timespec} + alignment _ = alignment (undefined :: CLong) + peek p = do + s <- #{peek struct timespec, tv_sec } p + ns <- #{peek struct timespec, tv_nsec} p + return (MkCTimespec s ns) + poke p (MkCTimespec s ns) = do + #{poke struct timespec, tv_sec } p s + #{poke struct timespec, tv_nsec} p ns + +foreign import ccall unsafe "time.h clock_gettime" + clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt +foreign import ccall unsafe "time.h clock_getres" + clock_getres :: ClockID -> Ptr CTimespec -> IO CInt + +-- | Get the resolution of the given clock. +clockGetRes :: #{type clockid_t} -> IO (Either Errno CTimespec) +clockGetRes clockid = alloca $ \ptspec -> do + rc <- clock_getres clockid ptspec + case rc of + 0 -> do + res <- peek ptspec + return $ Right res + _ -> do + errno <- getErrno + return $ Left errno + +-- | Get the current time from the given clock. +clockGetTime :: ClockID -> IO CTimespec +clockGetTime clockid = alloca (\ptspec -> do + throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime clockid ptspec + peek ptspec + ) + +clock_REALTIME :: ClockID +clock_REALTIME = #{const CLOCK_REALTIME} + +clock_TAI :: ClockID +clock_TAI = #{const 11} + +realtimeRes :: CTimespec +realtimeRes = unsafePerformIO $ do + mres <- clockGetRes clock_REALTIME + case mres of + Left errno -> ioError (errnoToIOError "clock_getres" errno Nothing Nothing) + Right res -> return res + +clockResolution :: ClockID -> Maybe CTimespec +clockResolution clockid = unsafePerformIO $ do + mres <- clockGetRes clockid + case mres of + Left _ -> return Nothing + Right res -> return $ Just res + +#endif diff --git a/lib/Data/Time/Clock/Internal/CTimeval.hs b/lib/Data/Time/Clock/Internal/CTimeval.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/CTimeval.hs @@ -0,0 +1,35 @@ +module Data.Time.Clock.Internal.CTimeval where + +#ifndef mingw32_HOST_OS +-- All Unix-specific, this + +#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 +import Foreign +#else +import Foreign.Safe +#endif +import Foreign.C + +data CTimeval = MkCTimeval CLong CLong + +instance Storable CTimeval where + sizeOf _ = (sizeOf (undefined :: CLong)) * 2 + alignment _ = alignment (undefined :: CLong) + peek p = do + s <- peekElemOff (castPtr p) 0 + mus <- peekElemOff (castPtr p) 1 + return (MkCTimeval s mus) + poke p (MkCTimeval s mus) = do + pokeElemOff (castPtr p) 0 s + pokeElemOff (castPtr p) 1 mus + +foreign import ccall unsafe "time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt + +-- | Get the current POSIX time from the system clock. +getCTimeval :: IO CTimeval +getCTimeval = with (MkCTimeval 0 0) (\ptval -> do + throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptval nullPtr + peek ptval + ) + +#endif diff --git a/lib/Data/Time/Clock/Internal/DiffTime.hs b/lib/Data/Time/Clock/Internal/DiffTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/DiffTime.hs @@ -0,0 +1,100 @@ +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +{-# OPTIONS -fno-warn-unused-imports #-} +#include "HsConfigure.h" +-- #hide +module Data.Time.Clock.Internal.DiffTime + ( + -- * Absolute intervals + DiffTime, + secondsToDiffTime, + picosecondsToDiffTime, + diffTimeToPicoseconds, + ) where + +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Data.Ratio ((%)) +import Data.Fixed +import Control.DeepSeq + + +-- | This is a length of time, as measured by a clock. +-- Conversion functions will treat it as seconds. +-- It has a precision of 10^-12 s. +newtype DiffTime = MkDiffTime Pico deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + ,Data, Typeable +#else +#endif +#endif +#endif + ) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance NFData DiffTime where -- FIXME: Data.Fixed had no NFData instances yet at time of writing + rnf dt = seq dt () + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Enum DiffTime where + succ (MkDiffTime a) = MkDiffTime (succ a) + pred (MkDiffTime a) = MkDiffTime (pred a) + toEnum = MkDiffTime . toEnum + fromEnum (MkDiffTime a) = fromEnum a + enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a) + enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b) + enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b) + enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c) + +instance Show DiffTime where + show (MkDiffTime t) = (showFixed True t) ++ "s" + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Num DiffTime where + (MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b) + (MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b) + (MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b) + negate (MkDiffTime a) = MkDiffTime (negate a) + abs (MkDiffTime a) = MkDiffTime (abs a) + signum (MkDiffTime a) = MkDiffTime (signum a) + fromInteger i = MkDiffTime (fromInteger i) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Real DiffTime where + toRational (MkDiffTime a) = toRational a + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Fractional DiffTime where + (MkDiffTime a) / (MkDiffTime b) = MkDiffTime (a / b) + recip (MkDiffTime a) = MkDiffTime (recip a) + fromRational r = MkDiffTime (fromRational r) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance RealFrac DiffTime where + properFraction (MkDiffTime a) = let (b',a') = properFraction a in (b',MkDiffTime a') + truncate (MkDiffTime a) = truncate a + round (MkDiffTime a) = round a + ceiling (MkDiffTime a) = ceiling a + floor (MkDiffTime a) = floor a + +-- | Create a 'DiffTime' which represents an integral number of seconds. +secondsToDiffTime :: Integer -> DiffTime +secondsToDiffTime = fromInteger + +-- | Create a 'DiffTime' from a number of picoseconds. +picosecondsToDiffTime :: Integer -> DiffTime +picosecondsToDiffTime x = MkDiffTime (MkFixed x) + +-- | Get the number of picoseconds in a 'DiffTime'. +diffTimeToPicoseconds :: DiffTime -> Integer +diffTimeToPicoseconds (MkDiffTime (MkFixed x)) = x + +{-# RULES +"realToFrac/DiffTime->Pico" realToFrac = \ (MkDiffTime ps) -> ps +"realToFrac/Pico->DiffTime" realToFrac = MkDiffTime + #-} diff --git a/lib/Data/Time/Clock/Internal/NominalDiffTime.hs b/lib/Data/Time/Clock/Internal/NominalDiffTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/NominalDiffTime.hs @@ -0,0 +1,94 @@ +{-# OPTIONS -fno-warn-unused-imports #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +#include "HsConfigure.h" +-- #hide +module Data.Time.Clock.Internal.NominalDiffTime + ( + NominalDiffTime, + nominalDay, + ) where + +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Data.Fixed +import Data.Time.Calendar.Days +import Control.DeepSeq + + +-- | This is a length of time, as measured by UTC. +-- Conversion functions will treat it as seconds. +-- It has a precision of 10^-12 s. +-- It ignores leap-seconds, so it's not necessarily a fixed amount of clock time. +-- For instance, 23:00 UTC + 2 hours of NominalDiffTime = 01:00 UTC (+ 1 day), +-- regardless of whether a leap-second intervened. +newtype NominalDiffTime = MkNominalDiffTime Pico deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + ,Data, Typeable +#endif +#endif +#endif + ) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance NFData NominalDiffTime where -- FIXME: Data.Fixed had no NFData instances yet at time of writing + rnf ndt = seq ndt () + +instance Enum NominalDiffTime where + succ (MkNominalDiffTime a) = MkNominalDiffTime (succ a) + pred (MkNominalDiffTime a) = MkNominalDiffTime (pred a) + toEnum = MkNominalDiffTime . toEnum + fromEnum (MkNominalDiffTime a) = fromEnum a + enumFrom (MkNominalDiffTime a) = fmap MkNominalDiffTime (enumFrom a) + enumFromThen (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromThen a b) + enumFromTo (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromTo a b) + enumFromThenTo (MkNominalDiffTime a) (MkNominalDiffTime b) (MkNominalDiffTime c) = fmap MkNominalDiffTime (enumFromThenTo a b c) + +instance Show NominalDiffTime where + show (MkNominalDiffTime t) = (showFixed True t) ++ "s" + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Num NominalDiffTime where + (MkNominalDiffTime a) + (MkNominalDiffTime b) = MkNominalDiffTime (a + b) + (MkNominalDiffTime a) - (MkNominalDiffTime b) = MkNominalDiffTime (a - b) + (MkNominalDiffTime a) * (MkNominalDiffTime b) = MkNominalDiffTime (a * b) + negate (MkNominalDiffTime a) = MkNominalDiffTime (negate a) + abs (MkNominalDiffTime a) = MkNominalDiffTime (abs a) + signum (MkNominalDiffTime a) = MkNominalDiffTime (signum a) + fromInteger i = MkNominalDiffTime (fromInteger i) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Real NominalDiffTime where + toRational (MkNominalDiffTime a) = toRational a + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance Fractional NominalDiffTime where + (MkNominalDiffTime a) / (MkNominalDiffTime b) = MkNominalDiffTime (a / b) + recip (MkNominalDiffTime a) = MkNominalDiffTime (recip a) + fromRational r = MkNominalDiffTime (fromRational r) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance RealFrac NominalDiffTime where + properFraction (MkNominalDiffTime a) = (i,MkNominalDiffTime f) where + (i,f) = properFraction a + truncate (MkNominalDiffTime a) = truncate a + round (MkNominalDiffTime a) = round a + ceiling (MkNominalDiffTime a) = ceiling a + floor (MkNominalDiffTime a) = floor a + +{-# RULES +"realToFrac/DiffTime->NominalDiffTime" realToFrac = \ dt -> MkNominalDiffTime (realToFrac dt) +"realToFrac/NominalDiffTime->DiffTime" realToFrac = \ (MkNominalDiffTime ps) -> realToFrac ps + +"realToFrac/NominalDiffTime->Pico" realToFrac = \ (MkNominalDiffTime ps) -> ps +"realToFrac/Pico->NominalDiffTime" realToFrac = MkNominalDiffTime + #-} + +-- | One day in 'NominalDiffTime'. +nominalDay :: NominalDiffTime +nominalDay = 86400 diff --git a/lib/Data/Time/Clock/Internal/POSIXTime.hs b/lib/Data/Time/Clock/Internal/POSIXTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/POSIXTime.hs @@ -0,0 +1,14 @@ +module Data.Time.Clock.Internal.POSIXTime where + +import Data.Time.Clock.Internal.NominalDiffTime + + +-- | 86400 nominal seconds in every day +posixDayLength :: NominalDiffTime +posixDayLength = nominalDay + +-- | POSIX time is the nominal time since 1970-01-01 00:00 UTC +-- +-- To convert from a 'Foreign.C.CTime' or 'System.Posix.EpochTime', use 'realToFrac'. +-- +type POSIXTime = NominalDiffTime diff --git a/lib/Data/Time/Clock/Internal/SystemTime.hs b/lib/Data/Time/Clock/Internal/SystemTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/SystemTime.hs @@ -0,0 +1,94 @@ +#if __GLASGOW_HASKELL__ >= 710 +{-# OPTIONS -fno-warn-trustworthy-safe #-} +#endif +{-# LANGUAGE Trustworthy #-} +module Data.Time.Clock.Internal.SystemTime + ( + SystemTime(..), + getSystemTime, + getTime_resolution, + getTAISystemTime, + ) where + +import Data.Int (Int64) +import Data.Word +import Control.DeepSeq +import Data.Time.Clock.Internal.DiffTime + +#include "HsTimeConfig.h" + +#ifdef mingw32_HOST_OS +import qualified System.Win32.Time as Win32 +#elif HAVE_CLOCK_GETTIME +import Data.Time.Clock.Internal.CTimespec +import Foreign.C.Types (CTime(..), CLong(..)) +#else +import Data.Time.Clock.Internal.CTimeval +import Foreign.C.Types (CLong(..)) +#endif + +-------------------------------------------------------------------------------- + +-- | 'SystemTime' is time returned by system clock functions. +-- Its semantics depends on the clock function, but the epoch is typically the beginning of 1970. +-- Note that 'systemNanoseconds' of 1E9 to 2E9-1 can be used to represent leap seconds. +data SystemTime = MkSystemTime + { systemSeconds :: {-# UNPACK #-} !Int64 + , systemNanoseconds :: {-# UNPACK #-} !Word32 + } deriving (Eq,Ord,Show) + +instance NFData SystemTime where + rnf a = a `seq` () + +-- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored. +-- 'getSystemTime' is typically much faster than 'getCurrentTime'. +getSystemTime :: IO SystemTime + +-- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime' +getTime_resolution :: DiffTime + +-- | If supported, get TAI time, epoch start of 1970 TAI, with resolution. +-- This is supported only on UNIX systems, and only those with CLOCK_TAI available at run-time. +getTAISystemTime :: Maybe (DiffTime,IO SystemTime) + +#ifdef mingw32_HOST_OS +-- On Windows, the equlvalent of POSIX time is "file time", defined as +-- the number of 100-nanosecond intervals that have elapsed since +-- 12:00 A.M. January 1, 1601 (UTC). We can convert this into a POSIX +-- time by adjusting the offset to be relative to the POSIX epoch. + +getSystemTime = do + Win32.FILETIME ft <- Win32.getSystemTimeAsFileTime + let (s, us) = (ft - win32_epoch_adjust) `divMod` 10000000 + return (MkSystemTime (fromIntegral s) (fromIntegral us * 100)) + where + win32_epoch_adjust :: Word64 + win32_epoch_adjust = 116444736000000000 +getTime_resolution = 100E-9 -- 100ns +getTAISystemTime = Nothing + +#elif HAVE_CLOCK_GETTIME +-- Use hi-res clock_gettime + +timespecToSystemTime :: CTimespec -> SystemTime +timespecToSystemTime (MkCTimespec (CTime s) (CLong ns)) = (MkSystemTime (fromIntegral s) (fromIntegral ns)) + +timespecToDiffTime :: CTimespec -> DiffTime +timespecToDiffTime (MkCTimespec (CTime s) ns) = (fromIntegral s) + (fromIntegral ns) * 1E-9 + +clockGetSystemTime :: ClockID -> IO SystemTime +clockGetSystemTime clock = fmap timespecToSystemTime $ clockGetTime clock + +getSystemTime = clockGetSystemTime clock_REALTIME +getTime_resolution = timespecToDiffTime realtimeRes +getTAISystemTime = fmap (\resolution -> (timespecToDiffTime resolution,clockGetSystemTime clock_TAI)) $ clockResolution clock_TAI + +#else +-- Use gettimeofday +getSystemTime = do + MkCTimeval (CLong s) (CLong us) <- getCTimeval + return (MkSystemTime (fromIntegral s) (fromIntegral us * 1000)) +getTime_resolution = 1E-6 -- microsecond +getTAISystemTime = Nothing + +#endif diff --git a/lib/Data/Time/Clock/Internal/UTCDiff.hs b/lib/Data/Time/Clock/Internal/UTCDiff.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/UTCDiff.hs @@ -0,0 +1,14 @@ +-- #hide +module Data.Time.Clock.Internal.UTCDiff where + +import Data.Time.Clock.Internal.NominalDiffTime +import Data.Time.Clock.Internal.UTCTime +import Data.Time.Clock.POSIX + +-- | addUTCTime a b = a + b +addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime +addUTCTime x t = posixSecondsToUTCTime (x + (utcTimeToPOSIXSeconds t)) + +-- | diffUTCTime a b = a - b +diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime +diffUTCTime a b = (utcTimeToPOSIXSeconds a) - (utcTimeToPOSIXSeconds b) diff --git a/lib/Data/Time/Clock/Internal/UTCTime.hs b/lib/Data/Time/Clock/Internal/UTCTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/UTCTime.hs @@ -0,0 +1,51 @@ +#include "HsConfigure.h" +module Data.Time.Clock.Internal.UTCTime +( + -- * UTC + -- | UTC is time as measured by a clock, corrected to keep pace with the earth by adding or removing + -- occasional seconds, known as \"leap seconds\". + -- These corrections are not predictable and are announced with six month's notice. + -- No table of these corrections is provided, as any program compiled with it would become + -- out of date in six months. + -- + -- If you don't care about leap seconds, use 'UTCTime' and 'NominalDiffTime' for your clock calculations, + -- and you'll be fine. + UTCTime(..), +) where + +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Control.DeepSeq +import Data.Time.Calendar.Days +import Data.Time.Clock.Internal.DiffTime + + +-- | This is the simplest representation of UTC. +-- It consists of the day number, and a time offset from midnight. +-- Note that if a day has a leap second added to it, it will have 86401 seconds. +data UTCTime = UTCTime { + -- | the day + utctDay :: Day, + -- | the time from midnight, 0 <= t < 86401s (because of leap-seconds) + utctDayTime :: DiffTime +} +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + deriving (Data, Typeable) +#endif +#endif +#endif + +instance NFData UTCTime where + rnf (UTCTime d t) = rnf d `seq` rnf t `seq` () + +instance Eq UTCTime where + (UTCTime da ta) == (UTCTime db tb) = (da == db) && (ta == tb) + +instance Ord UTCTime where + compare (UTCTime da ta) (UTCTime db tb) = case (compare da db) of + EQ -> compare ta tb + cmp -> cmp diff --git a/lib/Data/Time/Clock/Internal/UniversalTime.hs b/lib/Data/Time/Clock/Internal/UniversalTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/Internal/UniversalTime.hs @@ -0,0 +1,28 @@ +#include "HsConfigure.h" +module Data.Time.Clock.Internal.UniversalTime + ( + -- * Universal Time + -- | Time as measured by the Earth. + UniversalTime(..), + ) where + +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Control.DeepSeq + + +-- | The Modified Julian Date is the day with the fraction of the day, measured from UT midnight. +-- It's used to represent UT1, which is time as measured by the earth's rotation, adjusted for various wobbles. +newtype UniversalTime = ModJulianDate {getModJulianDate :: Rational} deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types + ,Data, Typeable +#endif +#endif + ) + +-- necessary because H98 doesn't have "cunning newtype" derivation +instance NFData UniversalTime where + rnf (ModJulianDate a) = rnf a diff --git a/lib/Data/Time/Clock/POSIX.hs b/lib/Data/Time/Clock/POSIX.hs --- a/lib/Data/Time/Clock/POSIX.hs +++ b/lib/Data/Time/Clock/POSIX.hs @@ -2,83 +2,32 @@ -- Most people won't need this module. module Data.Time.Clock.POSIX ( - posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime + posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime, + systemToPOSIXTime, ) where -import Data.Time.Clock.UTC +import Data.Time.Clock.Internal.POSIXTime +import Data.Time.Clock.Internal.UTCTime +import Data.Time.Clock.System import Data.Time.Calendar.Days import Data.Fixed -import Control.Monad -#include "HsTimeConfig.h" - -#ifdef mingw32_HOST_OS -import Data.Word ( Word64) -import System.Win32.Time -#elif HAVE_CLOCK_GETTIME -import Data.Time.Clock.CTimespec -import Foreign.C.Types (CTime(..)) -#else -import Data.Time.Clock.CTimeval -#endif - --- | 86400 nominal seconds in every day -posixDayLength :: NominalDiffTime -posixDayLength = 86400 - --- | POSIX time is the nominal time since 1970-01-01 00:00 UTC --- --- To convert from a 'Foreign.C.CTime' or 'System.Posix.EpochTime', use 'realToFrac'. --- -type POSIXTime = NominalDiffTime - -unixEpochDay :: Day -unixEpochDay = ModifiedJulianDay 40587 - posixSecondsToUTCTime :: POSIXTime -> UTCTime posixSecondsToUTCTime i = let (d,t) = divMod' i posixDayLength - in UTCTime (addDays d unixEpochDay) (realToFrac t) + in UTCTime (addDays d systemEpochDay) (realToFrac t) utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime utcTimeToPOSIXSeconds (UTCTime d t) = - (fromInteger (diffDays d unixEpochDay) * posixDayLength) + min posixDayLength (realToFrac t) + (fromInteger (diffDays d systemEpochDay) * posixDayLength) + min posixDayLength (realToFrac t) +systemToPOSIXTime :: SystemTime -> POSIXTime +systemToPOSIXTime (MkSystemTime s ns) = (fromIntegral s) + (fromIntegral ns) * 1E-9 + -- | Get the current POSIX time from the system clock. getPOSIXTime :: IO POSIXTime - -#ifdef mingw32_HOST_OS --- On Windows, the equlvalent of POSIX time is "file time", defined as --- the number of 100-nanosecond intervals that have elapsed since --- 12:00 A.M. January 1, 1601 (UTC). We can convert this into a POSIX --- time by adjusting the offset to be relative to the POSIX epoch. - -getPOSIXTime = do - FILETIME ft <- System.Win32.Time.getSystemTimeAsFileTime - return (fromIntegral (ft - win32_epoch_adjust) / 10000000) - -win32_epoch_adjust :: Word64 -win32_epoch_adjust = 116444736000000000 - -#elif HAVE_CLOCK_GETTIME - --- Use hi-res POSIX time -ctimespecToPosixSeconds :: CTimespec -> POSIXTime -ctimespecToPosixSeconds (MkCTimespec (CTime s) ns) = - (fromIntegral s) + (fromIntegral ns) / 1000000000 - -getPOSIXTime = liftM ctimespecToPosixSeconds getCTimespec - -#else - --- Use POSIX time -ctimevalToPosixSeconds :: CTimeval -> POSIXTime -ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (fromIntegral mus) / 1000000 - -getPOSIXTime = liftM ctimevalToPosixSeconds getCTimeval - -#endif +getPOSIXTime = fmap systemToPOSIXTime getSystemTime --- | Get the current UTC time from the system clock. +-- | Get the current 'UTCTime' from the system clock. getCurrentTime :: IO UTCTime -getCurrentTime = liftM posixSecondsToUTCTime getPOSIXTime +getCurrentTime = systemToUTCTime `fmap` getSystemTime diff --git a/lib/Data/Time/Clock/Scale.hs b/lib/Data/Time/Clock/Scale.hs deleted file mode 100644 --- a/lib/Data/Time/Clock/Scale.hs +++ /dev/null @@ -1,117 +0,0 @@ -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif -{-# OPTIONS -fno-warn-unused-imports #-} -#include "HsConfigure.h" --- #hide -module Data.Time.Clock.Scale -( - -- * Universal Time - -- | Time as measured by the earth. - UniversalTime(..), - - -- * Absolute intervals - DiffTime, - secondsToDiffTime, - picosecondsToDiffTime, - diffTimeToPicoseconds, -) where - -import Control.DeepSeq -import Data.Ratio ((%)) -import Data.Fixed -import Data.Typeable -#if LANGUAGE_Rank2Types -import Data.Data -#endif - --- | The Modified Julian Date is the day with the fraction of the day, measured from UT midnight. --- It's used to represent UT1, which is time as measured by the earth's rotation, adjusted for various wobbles. -newtype UniversalTime = ModJulianDate {getModJulianDate :: Rational} deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types - ,Data, Typeable -#endif -#endif - ) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance NFData UniversalTime where - rnf (ModJulianDate a) = rnf a - --- | This is a length of time, as measured by a clock. --- Conversion functions will treat it as seconds. --- It has a precision of 10^-12 s. -newtype DiffTime = MkDiffTime Pico deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - ,Data, Typeable -#else -#endif -#endif -#endif - ) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance NFData DiffTime where -- FIXME: Data.Fixed had no NFData instances yet at time of writing - rnf dt = seq dt () - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Enum DiffTime where - succ (MkDiffTime a) = MkDiffTime (succ a) - pred (MkDiffTime a) = MkDiffTime (pred a) - toEnum = MkDiffTime . toEnum - fromEnum (MkDiffTime a) = fromEnum a - enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a) - enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b) - enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b) - enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c) - -instance Show DiffTime where - show (MkDiffTime t) = (showFixed True t) ++ "s" - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Num DiffTime where - (MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b) - (MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b) - (MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b) - negate (MkDiffTime a) = MkDiffTime (negate a) - abs (MkDiffTime a) = MkDiffTime (abs a) - signum (MkDiffTime a) = MkDiffTime (signum a) - fromInteger i = MkDiffTime (fromInteger i) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Real DiffTime where - toRational (MkDiffTime a) = toRational a - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Fractional DiffTime where - (MkDiffTime a) / (MkDiffTime b) = MkDiffTime (a / b) - recip (MkDiffTime a) = MkDiffTime (recip a) - fromRational r = MkDiffTime (fromRational r) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance RealFrac DiffTime where - properFraction (MkDiffTime a) = let (b',a') = properFraction a in (b',MkDiffTime a') - truncate (MkDiffTime a) = truncate a - round (MkDiffTime a) = round a - ceiling (MkDiffTime a) = ceiling a - floor (MkDiffTime a) = floor a - --- | Create a 'DiffTime' which represents an integral number of seconds. -secondsToDiffTime :: Integer -> DiffTime -secondsToDiffTime = fromInteger - --- | Create a 'DiffTime' from a number of picoseconds. -picosecondsToDiffTime :: Integer -> DiffTime -picosecondsToDiffTime x = MkDiffTime (MkFixed x) - --- | Get the number of picoseconds in a 'DiffTime'. -diffTimeToPicoseconds :: DiffTime -> Integer -diffTimeToPicoseconds (MkDiffTime (MkFixed x)) = x - -{-# RULES -"realToFrac/DiffTime->Pico" realToFrac = \ (MkDiffTime ps) -> ps -"realToFrac/Pico->DiffTime" realToFrac = MkDiffTime - #-} diff --git a/lib/Data/Time/Clock/System.hs b/lib/Data/Time/Clock/System.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/Clock/System.hs @@ -0,0 +1,80 @@ +-- | Fast access to the system clock. +module Data.Time.Clock.System +( + systemEpochDay, + SystemTime(..), + truncateSystemTimeLeapSecond, + getSystemTime, + systemToUTCTime, + utcToSystemTime, + systemToTAITime, +) where + +import Data.Time.Clock.Internal.AbsoluteTime +import Data.Time.Clock.Internal.DiffTime +import Data.Time.Clock.Internal.SystemTime +import Data.Time.Clock.Internal.UTCTime +import Data.Time.Calendar.Days +import Data.Int (Int64) + + +-- | Map leap-second values to the start of the following second. +-- The resulting 'systemNanoseconds' will always be in the range 0 to 1E9-1. +truncateSystemTimeLeapSecond :: SystemTime -> SystemTime +truncateSystemTimeLeapSecond (MkSystemTime seconds nanoseconds) | nanoseconds >= 1000000000 = MkSystemTime (succ seconds) 0 +truncateSystemTimeLeapSecond t = t + +-- | Convert 'SystemTime' to 'UTCTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC. +systemToUTCTime :: SystemTime -> UTCTime +systemToUTCTime (MkSystemTime seconds nanoseconds) = let + days :: Int64 + timeSeconds :: Int64 + (days, timeSeconds) = seconds `divMod` 86400 + + day :: Day + day = addDays (fromIntegral days) systemEpochDay + + timeNanoseconds :: Int64 + timeNanoseconds = timeSeconds * 1000000000 + (fromIntegral nanoseconds) + + timePicoseconds :: Int64 + timePicoseconds = timeNanoseconds * 1000 + + time :: DiffTime + time = picosecondsToDiffTime $ fromIntegral timePicoseconds + in UTCTime day time + +-- | Convert 'UTCTime' to 'SystemTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' UTC. +utcToSystemTime :: UTCTime -> SystemTime +utcToSystemTime (UTCTime day time) = let + days :: Int64 + days = fromIntegral $ diffDays day systemEpochDay + + timePicoseconds :: Int64 + timePicoseconds = fromIntegral $ diffTimeToPicoseconds time + + timeNanoseconds :: Int64 + timeNanoseconds = timePicoseconds `div` 1000 + + timeSeconds :: Int64 + nanoseconds :: Int64 + (timeSeconds,nanoseconds) = if timeNanoseconds >= 86400000000000 then (86399,timeNanoseconds - 86399000000000) else timeNanoseconds `divMod` 1000000000 + + seconds :: Int64 + seconds = days * 86400 + timeSeconds + + in MkSystemTime seconds $ fromIntegral nanoseconds + +systemEpochAbsolute :: AbsoluteTime +systemEpochAbsolute = taiNominalDayStart systemEpochDay + +-- | Convert 'SystemTime' to 'AbsoluteTime', matching zero 'SystemTime' to midnight of 'systemEpochDay' TAI. +systemToTAITime :: SystemTime -> AbsoluteTime +systemToTAITime (MkSystemTime s ns) = let + diff :: DiffTime + diff = (fromIntegral s) + (fromIntegral ns) * 1E-9 + in addAbsoluteTime diff systemEpochAbsolute + +-- | The day of the epoch of 'SystemTime', 1970-01-01 +systemEpochDay :: Day +systemEpochDay = ModifiedJulianDay 40587 diff --git a/lib/Data/Time/Clock/TAI.hs b/lib/Data/Time/Clock/TAI.hs --- a/lib/Data/Time/Clock/TAI.hs +++ b/lib/Data/Time/Clock/TAI.hs @@ -1,58 +1,32 @@ -{-# OPTIONS -fno-warn-unused-imports #-} +{-# OPTIONS -fno-warn-orphans #-} #include "HsConfigure.h" -- | 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, + module Data.Time.Clock.Internal.AbsoluteTime, -- leap-second map type LeapSecondMap, -- conversion between UTC and TAI with map utcDayLength,utcToTAITime,taiToUTCTime, + + taiClock, ) where +import Data.Time.Clock.Internal.AbsoluteTime import Data.Time.LocalTime import Data.Time.Calendar.Days +import Data.Time.Clock.Internal.SystemTime +import Data.Time.Clock.System import Data.Time.Clock -import Control.DeepSeq import Data.Maybe -import Data.Typeable import Data.Fixed -#if LANGUAGE_Rank2Types -import Data.Data -#endif --- | AbsoluteTime is TAI, time as measured by a clock. -newtype AbsoluteTime = MkAbsoluteTime DiffTime deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - ,Data, Typeable -#endif -#endif -#endif - ) - -instance NFData AbsoluteTime where - rnf (MkAbsoluteTime a) = rnf a - instance Show AbsoluteTime where 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 -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. @@ -84,3 +58,7 @@ 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 + +-- | TAI clock, if it exists. Note that it is unlikely to be set correctly, without due care and attention. +taiClock :: Maybe (DiffTime,IO AbsoluteTime) +taiClock = fmap (fmap (fmap systemToTAITime)) getTAISystemTime diff --git a/lib/Data/Time/Clock/UTC.hs b/lib/Data/Time/Clock/UTC.hs deleted file mode 100644 --- a/lib/Data/Time/Clock/UTC.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# OPTIONS -fno-warn-unused-imports #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif -#include "HsConfigure.h" --- #hide -module Data.Time.Clock.UTC -( - -- * UTC - -- | UTC is time as measured by a clock, corrected to keep pace with the earth by adding or removing - -- occasional seconds, known as \"leap seconds\". - -- These corrections are not predictable and are announced with six month's notice. - -- No table of these corrections is provided, as any program compiled with it would become - -- out of date in six months. - -- - -- If you don't care about leap seconds, use UTCTime and NominalDiffTime for your clock calculations, - -- and you'll be fine. - UTCTime(..),NominalDiffTime -) where - -import Control.DeepSeq -import Data.Time.Calendar.Days -import Data.Time.Clock.Scale -import Data.Fixed -import Data.Typeable -#if LANGUAGE_Rank2Types -import Data.Data -#endif - --- | This is the simplest representation of UTC. --- It consists of the day number, and a time offset from midnight. --- Note that if a day has a leap second added to it, it will have 86401 seconds. -data UTCTime = UTCTime { - -- | the day - utctDay :: Day, - -- | the time from midnight, 0 <= t < 86401s (because of leap-seconds) - utctDayTime :: DiffTime -} -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - deriving (Data, Typeable) -#endif -#endif -#endif - -instance NFData UTCTime where - rnf (UTCTime d t) = d `deepseq` t `deepseq` () - -instance Eq UTCTime where - (UTCTime da ta) == (UTCTime db tb) = (da == db) && (ta == tb) - -instance Ord UTCTime where - compare (UTCTime da ta) (UTCTime db tb) = case (compare da db) of - EQ -> compare ta tb - cmp -> cmp - --- | This is a length of time, as measured by UTC. --- Conversion functions will treat it as seconds. --- It has a precision of 10^-12 s. --- It ignores leap-seconds, so it's not necessarily a fixed amount of clock time. --- For instance, 23:00 UTC + 2 hours of NominalDiffTime = 01:00 UTC (+ 1 day), --- regardless of whether a leap-second intervened. -newtype NominalDiffTime = MkNominalDiffTime Pico deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - ,Data, Typeable -#endif -#endif -#endif - ) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance NFData NominalDiffTime where -- FIXME: Data.Fixed had no NFData instances yet at time of writing - rnf ndt = seq ndt () - -instance Enum NominalDiffTime where - succ (MkNominalDiffTime a) = MkNominalDiffTime (succ a) - pred (MkNominalDiffTime a) = MkNominalDiffTime (pred a) - toEnum = MkNominalDiffTime . toEnum - fromEnum (MkNominalDiffTime a) = fromEnum a - enumFrom (MkNominalDiffTime a) = fmap MkNominalDiffTime (enumFrom a) - enumFromThen (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromThen a b) - enumFromTo (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromTo a b) - enumFromThenTo (MkNominalDiffTime a) (MkNominalDiffTime b) (MkNominalDiffTime c) = fmap MkNominalDiffTime (enumFromThenTo a b c) - -instance Show NominalDiffTime where - show (MkNominalDiffTime t) = (showFixed True t) ++ "s" - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Num NominalDiffTime where - (MkNominalDiffTime a) + (MkNominalDiffTime b) = MkNominalDiffTime (a + b) - (MkNominalDiffTime a) - (MkNominalDiffTime b) = MkNominalDiffTime (a - b) - (MkNominalDiffTime a) * (MkNominalDiffTime b) = MkNominalDiffTime (a * b) - negate (MkNominalDiffTime a) = MkNominalDiffTime (negate a) - abs (MkNominalDiffTime a) = MkNominalDiffTime (abs a) - signum (MkNominalDiffTime a) = MkNominalDiffTime (signum a) - fromInteger i = MkNominalDiffTime (fromInteger i) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Real NominalDiffTime where - toRational (MkNominalDiffTime a) = toRational a - --- necessary because H98 doesn't have "cunning newtype" derivation -instance Fractional NominalDiffTime where - (MkNominalDiffTime a) / (MkNominalDiffTime b) = MkNominalDiffTime (a / b) - recip (MkNominalDiffTime a) = MkNominalDiffTime (recip a) - fromRational r = MkNominalDiffTime (fromRational r) - --- necessary because H98 doesn't have "cunning newtype" derivation -instance RealFrac NominalDiffTime where - properFraction (MkNominalDiffTime a) = (i,MkNominalDiffTime f) where - (i,f) = properFraction a - truncate (MkNominalDiffTime a) = truncate a - round (MkNominalDiffTime a) = round a - ceiling (MkNominalDiffTime a) = ceiling a - floor (MkNominalDiffTime a) = floor a - -{-# RULES -"realToFrac/DiffTime->NominalDiffTime" realToFrac = \ dt -> MkNominalDiffTime (realToFrac dt) -"realToFrac/NominalDiffTime->DiffTime" realToFrac = \ (MkNominalDiffTime ps) -> realToFrac ps - -"realToFrac/NominalDiffTime->Pico" realToFrac = \ (MkNominalDiffTime ps) -> ps -"realToFrac/Pico->NominalDiffTime" realToFrac = MkNominalDiffTime - #-} diff --git a/lib/Data/Time/Clock/UTCDiff.hs b/lib/Data/Time/Clock/UTCDiff.hs deleted file mode 100644 --- a/lib/Data/Time/Clock/UTCDiff.hs +++ /dev/null @@ -1,13 +0,0 @@ --- #hide -module Data.Time.Clock.UTCDiff where - -import Data.Time.Clock.POSIX -import Data.Time.Clock.UTC - --- | addUTCTime a b = a + b -addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime -addUTCTime x t = posixSecondsToUTCTime (x + (utcTimeToPOSIXSeconds t)) - --- | diffUTCTime a b = a - b -diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime -diffUTCTime a b = (utcTimeToPOSIXSeconds a) - (utcTimeToPOSIXSeconds b) diff --git a/lib/Data/Time/Format.hs b/lib/Data/Time/Format.hs --- a/lib/Data/Time/Format.hs +++ b/lib/Data/Time/Format.hs @@ -5,47 +5,74 @@ module Data.Time.Format.Parse ) where -import Data.Time.Format.Parse +import Data.Maybe +import Data.Char +import Data.Fixed -import Data.Time.LocalTime.TimeZone -import Data.Time.LocalTime.TimeOfDay -import Data.Time.LocalTime.LocalTime +import Data.Time.Clock.Internal.UniversalTime +import Data.Time.Clock.Internal.UTCTime +import Data.Time.Clock.POSIX import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private -import Data.Time.Clock.Scale -import Data.Time.Clock.UTC -import Data.Time.Clock.POSIX +import Data.Time.LocalTime.Internal.TimeZone +import Data.Time.LocalTime.Internal.TimeOfDay +import Data.Time.LocalTime.Internal.LocalTime +import Data.Time.LocalTime.Internal.ZonedTime +import Data.Time.Format.Parse -import Data.Maybe -import Data.Char -import Data.Fixed +type NumericPadOption = Maybe Char + +-- the weird UNIX logic is here +getPadOption :: Bool -> Bool -> Int -> Char -> Maybe NumericPadOption -> Maybe Int -> PadOption +getPadOption trunc fdef idef cdef mnpad mi = let + c = case mnpad of + Just (Just c') -> c' + Just Nothing -> ' ' + _ -> cdef + i = case mi of + Just i' -> case mnpad of + Just Nothing -> i' + _ -> if trunc then i' else max i' idef + Nothing -> idef + f = case mi of + Just _ -> True + Nothing -> case mnpad of + Nothing -> fdef + Just Nothing -> False + Just (Just _) -> True + in if f then Pad i c else NoPad + +padGeneral :: Bool -> Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) +padGeneral trunc fdef idef cdef ff locale mnpad mi = ff locale $ getPadOption trunc fdef idef cdef mnpad mi + +padString :: (TimeLocale -> t -> String) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) +padString ff = padGeneral False False 1 ' ' $ \locale pado -> showPadded pado . ff locale + +padNum :: (Show i,Ord i,Num i) => Bool -> Int -> Char -> (t -> i) -> (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) +padNum fdef idef cdef ff = padGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff + -- class FormatTime t where - formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> t -> String) + formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String) -formatChar :: (FormatTime t) => Char -> TimeLocale -> Maybe NumericPadOption -> t -> String -formatChar '%' _ _ _ = "%" -formatChar 't' _ _ _ = "\t" -formatChar 'n' _ _ _ = "\n" -formatChar c locale mpado t = case (formatCharacter c) of - Just f -> f locale mpado t - _ -> "" +formatChar :: (FormatTime t) => Char -> TimeLocale -> Maybe NumericPadOption -> Maybe Int -> t -> String +formatChar '%' = padString $ \_ _ -> "%" +formatChar 't' = padString $ \_ _ -> "\t" +formatChar 'n' = padString $ \_ _ -> "\n" +formatChar c = case formatCharacter c of + Just f -> f + _ -> \_ _ _ _ -> "" -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'. -- --- For all types (note these three are done here, not by 'formatCharacter'): --- --- [@%%@] @%@ --- --- [@%t@] tab --- --- [@%n@] newline +-- The general form is @%\\\@, where @\@ and @\@ are optional. -- --- glibc-style modifiers can be used before the letter (here marked as @z@): +-- == @\@ +-- glibc-style modifiers can be used before the specifier (here marked as @z@): -- -- [@%-z@] no padding -- @@ -57,16 +84,36 @@ -- -- [@%#z@] convert to lower case (consistently, unlike glibc) -- +-- == @\@ +-- Width digits can also be used after any modifiers and before the specifier (here marked as @z@), for example: +-- +-- [@%4z@] pad to 4 characters (with default padding character) +-- +-- [@%_12z@] pad with spaces to 12 characters +-- +-- == @\@ +-- +-- For all types (note these three are done by 'formatTime', not by 'formatCharacter'): +-- +-- [@%%@] @%@ +-- +-- [@%t@] tab +-- +-- [@%n@] newline +-- +-- === 'TimeZone' -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'): -- -- [@%z@] timezone offset in the format @-HHMM@. -- -- [@%Z@] timezone name -- +-- === 'LocalTime' -- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@) -- +-- === 'TimeOfDay' -- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%R@] same as @%H:%M@ @@ -98,6 +145,7 @@ -- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros. -- For a whole number of seconds, @%Q@ produces the empty string. -- +-- === 'UTCTime' and 'ZonedTime' -- For 'UTCTime' and 'ZonedTime': -- -- [@%s@] number of whole seconds since the Unix epoch. For times before @@ -105,6 +153,7 @@ -- the decimals are positive, not negative. For example, 0.9 seconds -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@. -- +-- === 'Day' -- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%D@] same as @%m\/%d\/%y@ @@ -131,10 +180,6 @@ -- -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@ -- --- [@%G@] year for Week Date format, no padding. Note @%0G@ and @%_G@ pad to four chars --- --- [@%g@] year of century for Week Date format, 0-padded to two chars, @00@ - @99@ --- -- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars -- -- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@ @@ -152,103 +197,146 @@ -- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@ formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String formatTime _ [] _ = "" -formatTime locale ('%':'_':c:cs) t = (formatChar c locale (Just (Just ' ')) t) ++ (formatTime locale cs t) -formatTime locale ('%':'-':c:cs) t = (formatChar c locale (Just Nothing) t) ++ (formatTime locale cs t) -formatTime locale ('%':'0':c:cs) t = (formatChar c locale (Just (Just '0')) t) ++ (formatTime locale cs t) -formatTime locale ('%':'^':c:cs) t = (fmap toUpper (formatChar c locale Nothing t)) ++ (formatTime locale cs t) -formatTime locale ('%':'#':c:cs) t = (fmap toLower (formatChar c locale Nothing t)) ++ (formatTime locale cs t) -formatTime locale ('%':c:cs) t = (formatChar c locale Nothing t) ++ (formatTime locale cs t) +formatTime locale ('%':cs) t = case formatTime1 locale cs t of + Just result -> result + Nothing -> '%':(formatTime locale cs t) formatTime locale (c:cs) t = c:(formatTime locale cs t) +formatTime1 :: (FormatTime t) => TimeLocale -> String -> t -> Maybe String +formatTime1 locale ('_':cs) t = formatTime2 locale id (Just (Just ' ')) cs t +formatTime1 locale ('-':cs) t = formatTime2 locale id (Just Nothing) cs t +formatTime1 locale ('0':cs) t = formatTime2 locale id (Just (Just '0')) cs t +formatTime1 locale ('^':cs) t = formatTime2 locale (fmap toUpper) Nothing cs t +formatTime1 locale ('#':cs) t = formatTime2 locale (fmap toLower) Nothing cs t +formatTime1 locale cs t = formatTime2 locale id Nothing cs t + +getDigit :: Char -> Maybe Int +getDigit c | c < '0' = Nothing +getDigit c | c > '9' = Nothing +getDigit c = Just $ (ord c) - (ord '0') + +pullNumber :: Maybe Int -> String -> (Maybe Int,String) +pullNumber mx [] = (mx,[]) +pullNumber mx s@(c:cs) = case getDigit c of + Just i -> pullNumber (Just $ (fromMaybe 0 mx)*10+i) cs + Nothing -> (mx,s) + +formatTime2 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe NumericPadOption -> String -> t -> Maybe String +formatTime2 locale recase mpad cs t = let + (mwidth,rest) = pullNumber Nothing cs + in formatTime3 locale recase mpad mwidth rest t + +formatTime3 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe NumericPadOption -> Maybe Int -> String -> t -> Maybe String +formatTime3 locale recase mpad mwidth (c:cs) t = Just $ (recase (formatChar c locale mpad mwidth t)) ++ (formatTime locale cs t) +formatTime3 _locale _recase _mpad _mwidth [] _t = Nothing + instance FormatTime LocalTime where - formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale)) - formatCharacter c = case (formatCharacter c) of - Just f -> Just (\locale mpado dt -> f locale mpado (localDay dt)) - Nothing -> case (formatCharacter c) of - Just f -> Just (\locale mpado dt -> f locale mpado (localTimeOfDay dt)) + formatCharacter 'c' = Just $ \locale _ _ -> formatTime locale (dateTimeFmt locale) + formatCharacter c = case formatCharacter c of + Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (localDay dt) + Nothing -> case formatCharacter c of + Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (localTimeOfDay dt) Nothing -> Nothing +todAMPM :: TimeLocale -> TimeOfDay -> String +todAMPM locale day = let + (am,pm) = amPm locale + in if (todHour day) < 12 then am else pm + +tod12Hour :: TimeOfDay -> Int +tod12Hour day = (mod (todHour day - 1) 12) + 1 + +showPaddedFixedFraction :: HasResolution a => PadOption -> Fixed a -> String +showPaddedFixedFraction pado x = let + digits = dropWhile (=='.') $ dropWhile (/='.') $ showFixed True x + n = length digits + in case pado of + NoPad -> digits + Pad i c -> if i < n + then take i digits + else digits ++ replicate (i - n) c + instance FormatTime TimeOfDay where -- Aggregate - formatCharacter 'R' = Just (\locale _ -> formatTime locale "%H:%M") - formatCharacter 'T' = Just (\locale _ -> formatTime locale "%H:%M:%S") - formatCharacter 'X' = Just (\locale _ -> formatTime locale (timeFmt locale)) - formatCharacter 'r' = Just (\locale _ -> formatTime locale (time12Fmt locale)) + formatCharacter 'R' = Just $ padString $ \locale -> formatTime locale "%H:%M" + formatCharacter 'T' = Just $ padString $ \locale -> formatTime locale "%H:%M:%S" + formatCharacter 'X' = Just $ padString $ \locale -> formatTime locale (timeFmt locale) + formatCharacter 'r' = Just $ padString $ \locale -> formatTime locale (time12Fmt locale) -- AM/PM - formatCharacter 'P' = Just (\locale _ day -> map toLower ((if (todHour day) < 12 then fst else snd) (amPm locale))) - formatCharacter 'p' = Just (\locale _ day -> (if (todHour day) < 12 then fst else snd) (amPm locale)) + formatCharacter 'P' = Just $ padString $ \locale -> map toLower . todAMPM locale + formatCharacter 'p' = Just $ padString $ \locale -> todAMPM locale -- Hour - formatCharacter 'H' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todHour) - formatCharacter 'I' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour) - formatCharacter 'k' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . todHour) - formatCharacter 'l' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour) + formatCharacter 'H' = Just $ padNum True 2 '0' todHour + formatCharacter 'I' = Just $ padNum True 2 '0' tod12Hour + formatCharacter 'k' = Just $ padNum True 2 ' ' todHour + formatCharacter 'l' = Just $ padNum True 2 ' ' tod12Hour -- Minute - formatCharacter 'M' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todMin) + formatCharacter 'M' = Just $ padNum True 2 '0' todMin -- Second - formatCharacter 'S' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt) :: Int -> String) . truncate . todSec) - formatCharacter 'q' = Just (\_ _ -> drop 1 . dropWhile (/='.') . showFixed False . todSec) - formatCharacter 'Q' = Just (\_ _ -> dropWhile (/='.') . showFixed True . todSec) + formatCharacter 'S' = Just $ padNum True 2 '0' $ (truncate . todSec :: TimeOfDay -> Int) + formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec + formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado -> ('.':) . showPaddedFixedFraction pado . todSec -- Default formatCharacter _ = Nothing instance FormatTime ZonedTime where - formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale)) - formatCharacter 's' = Just (\_ _ zt -> show (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer)) - formatCharacter c = case (formatCharacter c) of - Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeToLocalTime dt)) - Nothing -> case (formatCharacter c) of - Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeZone dt)) + formatCharacter 'c' = Just $ padString $ \locale -> formatTime locale (dateTimeFmt locale) + formatCharacter 's' = Just $ padNum True 1 '0' $ (floor . utcTimeToPOSIXSeconds . zonedTimeToUTC :: ZonedTime -> Integer) + formatCharacter c = case formatCharacter c of + Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (zonedTimeToLocalTime dt) + Nothing -> case formatCharacter c of + Just f -> Just $ \locale mpado mwidth dt -> f locale mpado mwidth (zonedTimeZone dt) Nothing -> Nothing instance FormatTime TimeZone where - formatCharacter 'z' = Just (\_ opt -> timeZoneOffsetString' (fromMaybe (Just '0') opt)) - formatCharacter 'Z' = - Just (\_ opt z -> let n = timeZoneName z - in if null n then timeZoneOffsetString' (fromMaybe (Just '0') opt) z else n) + formatCharacter 'z' = Just $ padGeneral False True 4 '0' $ \_ pado -> showPadded pado . timeZoneOffsetString'' pado + formatCharacter 'Z' = Just $ \locale mnpo mi z -> let + n = timeZoneName z + in if null n then timeZoneOffsetString'' (getPadOption False True 4 '0' mnpo mi) z else padString (\_ -> timeZoneName) locale mnpo mi z formatCharacter _ = Nothing instance FormatTime Day where -- Aggregate - formatCharacter 'D' = Just (\locale _ -> formatTime locale "%m/%d/%y") - formatCharacter 'F' = Just (\locale _ -> formatTime locale "%Y-%m-%d") - formatCharacter 'x' = Just (\locale _ -> formatTime locale (dateFmt locale)) + formatCharacter 'D' = Just $ padString $ \locale -> formatTime locale "%m/%d/%y" + formatCharacter 'F' = Just $ padString $ \locale -> formatTime locale "%Y-%m-%d" + formatCharacter 'x' = Just $ padString $ \locale -> formatTime locale (dateFmt locale) -- Year Count - formatCharacter 'Y' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . fst . toOrdinalDate) - formatCharacter 'y' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . fst . toOrdinalDate) - formatCharacter 'C' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . fst . toOrdinalDate) + formatCharacter 'Y' = Just $ padNum False 4 '0' $ fst . toOrdinalDate + formatCharacter 'y' = Just $ padNum True 2 '0' $ mod100 . fst . toOrdinalDate + formatCharacter 'C' = Just $ padNum False 2 '0' $ div100 . fst . toOrdinalDate -- Month of Year - formatCharacter 'B' = Just (\locale _ -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) - formatCharacter 'b' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) - formatCharacter 'h' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) - formatCharacter 'm' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,m,_) -> m) . toGregorian) + formatCharacter 'B' = Just $ padString $ \locale -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian + formatCharacter 'b' = Just $ padString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian + formatCharacter 'h' = Just $ padString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian + formatCharacter 'm' = Just $ padNum True 2 '0' $ (\(_,m,_) -> m) . toGregorian -- Day of Month - formatCharacter 'd' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,_,d) -> d) . toGregorian) - formatCharacter 'e' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\(_,_,d) -> d) . toGregorian) + formatCharacter 'd' = Just $ padNum True 2 '0' $ (\(_,_,d) -> d) . toGregorian + formatCharacter 'e' = Just $ padNum True 2 ' ' $ (\(_,_,d) -> d) . toGregorian -- Day of Year - formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate) + formatCharacter 'j' = Just $ padNum True 3 '0' $ snd . toOrdinalDate -- ISO 8601 Week Date - formatCharacter 'G' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . (\(y,_,_) -> y) . toWeekDate) - formatCharacter 'g' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . (\(y,_,_) -> y) . toWeekDate) - formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . (\(y,_,_) -> y) . toWeekDate) + formatCharacter 'G' = Just $ padNum False 4 '0' $ (\(y,_,_) -> y) . toWeekDate + formatCharacter 'g' = Just $ padNum True 2 '0' $ mod100 . (\(y,_,_) -> y) . toWeekDate + formatCharacter 'f' = Just $ padNum False 2 '0' $ div100 . (\(y,_,_) -> y) . toWeekDate - formatCharacter 'V' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,w,_) -> w) . toWeekDate) - formatCharacter 'u' = Just (\_ _ -> show . (\(_,_,d) -> d) . toWeekDate) + formatCharacter 'V' = Just $ padNum True 2 '0' $ (\(_,w,_) -> w) . toWeekDate + formatCharacter 'u' = Just $ padNum True 1 '0' $ (\(_,_,d) -> d) . toWeekDate -- Day of week - formatCharacter 'a' = Just (\locale _ -> snd . ((wDays locale) !!) . snd . sundayStartWeek) - formatCharacter 'A' = Just (\locale _ -> fst . ((wDays locale) !!) . snd . sundayStartWeek) - formatCharacter 'U' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . sundayStartWeek) - formatCharacter 'w' = Just (\_ _ -> show . snd . sundayStartWeek) - formatCharacter 'W' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . mondayStartWeek) + formatCharacter 'a' = Just $ padString $ \locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek + formatCharacter 'A' = Just $ padString $ \locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek + formatCharacter 'U' = Just $ padNum True 2 '0' $ fst . sundayStartWeek + formatCharacter 'w' = Just $ padNum True 1 '0' $ snd . sundayStartWeek + formatCharacter 'W' = Just $ padNum True 2 '0' $ fst . mondayStartWeek -- Default formatCharacter _ = Nothing instance FormatTime UTCTime where - formatCharacter c = fmap (\f locale mpado t -> f locale mpado (utcToZonedTime utc t)) (formatCharacter c) + formatCharacter c = fmap (\f locale mpado mwidth t -> f locale mpado mwidth (utcToZonedTime utc t)) (formatCharacter c) instance FormatTime UniversalTime where - formatCharacter c = fmap (\f locale mpado t -> f locale mpado (ut1ToLocalTime 0 t)) (formatCharacter c) + formatCharacter c = fmap (\f locale mpado mwidth t -> f locale mpado mwidth (ut1ToLocalTime 0 t)) (formatCharacter c) diff --git a/lib/Data/Time/Format/Locale.hs b/lib/Data/Time/Format/Locale.hs --- a/lib/Data/Time/Format/Locale.hs +++ b/lib/Data/Time/Format/Locale.hs @@ -11,7 +11,7 @@ ) where -import Data.Time.LocalTime.TimeZone +import Data.Time.LocalTime.Internal.TimeZone data TimeLocale = TimeLocale { diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs --- a/lib/Data/Time/Format/Parse.hs +++ b/lib/Data/Time/Format/Parse.hs @@ -15,17 +15,18 @@ ) where import Text.Read(readMaybe) +import Data.Time.Clock.Internal.UniversalTime import Data.Time.Clock.POSIX -import Data.Time.Clock.Scale -import Data.Time.Clock.UTC +import Data.Time.Clock.Internal.UTCTime import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Data.Time.Calendar.Private(clipValid) -import Data.Time.LocalTime.TimeZone -import Data.Time.LocalTime.TimeOfDay -import Data.Time.LocalTime.LocalTime +import Data.Time.LocalTime.Internal.TimeZone +import Data.Time.LocalTime.Internal.TimeOfDay +import Data.Time.LocalTime.Internal.LocalTime +import Data.Time.LocalTime.Internal.ZonedTime #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>),(<*>)) @@ -75,8 +76,8 @@ #if LANGUAGE_Rank2Types -- | Parses a time value given a format string. --- Supports the same %-codes as 'formatTime', including @%-@, @%_@ and @%0@ modifiers. --- Case is not significant. +-- Supports the same %-codes as 'formatTime', including @%-@, @%_@ and @%0@ modifiers, however padding widths are not supported. +-- Case is not significant in the input string. -- Some variations in the input are accepted: -- -- [@%z@] accepts any of @-HHMM@ or @-HH:MM@. diff --git a/lib/Data/Time/LocalTime.hs b/lib/Data/Time/LocalTime.hs --- a/lib/Data/Time/LocalTime.hs +++ b/lib/Data/Time/LocalTime.hs @@ -1,11 +1,18 @@ module Data.Time.LocalTime ( - module Data.Time.LocalTime.TimeZone, - module Data.Time.LocalTime.TimeOfDay, - module Data.Time.LocalTime.LocalTime + -- * Time zones + TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc, + + -- getting the locale time zone + getTimeZone,getCurrentTimeZone, + + module Data.Time.LocalTime.Internal.TimeOfDay, + module Data.Time.LocalTime.Internal.LocalTime, + module Data.Time.LocalTime.Internal.ZonedTime, ) where import Data.Time.Format() -import Data.Time.LocalTime.TimeZone -import Data.Time.LocalTime.TimeOfDay -import Data.Time.LocalTime.LocalTime +import Data.Time.LocalTime.Internal.TimeZone hiding (timeZoneOffsetString'') +import Data.Time.LocalTime.Internal.TimeOfDay +import Data.Time.LocalTime.Internal.LocalTime +import Data.Time.LocalTime.Internal.ZonedTime diff --git a/lib/Data/Time/LocalTime/Internal/LocalTime.hs b/lib/Data/Time/LocalTime/Internal/LocalTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/LocalTime/Internal/LocalTime.hs @@ -0,0 +1,75 @@ +{-# OPTIONS -fno-warn-orphans #-} +#include "HsConfigure.h" + +-- #hide +module Data.Time.LocalTime.Internal.LocalTime +( + -- * Local Time + LocalTime(..), + + -- converting UTC and UT1 times to LocalTime + utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1, +) where + + + +import Control.DeepSeq +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Data.Time.Calendar.Days +import Data.Time.Calendar.Gregorian +import Data.Time.Clock.Internal.UniversalTime +import Data.Time.Clock.Internal.UTCTime +import Data.Time.LocalTime.Internal.TimeOfDay +import Data.Time.LocalTime.Internal.TimeZone + + +-- | A simple day and time aggregate, where the day is of the specified parameter, +-- and the time is a TimeOfDay. +-- Conversion of this (as local civil time) to UTC depends on the time zone. +-- Conversion of this (as local mean time) to UT1 depends on the longitude. +data LocalTime = LocalTime { + localDay :: Day, + localTimeOfDay :: TimeOfDay +} deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + ,Data, Typeable +#endif +#endif +#endif + ) + +instance NFData LocalTime where + rnf (LocalTime d t) = rnf d `seq` rnf t `seq` () + +instance Show LocalTime where + show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t) + +-- | Get the local time of a UTC time in a time zone. +utcToLocalTime :: TimeZone -> UTCTime -> LocalTime +utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod where + (i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt) + +-- | Get the UTC time of a local time in a time zone. +localTimeToUTC :: TimeZone -> LocalTime -> UTCTime +localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC) where + (i,todUTC) = localToUTCTimeOfDay tz tod + +-- | Get the local time of a UT1 time on a particular meridian (in degrees, positive is East). +ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime +ut1ToLocalTime long (ModJulianDate date) = LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset) where + localTime = date + long / 360 :: Rational + localMJD = floor localTime + localToDOffset = localTime - (fromIntegral localMJD) + +-- | Get the UT1 time of a local time on a particular meridian (in degrees, positive is East). +localTimeToUT1 :: Rational -> LocalTime -> UniversalTime +localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) = ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360)) + +-- orphan instance +instance Show UniversalTime where + show t = show (ut1ToLocalTime 0 t) diff --git a/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs b/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs @@ -0,0 +1,98 @@ +{-# OPTIONS -fno-warn-unused-imports #-} +#include "HsConfigure.h" +-- #hide +module Data.Time.LocalTime.Internal.TimeOfDay +( + -- * Time of day + TimeOfDay(..),midnight,midday,makeTimeOfDayValid, + utcToLocalTimeOfDay,localToUTCTimeOfDay, + timeToTimeOfDay,timeOfDayToTime, + dayFractionToTimeOfDay,timeOfDayToDayFraction +) where + +import Control.DeepSeq +import Data.Typeable +import Data.Fixed +#if LANGUAGE_Rank2Types +import Data.Data +#endif +import Data.Time.Clock.Internal.DiffTime +import Data.Time.Calendar.Private +import Data.Time.LocalTime.Internal.TimeZone + + +-- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. +data TimeOfDay = TimeOfDay { + -- | range 0 - 23 + todHour :: Int, + -- | range 0 - 59 + todMin :: Int, + -- | Note that 0 <= 'todSec' < 61, accomodating leap seconds. + -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously + todSec :: Pico +} deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + ,Data, Typeable +#endif +#endif +#endif + ) + +instance NFData TimeOfDay where + rnf (TimeOfDay h m s) = rnf h `seq` rnf m `seq` s `seq` () -- FIXME: Data.Fixed had no NFData instances yet at time of writing + +-- | Hour zero +midnight :: TimeOfDay +midnight = TimeOfDay 0 0 0 + +-- | Hour twelve +midday :: TimeOfDay +midday = TimeOfDay 12 0 0 + +instance Show TimeOfDay where + show (TimeOfDay h m s) = (show2 h) ++ ":" ++ (show2 m) ++ ":" ++ (show2Fixed s) + +makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay +makeTimeOfDayValid h m s = do + _ <- clipValid 0 23 h + _ <- clipValid 0 59 m + _ <- clipValid 0 60.999999999999 s + return (TimeOfDay h m s) + +-- | Convert a time of day in UTC to a time of day in some timezone, together with a day adjustment. +utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) +utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where + m' = m + timeZoneMinutes zone + h' = h + (div m' 60) + +-- | Convert a time of day in some timezone to a time of day in UTC, together with a day adjustment. +localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) +localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimeZone (negate (timeZoneMinutes zone))) + +posixDayLength :: DiffTime +posixDayLength = fromInteger 86400 + +-- | Get the time of day given a time since midnight. +-- Time more than 24h will be converted to leap-seconds. +timeToTimeOfDay :: DiffTime -> TimeOfDay +timeToTimeOfDay dt | dt >= posixDayLength = TimeOfDay 23 59 (60 + (realToFrac (dt - posixDayLength))) +timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) s where + s' = realToFrac dt + s = mod' s' 60 + m' = div' s' 60 + m = mod' m' 60 + h = div' m' 60 + +-- | Get the time since midnight for a given time of day. +timeOfDayToTime :: TimeOfDay -> DiffTime +timeOfDayToTime (TimeOfDay h m s) = ((fromIntegral h) * 60 + (fromIntegral m)) * 60 + (realToFrac s) + +-- | Get the time of day given the fraction of a day since midnight. +dayFractionToTimeOfDay :: Rational -> TimeOfDay +dayFractionToTimeOfDay df = timeToTimeOfDay (realToFrac (df * 86400)) + +-- | Get the fraction of a day since midnight given a time of day. +timeOfDayToDayFraction :: TimeOfDay -> Rational +timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod) / realToFrac posixDayLength diff --git a/lib/Data/Time/LocalTime/Internal/TimeZone.hs b/lib/Data/Time/LocalTime/Internal/TimeZone.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/LocalTime/Internal/TimeZone.hs @@ -0,0 +1,109 @@ +{-# OPTIONS -fno-warn-unused-imports #-} +{-# LANGUAGE ForeignFunctionInterface #-} +#include "HsConfigure.h" + +-- #hide +module Data.Time.LocalTime.Internal.TimeZone +( + -- * Time zones + TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',timeZoneOffsetString'',minutesToTimeZone,hoursToTimeZone,utc, + + -- getting the locale time zone + getTimeZone,getCurrentTimeZone +) where + +--import System.Time.Calendar.Format +import Data.Time.Calendar.Private +import Data.Time.Clock.System +import Data.Time.Clock.POSIX +import Data.Time.Clock.Internal.UTCTime + +#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 +import Foreign +#else +import Foreign.Safe +#endif +import Foreign.C +import Control.DeepSeq +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif + +-- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag. +data TimeZone = TimeZone { + -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC. + timeZoneMinutes :: Int, + -- | Is this time zone just persisting for the summer? + timeZoneSummerOnly :: Bool, + -- | The name of the zone, typically a three- or four-letter acronym. + timeZoneName :: String +} deriving (Eq,Ord +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types + ,Data, Typeable +#endif +#endif + ) + +instance NFData TimeZone where + rnf (TimeZone m so n) = rnf m `seq` rnf so `seq` rnf n `seq` () + +-- | Create a nameless non-summer timezone for this number of minutes. +minutesToTimeZone :: Int -> TimeZone +minutesToTimeZone m = TimeZone m False "" + +-- | Create a nameless non-summer timezone for this number of hours. +hoursToTimeZone :: Int -> TimeZone +hoursToTimeZone i = minutesToTimeZone (60 * i) + +showT :: PadOption -> Int -> String +showT opt t = showPaddedNum opt ((div t 60) * 100 + (mod t 60)) + +timeZoneOffsetString'' :: PadOption -> TimeZone -> String +timeZoneOffsetString'' opt (TimeZone t _ _) | t < 0 = '-':(showT opt (negate t)) +timeZoneOffsetString'' opt (TimeZone t _ _) = '+':(showT opt t) + +-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime), with arbitrary padding. +timeZoneOffsetString' :: Maybe Char -> TimeZone -> String +timeZoneOffsetString' Nothing = timeZoneOffsetString'' NoPad +timeZoneOffsetString' (Just c) = timeZoneOffsetString'' $ Pad 4 c + +-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime). +timeZoneOffsetString :: TimeZone -> String +timeZoneOffsetString = timeZoneOffsetString'' (Pad 4 '0') + +instance Show TimeZone where + show zone@(TimeZone _ _ "") = timeZoneOffsetString zone + show (TimeZone _ _ name) = name + +-- | The UTC time zone. +utc :: TimeZone +utc = TimeZone 0 False "UTC" + +{-# CFILES cbits/HsTime.c #-} +foreign import ccall unsafe "HsTime.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> Ptr CString -> IO CLong + +getTimeZoneCTime :: CTime -> IO TimeZone +getTimeZoneCTime ctime = with 0 (\pdst -> with nullPtr (\pcname -> do + secs <- get_current_timezone_seconds ctime pdst pcname + case secs of + 0x80000000 -> fail "localtime_r failed" + _ -> do + dst <- peek pdst + cname <- peek pcname + name <- peekCString cname + return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name) + )) + +-- | Get the local time-zone for a given time (varying as per summertime adjustments). +getTimeZoneSystem :: SystemTime -> IO TimeZone +getTimeZoneSystem = getTimeZoneCTime . CTime . systemSeconds + +-- | Get the local time-zone for a given time (varying as per summertime adjustments). +getTimeZone :: UTCTime -> IO TimeZone +getTimeZone = getTimeZoneCTime . fromInteger . floor . utcTimeToPOSIXSeconds + +-- | Get the current time-zone. +getCurrentTimeZone :: IO TimeZone +getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem diff --git a/lib/Data/Time/LocalTime/Internal/ZonedTime.hs b/lib/Data/Time/LocalTime/Internal/ZonedTime.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/LocalTime/Internal/ZonedTime.hs @@ -0,0 +1,61 @@ +{-# OPTIONS -fno-warn-orphans #-} +#include "HsConfigure.h" + +-- #hide +module Data.Time.LocalTime.Internal.ZonedTime +( + ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime +) where + +import Control.DeepSeq +import Data.Typeable +#if LANGUAGE_Rank2Types +import Data.Data +#endif + +import Data.Time.Clock.Internal.UTCTime +import Data.Time.Clock.POSIX +import Data.Time.LocalTime.Internal.TimeZone +import Data.Time.LocalTime.Internal.LocalTime + + +-- | A local time together with a time zone. +data ZonedTime = ZonedTime { + zonedTimeToLocalTime :: LocalTime, + zonedTimeZone :: TimeZone +} +#if LANGUAGE_DeriveDataTypeable +#if LANGUAGE_Rank2Types +#if HAS_DataPico + deriving (Data, Typeable) +#endif +#endif +#endif + +instance NFData ZonedTime where + rnf (ZonedTime lt z) = rnf lt `seq` rnf z `seq` () + +utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime +utcToZonedTime zone time = ZonedTime (utcToLocalTime zone time) zone + +zonedTimeToUTC :: ZonedTime -> UTCTime +zonedTimeToUTC (ZonedTime t zone) = localTimeToUTC zone t + +instance Show ZonedTime where + show (ZonedTime t zone) = show t ++ " " ++ show zone + +-- orphan instance +instance Show UTCTime where + show t = show (utcToZonedTime utc t) + +getZonedTime :: IO ZonedTime +getZonedTime = do + t <- getCurrentTime + zone <- getTimeZone t + return (utcToZonedTime zone t) + +-- | +utcToLocalZonedTime :: UTCTime -> IO ZonedTime +utcToLocalZonedTime t = do + zone <- getTimeZone t + return (utcToZonedTime zone t) diff --git a/lib/Data/Time/LocalTime/LocalTime.hs b/lib/Data/Time/LocalTime/LocalTime.hs deleted file mode 100644 --- a/lib/Data/Time/LocalTime/LocalTime.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-# OPTIONS -fno-warn-orphans -fno-warn-unused-imports #-} -#include "HsConfigure.h" - --- #hide -module Data.Time.LocalTime.LocalTime -( - -- * Local Time - LocalTime(..), - - -- converting UTC and UT1 times to LocalTime - utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1, - - ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime -) where - -import Data.Time.LocalTime.TimeOfDay -import Data.Time.LocalTime.TimeZone -import Data.Time.Calendar.Days -import Data.Time.Calendar.Gregorian - -import Data.Time.Clock.Scale -import Data.Time.Clock.UTCDiff -import Data.Time.Clock.UTC -import Data.Time.Clock.POSIX - -import Control.DeepSeq -import Data.Typeable -#if LANGUAGE_Rank2Types -import Data.Data -#endif - --- | A simple day and time aggregate, where the day is of the specified parameter, --- and the time is a TimeOfDay. --- Conversion of this (as local civil time) to UTC depends on the time zone. --- Conversion of this (as local mean time) to UT1 depends on the longitude. -data LocalTime = LocalTime { - localDay :: Day, - localTimeOfDay :: TimeOfDay -} deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - ,Data, Typeable -#endif -#endif -#endif - ) - -instance NFData LocalTime where - rnf (LocalTime d t) = d `deepseq` t `deepseq` () - -instance Show LocalTime where - show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t) - --- | show a UTC time in a given time zone as a LocalTime -utcToLocalTime :: TimeZone -> UTCTime -> LocalTime -utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod where - (i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt) - --- | find out what UTC time a given LocalTime in a given time zone is -localTimeToUTC :: TimeZone -> LocalTime -> UTCTime -localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC) where - (i,todUTC) = localToUTCTimeOfDay tz tod - --- | 1st arg is observation meridian in degrees, positive is East -ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime -ut1ToLocalTime long (ModJulianDate date) = LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset) where - localTime = date + long / 360 :: Rational - localMJD = floor localTime - localToDOffset = localTime - (fromIntegral localMJD) - --- | 1st arg is observation meridian in degrees, positive is East -localTimeToUT1 :: Rational -> LocalTime -> UniversalTime -localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) = ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360)) - --- orphan instance -instance Show UniversalTime where - show t = show (ut1ToLocalTime 0 t) - --- | A local time together with a TimeZone. -data ZonedTime = ZonedTime { - zonedTimeToLocalTime :: LocalTime, - zonedTimeZone :: TimeZone -} -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - deriving (Data, Typeable) -#endif -#endif -#endif - -instance NFData ZonedTime where - rnf (ZonedTime lt z) = lt `deepseq` z `deepseq` () - -utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime -utcToZonedTime zone time = ZonedTime (utcToLocalTime zone time) zone - -zonedTimeToUTC :: ZonedTime -> UTCTime -zonedTimeToUTC (ZonedTime t zone) = localTimeToUTC zone t - -instance Show ZonedTime where - show (ZonedTime t zone) = show t ++ " " ++ show zone - --- orphan instance -instance Show UTCTime where - show t = show (utcToZonedTime utc t) - -getZonedTime :: IO ZonedTime -getZonedTime = do - t <- getCurrentTime - zone <- getTimeZone t - return (utcToZonedTime zone t) - --- | -utcToLocalZonedTime :: UTCTime -> IO ZonedTime -utcToLocalZonedTime t = do - zone <- getTimeZone t - return (utcToZonedTime zone t) diff --git a/lib/Data/Time/LocalTime/TimeOfDay.hs b/lib/Data/Time/LocalTime/TimeOfDay.hs deleted file mode 100644 --- a/lib/Data/Time/LocalTime/TimeOfDay.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# OPTIONS -fno-warn-unused-imports #-} -#include "HsConfigure.h" --- #hide -module Data.Time.LocalTime.TimeOfDay -( - -- * Time of day - TimeOfDay(..),midnight,midday,makeTimeOfDayValid, - utcToLocalTimeOfDay,localToUTCTimeOfDay, - timeToTimeOfDay,timeOfDayToTime, - dayFractionToTimeOfDay,timeOfDayToDayFraction -) where - -import Data.Time.LocalTime.TimeZone -import Data.Time.Calendar.Private -import Data.Time.Clock.Scale -import Control.DeepSeq -import Data.Typeable -import Data.Fixed -#if LANGUAGE_Rank2Types -import Data.Data -#endif - --- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. -data TimeOfDay = TimeOfDay { - -- | range 0 - 23 - todHour :: Int, - -- | range 0 - 59 - todMin :: Int, - -- | Note that 0 <= todSec < 61, accomodating leap seconds. - -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously - todSec :: Pico -} deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types -#if HAS_DataPico - ,Data, Typeable -#endif -#endif -#endif - ) - -instance NFData TimeOfDay where - rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `seq` () -- FIXME: Data.Fixed had no NFData instances yet at time of writing - --- | Hour zero -midnight :: TimeOfDay -midnight = TimeOfDay 0 0 0 - --- | Hour twelve -midday :: TimeOfDay -midday = TimeOfDay 12 0 0 - -instance Show TimeOfDay where - show (TimeOfDay h m s) = (show2 (Just '0') h) ++ ":" ++ (show2 (Just '0') m) ++ ":" ++ (show2Fixed (Just '0') s) - -makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay -makeTimeOfDayValid h m s = do - _ <- clipValid 0 23 h - _ <- clipValid 0 59 m - _ <- clipValid 0 60.999999999999 s - return (TimeOfDay h m s) - --- | Convert a ToD in UTC to a ToD in some timezone, together with a day adjustment. -utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) -utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where - m' = m + timeZoneMinutes zone - h' = h + (div m' 60) - --- | Convert a ToD in some timezone to a ToD in UTC, together with a day adjustment. -localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) -localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimeZone (negate (timeZoneMinutes zone))) - -posixDayLength :: DiffTime -posixDayLength = fromInteger 86400 - --- | Get a TimeOfDay given a time since midnight. --- Time more than 24h will be converted to leap-seconds. -timeToTimeOfDay :: DiffTime -> TimeOfDay -timeToTimeOfDay dt | dt >= posixDayLength = TimeOfDay 23 59 (60 + (realToFrac (dt - posixDayLength))) -timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) s where - s' = realToFrac dt - s = mod' s' 60 - m' = div' s' 60 - m = mod' m' 60 - h = div' m' 60 - --- | Find out how much time since midnight a given TimeOfDay is. -timeOfDayToTime :: TimeOfDay -> DiffTime -timeOfDayToTime (TimeOfDay h m s) = ((fromIntegral h) * 60 + (fromIntegral m)) * 60 + (realToFrac s) - --- | Get a TimeOfDay given the fraction of a day since midnight. -dayFractionToTimeOfDay :: Rational -> TimeOfDay -dayFractionToTimeOfDay df = timeToTimeOfDay (realToFrac (df * 86400)) - --- | Get the fraction of a day since midnight given a TimeOfDay. -timeOfDayToDayFraction :: TimeOfDay -> Rational -timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod) / realToFrac posixDayLength diff --git a/lib/Data/Time/LocalTime/TimeZone.hs b/lib/Data/Time/LocalTime/TimeZone.hs deleted file mode 100644 --- a/lib/Data/Time/LocalTime/TimeZone.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# OPTIONS -fno-warn-unused-imports #-} -{-# LANGUAGE ForeignFunctionInterface #-} -#include "HsConfigure.h" - --- #hide -module Data.Time.LocalTime.TimeZone -( - -- * Time zones - TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc, - - -- getting the locale time zone - getTimeZone,getCurrentTimeZone -) where - ---import System.Time.Calendar.Format -import Data.Time.Calendar.Private -import Data.Time.Clock.POSIX -import Data.Time.Clock.UTC - -#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 -import Foreign -#else -import Foreign.Safe -#endif -import Foreign.C -import Control.DeepSeq -import Data.Typeable -#if LANGUAGE_Rank2Types -import Data.Data -#endif - --- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag. -data TimeZone = TimeZone { - -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC. - timeZoneMinutes :: Int, - -- | Is this time zone just persisting for the summer? - timeZoneSummerOnly :: Bool, - -- | The name of the zone, typically a three- or four-letter acronym. - timeZoneName :: String -} deriving (Eq,Ord -#if LANGUAGE_DeriveDataTypeable -#if LANGUAGE_Rank2Types - ,Data, Typeable -#endif -#endif - ) - -instance NFData TimeZone where - rnf (TimeZone m so n) = m `deepseq` so `deepseq` n `deepseq` () - --- | Create a nameless non-summer timezone for this number of minutes -minutesToTimeZone :: Int -> TimeZone -minutesToTimeZone m = TimeZone m False "" - --- | Create a nameless non-summer timezone for this number of hours -hoursToTimeZone :: Int -> TimeZone -hoursToTimeZone i = minutesToTimeZone (60 * i) - -showT :: NumericPadOption -> Int -> String -showT opt t = show4 opt ((div t 60) * 100 + (mod t 60)) - --- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like %z in formatTime), with arbitrary padding -timeZoneOffsetString' :: NumericPadOption -> TimeZone -> String -timeZoneOffsetString' opt (TimeZone t _ _) | t < 0 = '-':(showT opt (negate t)) -timeZoneOffsetString' opt (TimeZone t _ _) = '+':(showT opt t) - --- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like %z in formatTime) -timeZoneOffsetString :: TimeZone -> String -timeZoneOffsetString = timeZoneOffsetString' (Just '0') - -instance Show TimeZone where - show zone@(TimeZone _ _ "") = timeZoneOffsetString zone - show (TimeZone _ _ name) = name - --- | The UTC time zone -utc :: TimeZone -utc = TimeZone 0 False "UTC" - -{-# CFILES cbits/HsTime.c #-} -foreign import ccall unsafe "HsTime.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> Ptr CString -> IO CLong - -posixToCTime :: POSIXTime -> CTime -posixToCTime = fromInteger . floor - --- | Get the local time-zone for a given time (varying as per summertime adjustments) -getTimeZone :: UTCTime -> IO TimeZone -getTimeZone time = with 0 (\pdst -> with nullPtr (\pcname -> do - secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) pdst pcname - case secs of - 0x80000000 -> fail "localtime_r failed" - _ -> do - dst <- peek pdst - cname <- peek pcname - name <- peekCString cname - return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name) - )) - --- | Get the current time-zone -getCurrentTimeZone :: IO TimeZone -getCurrentTimeZone = getCurrentTime >>= getTimeZone diff --git a/test/Test.hs b/test/Test.hs deleted file mode 100644 --- a/test/Test.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Main where -import Test.Framework -import Test.Tests -import Foreign.C.Types - -main :: IO () -main = do - if (toRational (1000000000000 :: CTime)) /= (1000000000000 :: Rational) - then putStrLn "WARNING: Some tests will incorrectly fail due to a 32-bit time_t C type." - else return () - defaultMain tests diff --git a/test/Test/AddDays.hs b/test/Test/AddDays.hs deleted file mode 100644 --- a/test/Test/AddDays.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Test.AddDays where - -import Data.Time.Calendar -import Test.TestUtil -import Test.AddDaysRef - -days ::[Day] -days = - [ - fromGregorian 2005 2 28, - fromGregorian 2004 2 29, - fromGregorian 2004 1 31, - fromGregorian 2004 12 31, - fromGregorian 2005 7 1, - fromGregorian 2005 4 21, - fromGregorian 2005 6 30 - ] - -increments :: [Integer] -increments = [-10,-4,-1,0,1,7,83] - -adders :: [(String,Integer -> Day -> Day)] -adders = - [ - ("day",addDays), - ("month (clip)",addGregorianMonthsClip), - ("month (roll over)",addGregorianMonthsRollOver), - ("year (clip)",addGregorianYearsClip), - ("year (roll over)",addGregorianYearsRollOver) - ] - -resultDays :: [String] -resultDays = do - (aname,adder) <- adders - increment <- increments - day <- days - return ((showGregorian day) ++ " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day)) - -addDaysTest :: Test -addDaysTest = pureTest "addDays" $ - diff addDaysRef $ unlines resultDays diff --git a/test/Test/AddDaysRef.hs b/test/Test/AddDaysRef.hs deleted file mode 100644 --- a/test/Test/AddDaysRef.hs +++ /dev/null @@ -1,250 +0,0 @@ -module Test.AddDaysRef where - -addDaysRef :: String -addDaysRef = - unlines - [ "2005-02-28 + -10 * day = 2005-02-18" - , "2004-02-29 + -10 * day = 2004-02-19" - , "2004-01-31 + -10 * day = 2004-01-21" - , "2004-12-31 + -10 * day = 2004-12-21" - , "2005-07-01 + -10 * day = 2005-06-21" - , "2005-04-21 + -10 * day = 2005-04-11" - , "2005-06-30 + -10 * day = 2005-06-20" - , "2005-02-28 + -4 * day = 2005-02-24" - , "2004-02-29 + -4 * day = 2004-02-25" - , "2004-01-31 + -4 * day = 2004-01-27" - , "2004-12-31 + -4 * day = 2004-12-27" - , "2005-07-01 + -4 * day = 2005-06-27" - , "2005-04-21 + -4 * day = 2005-04-17" - , "2005-06-30 + -4 * day = 2005-06-26" - , "2005-02-28 + -1 * day = 2005-02-27" - , "2004-02-29 + -1 * day = 2004-02-28" - , "2004-01-31 + -1 * day = 2004-01-30" - , "2004-12-31 + -1 * day = 2004-12-30" - , "2005-07-01 + -1 * day = 2005-06-30" - , "2005-04-21 + -1 * day = 2005-04-20" - , "2005-06-30 + -1 * day = 2005-06-29" - , "2005-02-28 + 0 * day = 2005-02-28" - , "2004-02-29 + 0 * day = 2004-02-29" - , "2004-01-31 + 0 * day = 2004-01-31" - , "2004-12-31 + 0 * day = 2004-12-31" - , "2005-07-01 + 0 * day = 2005-07-01" - , "2005-04-21 + 0 * day = 2005-04-21" - , "2005-06-30 + 0 * day = 2005-06-30" - , "2005-02-28 + 1 * day = 2005-03-01" - , "2004-02-29 + 1 * day = 2004-03-01" - , "2004-01-31 + 1 * day = 2004-02-01" - , "2004-12-31 + 1 * day = 2005-01-01" - , "2005-07-01 + 1 * day = 2005-07-02" - , "2005-04-21 + 1 * day = 2005-04-22" - , "2005-06-30 + 1 * day = 2005-07-01" - , "2005-02-28 + 7 * day = 2005-03-07" - , "2004-02-29 + 7 * day = 2004-03-07" - , "2004-01-31 + 7 * day = 2004-02-07" - , "2004-12-31 + 7 * day = 2005-01-07" - , "2005-07-01 + 7 * day = 2005-07-08" - , "2005-04-21 + 7 * day = 2005-04-28" - , "2005-06-30 + 7 * day = 2005-07-07" - , "2005-02-28 + 83 * day = 2005-05-22" - , "2004-02-29 + 83 * day = 2004-05-22" - , "2004-01-31 + 83 * day = 2004-04-23" - , "2004-12-31 + 83 * day = 2005-03-24" - , "2005-07-01 + 83 * day = 2005-09-22" - , "2005-04-21 + 83 * day = 2005-07-13" - , "2005-06-30 + 83 * day = 2005-09-21" - , "2005-02-28 + -10 * month (clip) = 2004-04-28" - , "2004-02-29 + -10 * month (clip) = 2003-04-29" - , "2004-01-31 + -10 * month (clip) = 2003-03-31" - , "2004-12-31 + -10 * month (clip) = 2004-02-29" - , "2005-07-01 + -10 * month (clip) = 2004-09-01" - , "2005-04-21 + -10 * month (clip) = 2004-06-21" - , "2005-06-30 + -10 * month (clip) = 2004-08-30" - , "2005-02-28 + -4 * month (clip) = 2004-10-28" - , "2004-02-29 + -4 * month (clip) = 2003-10-29" - , "2004-01-31 + -4 * month (clip) = 2003-09-30" - , "2004-12-31 + -4 * month (clip) = 2004-08-31" - , "2005-07-01 + -4 * month (clip) = 2005-03-01" - , "2005-04-21 + -4 * month (clip) = 2004-12-21" - , "2005-06-30 + -4 * month (clip) = 2005-02-28" - , "2005-02-28 + -1 * month (clip) = 2005-01-28" - , "2004-02-29 + -1 * month (clip) = 2004-01-29" - , "2004-01-31 + -1 * month (clip) = 2003-12-31" - , "2004-12-31 + -1 * month (clip) = 2004-11-30" - , "2005-07-01 + -1 * month (clip) = 2005-06-01" - , "2005-04-21 + -1 * month (clip) = 2005-03-21" - , "2005-06-30 + -1 * month (clip) = 2005-05-30" - , "2005-02-28 + 0 * month (clip) = 2005-02-28" - , "2004-02-29 + 0 * month (clip) = 2004-02-29" - , "2004-01-31 + 0 * month (clip) = 2004-01-31" - , "2004-12-31 + 0 * month (clip) = 2004-12-31" - , "2005-07-01 + 0 * month (clip) = 2005-07-01" - , "2005-04-21 + 0 * month (clip) = 2005-04-21" - , "2005-06-30 + 0 * month (clip) = 2005-06-30" - , "2005-02-28 + 1 * month (clip) = 2005-03-28" - , "2004-02-29 + 1 * month (clip) = 2004-03-29" - , "2004-01-31 + 1 * month (clip) = 2004-02-29" - , "2004-12-31 + 1 * month (clip) = 2005-01-31" - , "2005-07-01 + 1 * month (clip) = 2005-08-01" - , "2005-04-21 + 1 * month (clip) = 2005-05-21" - , "2005-06-30 + 1 * month (clip) = 2005-07-30" - , "2005-02-28 + 7 * month (clip) = 2005-09-28" - , "2004-02-29 + 7 * month (clip) = 2004-09-29" - , "2004-01-31 + 7 * month (clip) = 2004-08-31" - , "2004-12-31 + 7 * month (clip) = 2005-07-31" - , "2005-07-01 + 7 * month (clip) = 2006-02-01" - , "2005-04-21 + 7 * month (clip) = 2005-11-21" - , "2005-06-30 + 7 * month (clip) = 2006-01-30" - , "2005-02-28 + 83 * month (clip) = 2012-01-28" - , "2004-02-29 + 83 * month (clip) = 2011-01-29" - , "2004-01-31 + 83 * month (clip) = 2010-12-31" - , "2004-12-31 + 83 * month (clip) = 2011-11-30" - , "2005-07-01 + 83 * month (clip) = 2012-06-01" - , "2005-04-21 + 83 * month (clip) = 2012-03-21" - , "2005-06-30 + 83 * month (clip) = 2012-05-30" - , "2005-02-28 + -10 * month (roll over) = 2004-04-28" - , "2004-02-29 + -10 * month (roll over) = 2003-04-29" - , "2004-01-31 + -10 * month (roll over) = 2003-03-31" - , "2004-12-31 + -10 * month (roll over) = 2004-03-02" - , "2005-07-01 + -10 * month (roll over) = 2004-09-01" - , "2005-04-21 + -10 * month (roll over) = 2004-06-21" - , "2005-06-30 + -10 * month (roll over) = 2004-08-30" - , "2005-02-28 + -4 * month (roll over) = 2004-10-28" - , "2004-02-29 + -4 * month (roll over) = 2003-10-29" - , "2004-01-31 + -4 * month (roll over) = 2003-10-01" - , "2004-12-31 + -4 * month (roll over) = 2004-08-31" - , "2005-07-01 + -4 * month (roll over) = 2005-03-01" - , "2005-04-21 + -4 * month (roll over) = 2004-12-21" - , "2005-06-30 + -4 * month (roll over) = 2005-03-02" - , "2005-02-28 + -1 * month (roll over) = 2005-01-28" - , "2004-02-29 + -1 * month (roll over) = 2004-01-29" - , "2004-01-31 + -1 * month (roll over) = 2003-12-31" - , "2004-12-31 + -1 * month (roll over) = 2004-12-01" - , "2005-07-01 + -1 * month (roll over) = 2005-06-01" - , "2005-04-21 + -1 * month (roll over) = 2005-03-21" - , "2005-06-30 + -1 * month (roll over) = 2005-05-30" - , "2005-02-28 + 0 * month (roll over) = 2005-02-28" - , "2004-02-29 + 0 * month (roll over) = 2004-02-29" - , "2004-01-31 + 0 * month (roll over) = 2004-01-31" - , "2004-12-31 + 0 * month (roll over) = 2004-12-31" - , "2005-07-01 + 0 * month (roll over) = 2005-07-01" - , "2005-04-21 + 0 * month (roll over) = 2005-04-21" - , "2005-06-30 + 0 * month (roll over) = 2005-06-30" - , "2005-02-28 + 1 * month (roll over) = 2005-03-28" - , "2004-02-29 + 1 * month (roll over) = 2004-03-29" - , "2004-01-31 + 1 * month (roll over) = 2004-03-02" - , "2004-12-31 + 1 * month (roll over) = 2005-01-31" - , "2005-07-01 + 1 * month (roll over) = 2005-08-01" - , "2005-04-21 + 1 * month (roll over) = 2005-05-21" - , "2005-06-30 + 1 * month (roll over) = 2005-07-30" - , "2005-02-28 + 7 * month (roll over) = 2005-09-28" - , "2004-02-29 + 7 * month (roll over) = 2004-09-29" - , "2004-01-31 + 7 * month (roll over) = 2004-08-31" - , "2004-12-31 + 7 * month (roll over) = 2005-07-31" - , "2005-07-01 + 7 * month (roll over) = 2006-02-01" - , "2005-04-21 + 7 * month (roll over) = 2005-11-21" - , "2005-06-30 + 7 * month (roll over) = 2006-01-30" - , "2005-02-28 + 83 * month (roll over) = 2012-01-28" - , "2004-02-29 + 83 * month (roll over) = 2011-01-29" - , "2004-01-31 + 83 * month (roll over) = 2010-12-31" - , "2004-12-31 + 83 * month (roll over) = 2011-12-01" - , "2005-07-01 + 83 * month (roll over) = 2012-06-01" - , "2005-04-21 + 83 * month (roll over) = 2012-03-21" - , "2005-06-30 + 83 * month (roll over) = 2012-05-30" - , "2005-02-28 + -10 * year (clip) = 1995-02-28" - , "2004-02-29 + -10 * year (clip) = 1994-02-28" - , "2004-01-31 + -10 * year (clip) = 1994-01-31" - , "2004-12-31 + -10 * year (clip) = 1994-12-31" - , "2005-07-01 + -10 * year (clip) = 1995-07-01" - , "2005-04-21 + -10 * year (clip) = 1995-04-21" - , "2005-06-30 + -10 * year (clip) = 1995-06-30" - , "2005-02-28 + -4 * year (clip) = 2001-02-28" - , "2004-02-29 + -4 * year (clip) = 2000-02-29" - , "2004-01-31 + -4 * year (clip) = 2000-01-31" - , "2004-12-31 + -4 * year (clip) = 2000-12-31" - , "2005-07-01 + -4 * year (clip) = 2001-07-01" - , "2005-04-21 + -4 * year (clip) = 2001-04-21" - , "2005-06-30 + -4 * year (clip) = 2001-06-30" - , "2005-02-28 + -1 * year (clip) = 2004-02-28" - , "2004-02-29 + -1 * year (clip) = 2003-02-28" - , "2004-01-31 + -1 * year (clip) = 2003-01-31" - , "2004-12-31 + -1 * year (clip) = 2003-12-31" - , "2005-07-01 + -1 * year (clip) = 2004-07-01" - , "2005-04-21 + -1 * year (clip) = 2004-04-21" - , "2005-06-30 + -1 * year (clip) = 2004-06-30" - , "2005-02-28 + 0 * year (clip) = 2005-02-28" - , "2004-02-29 + 0 * year (clip) = 2004-02-29" - , "2004-01-31 + 0 * year (clip) = 2004-01-31" - , "2004-12-31 + 0 * year (clip) = 2004-12-31" - , "2005-07-01 + 0 * year (clip) = 2005-07-01" - , "2005-04-21 + 0 * year (clip) = 2005-04-21" - , "2005-06-30 + 0 * year (clip) = 2005-06-30" - , "2005-02-28 + 1 * year (clip) = 2006-02-28" - , "2004-02-29 + 1 * year (clip) = 2005-02-28" - , "2004-01-31 + 1 * year (clip) = 2005-01-31" - , "2004-12-31 + 1 * year (clip) = 2005-12-31" - , "2005-07-01 + 1 * year (clip) = 2006-07-01" - , "2005-04-21 + 1 * year (clip) = 2006-04-21" - , "2005-06-30 + 1 * year (clip) = 2006-06-30" - , "2005-02-28 + 7 * year (clip) = 2012-02-28" - , "2004-02-29 + 7 * year (clip) = 2011-02-28" - , "2004-01-31 + 7 * year (clip) = 2011-01-31" - , "2004-12-31 + 7 * year (clip) = 2011-12-31" - , "2005-07-01 + 7 * year (clip) = 2012-07-01" - , "2005-04-21 + 7 * year (clip) = 2012-04-21" - , "2005-06-30 + 7 * year (clip) = 2012-06-30" - , "2005-02-28 + 83 * year (clip) = 2088-02-28" - , "2004-02-29 + 83 * year (clip) = 2087-02-28" - , "2004-01-31 + 83 * year (clip) = 2087-01-31" - , "2004-12-31 + 83 * year (clip) = 2087-12-31" - , "2005-07-01 + 83 * year (clip) = 2088-07-01" - , "2005-04-21 + 83 * year (clip) = 2088-04-21" - , "2005-06-30 + 83 * year (clip) = 2088-06-30" - , "2005-02-28 + -10 * year (roll over) = 1995-02-28" - , "2004-02-29 + -10 * year (roll over) = 1994-03-01" - , "2004-01-31 + -10 * year (roll over) = 1994-01-31" - , "2004-12-31 + -10 * year (roll over) = 1994-12-31" - , "2005-07-01 + -10 * year (roll over) = 1995-07-01" - , "2005-04-21 + -10 * year (roll over) = 1995-04-21" - , "2005-06-30 + -10 * year (roll over) = 1995-06-30" - , "2005-02-28 + -4 * year (roll over) = 2001-02-28" - , "2004-02-29 + -4 * year (roll over) = 2000-02-29" - , "2004-01-31 + -4 * year (roll over) = 2000-01-31" - , "2004-12-31 + -4 * year (roll over) = 2000-12-31" - , "2005-07-01 + -4 * year (roll over) = 2001-07-01" - , "2005-04-21 + -4 * year (roll over) = 2001-04-21" - , "2005-06-30 + -4 * year (roll over) = 2001-06-30" - , "2005-02-28 + -1 * year (roll over) = 2004-02-28" - , "2004-02-29 + -1 * year (roll over) = 2003-03-01" - , "2004-01-31 + -1 * year (roll over) = 2003-01-31" - , "2004-12-31 + -1 * year (roll over) = 2003-12-31" - , "2005-07-01 + -1 * year (roll over) = 2004-07-01" - , "2005-04-21 + -1 * year (roll over) = 2004-04-21" - , "2005-06-30 + -1 * year (roll over) = 2004-06-30" - , "2005-02-28 + 0 * year (roll over) = 2005-02-28" - , "2004-02-29 + 0 * year (roll over) = 2004-02-29" - , "2004-01-31 + 0 * year (roll over) = 2004-01-31" - , "2004-12-31 + 0 * year (roll over) = 2004-12-31" - , "2005-07-01 + 0 * year (roll over) = 2005-07-01" - , "2005-04-21 + 0 * year (roll over) = 2005-04-21" - , "2005-06-30 + 0 * year (roll over) = 2005-06-30" - , "2005-02-28 + 1 * year (roll over) = 2006-02-28" - , "2004-02-29 + 1 * year (roll over) = 2005-03-01" - , "2004-01-31 + 1 * year (roll over) = 2005-01-31" - , "2004-12-31 + 1 * year (roll over) = 2005-12-31" - , "2005-07-01 + 1 * year (roll over) = 2006-07-01" - , "2005-04-21 + 1 * year (roll over) = 2006-04-21" - , "2005-06-30 + 1 * year (roll over) = 2006-06-30" - , "2005-02-28 + 7 * year (roll over) = 2012-02-28" - , "2004-02-29 + 7 * year (roll over) = 2011-03-01" - , "2004-01-31 + 7 * year (roll over) = 2011-01-31" - , "2004-12-31 + 7 * year (roll over) = 2011-12-31" - , "2005-07-01 + 7 * year (roll over) = 2012-07-01" - , "2005-04-21 + 7 * year (roll over) = 2012-04-21" - , "2005-06-30 + 7 * year (roll over) = 2012-06-30" - , "2005-02-28 + 83 * year (roll over) = 2088-02-28" - , "2004-02-29 + 83 * year (roll over) = 2087-03-01" - , "2004-01-31 + 83 * year (roll over) = 2087-01-31" - , "2004-12-31 + 83 * year (roll over) = 2087-12-31" - , "2005-07-01 + 83 * year (roll over) = 2088-07-01" - , "2005-04-21 + 83 * year (roll over) = 2088-04-21" - , "2005-06-30 + 83 * year (roll over) = 2088-06-30" ] diff --git a/test/Test/ClipDates.hs b/test/Test/ClipDates.hs deleted file mode 100644 --- a/test/Test/ClipDates.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# Language TupleSections #-} - -module Test.ClipDates where - -import Data.Time.Calendar.OrdinalDate -import Data.Time.Calendar.WeekDate -import Data.Time.Calendar -import Test.TestUtil -import Test.ClipDatesRef - -yearAndDay :: (Integer,Int) -> String -yearAndDay (y,d) = (show y) ++ "-" ++ (show d) ++ " = " ++ (showOrdinalDate (fromOrdinalDate y d)) - -gregorian :: (Integer,Int,Int) -> String -gregorian (y,m,d) = (show y) ++ "-" ++ (show m) ++ "-" ++ (show d) ++ " = " ++ (showGregorian (fromGregorian y m d)) - -iSOWeekDay :: (Integer,Int,Int) -> String -iSOWeekDay (y,w,d) = (show y) ++ "-W" ++ (show w) ++ "-" ++ (show d) ++ " = " ++ (showWeekDate (fromWeekDate y w d)) - --- - -tupleUp2 :: [a] -> [b] -> [(a, b)] -tupleUp2 l1 l2 = concatMap (\e -> map (e,) l2) l1 - -tupleUp3 :: [a] -> [b] -> [c] -> [(a, b, c)] -tupleUp3 l1 l2 l3 - = let ts = tupleUp2 l2 l3 - in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1 - --- - -clipDates :: Test -clipDates = pureTest "clipDates" $ - let - yad = unlines $ map yearAndDay $ - tupleUp2 [1968,1969,1971] [-4,0,1,200,364,365,366,367,700] - - - greg = unlines $ map gregorian $ - tupleUp3 [1968,1969,1971] [-20,-1,0,1,2,12,13,17] [-7,-1,0,1,2,27,28,29,30,31,32,40] - - iso = unlines $ map iSOWeekDay $ - tupleUp3 [1968,1969,2004] [-20,-1,0,1,20,51,52,53,54] [-2,-1,0,1,4,6,7,8,9] - - in diff clipDatesRef $ - concat [ "YearAndDay\n", yad, "Gregorian\n", greg, "ISOWeekDay\n", iso ] diff --git a/test/Test/ClipDatesRef.hs b/test/Test/ClipDatesRef.hs deleted file mode 100644 --- a/test/Test/ClipDatesRef.hs +++ /dev/null @@ -1,566 +0,0 @@ -module Test.ClipDatesRef where - -clipDatesRef :: String -clipDatesRef = - unlines - [ "YearAndDay" - , "1968--4 = 1968-001" - , "1968-0 = 1968-001" - , "1968-1 = 1968-001" - , "1968-200 = 1968-200" - , "1968-364 = 1968-364" - , "1968-365 = 1968-365" - , "1968-366 = 1968-366" - , "1968-367 = 1968-366" - , "1968-700 = 1968-366" - , "1969--4 = 1969-001" - , "1969-0 = 1969-001" - , "1969-1 = 1969-001" - , "1969-200 = 1969-200" - , "1969-364 = 1969-364" - , "1969-365 = 1969-365" - , "1969-366 = 1969-365" - , "1969-367 = 1969-365" - , "1969-700 = 1969-365" - , "1971--4 = 1971-001" - , "1971-0 = 1971-001" - , "1971-1 = 1971-001" - , "1971-200 = 1971-200" - , "1971-364 = 1971-364" - , "1971-365 = 1971-365" - , "1971-366 = 1971-365" - , "1971-367 = 1971-365" - , "1971-700 = 1971-365" - , "Gregorian" - , "1968--20--7 = 1968-01-01" - , "1968--20--1 = 1968-01-01" - , "1968--20-0 = 1968-01-01" - , "1968--20-1 = 1968-01-01" - , "1968--20-2 = 1968-01-02" - , "1968--20-27 = 1968-01-27" - , "1968--20-28 = 1968-01-28" - , "1968--20-29 = 1968-01-29" - , "1968--20-30 = 1968-01-30" - , "1968--20-31 = 1968-01-31" - , "1968--20-32 = 1968-01-31" - , "1968--20-40 = 1968-01-31" - , "1968--1--7 = 1968-01-01" - , "1968--1--1 = 1968-01-01" - , "1968--1-0 = 1968-01-01" - , "1968--1-1 = 1968-01-01" - , "1968--1-2 = 1968-01-02" - , "1968--1-27 = 1968-01-27" - , "1968--1-28 = 1968-01-28" - , "1968--1-29 = 1968-01-29" - , "1968--1-30 = 1968-01-30" - , "1968--1-31 = 1968-01-31" - , "1968--1-32 = 1968-01-31" - , "1968--1-40 = 1968-01-31" - , "1968-0--7 = 1968-01-01" - , "1968-0--1 = 1968-01-01" - , "1968-0-0 = 1968-01-01" - , "1968-0-1 = 1968-01-01" - , "1968-0-2 = 1968-01-02" - , "1968-0-27 = 1968-01-27" - , "1968-0-28 = 1968-01-28" - , "1968-0-29 = 1968-01-29" - , "1968-0-30 = 1968-01-30" - , "1968-0-31 = 1968-01-31" - , "1968-0-32 = 1968-01-31" - , "1968-0-40 = 1968-01-31" - , "1968-1--7 = 1968-01-01" - , "1968-1--1 = 1968-01-01" - , "1968-1-0 = 1968-01-01" - , "1968-1-1 = 1968-01-01" - , "1968-1-2 = 1968-01-02" - , "1968-1-27 = 1968-01-27" - , "1968-1-28 = 1968-01-28" - , "1968-1-29 = 1968-01-29" - , "1968-1-30 = 1968-01-30" - , "1968-1-31 = 1968-01-31" - , "1968-1-32 = 1968-01-31" - , "1968-1-40 = 1968-01-31" - , "1968-2--7 = 1968-02-01" - , "1968-2--1 = 1968-02-01" - , "1968-2-0 = 1968-02-01" - , "1968-2-1 = 1968-02-01" - , "1968-2-2 = 1968-02-02" - , "1968-2-27 = 1968-02-27" - , "1968-2-28 = 1968-02-28" - , "1968-2-29 = 1968-02-29" - , "1968-2-30 = 1968-02-29" - , "1968-2-31 = 1968-02-29" - , "1968-2-32 = 1968-02-29" - , "1968-2-40 = 1968-02-29" - , "1968-12--7 = 1968-12-01" - , "1968-12--1 = 1968-12-01" - , "1968-12-0 = 1968-12-01" - , "1968-12-1 = 1968-12-01" - , "1968-12-2 = 1968-12-02" - , "1968-12-27 = 1968-12-27" - , "1968-12-28 = 1968-12-28" - , "1968-12-29 = 1968-12-29" - , "1968-12-30 = 1968-12-30" - , "1968-12-31 = 1968-12-31" - , "1968-12-32 = 1968-12-31" - , "1968-12-40 = 1968-12-31" - , "1968-13--7 = 1968-12-01" - , "1968-13--1 = 1968-12-01" - , "1968-13-0 = 1968-12-01" - , "1968-13-1 = 1968-12-01" - , "1968-13-2 = 1968-12-02" - , "1968-13-27 = 1968-12-27" - , "1968-13-28 = 1968-12-28" - , "1968-13-29 = 1968-12-29" - , "1968-13-30 = 1968-12-30" - , "1968-13-31 = 1968-12-31" - , "1968-13-32 = 1968-12-31" - , "1968-13-40 = 1968-12-31" - , "1968-17--7 = 1968-12-01" - , "1968-17--1 = 1968-12-01" - , "1968-17-0 = 1968-12-01" - , "1968-17-1 = 1968-12-01" - , "1968-17-2 = 1968-12-02" - , "1968-17-27 = 1968-12-27" - , "1968-17-28 = 1968-12-28" - , "1968-17-29 = 1968-12-29" - , "1968-17-30 = 1968-12-30" - , "1968-17-31 = 1968-12-31" - , "1968-17-32 = 1968-12-31" - , "1968-17-40 = 1968-12-31" - , "1969--20--7 = 1969-01-01" - , "1969--20--1 = 1969-01-01" - , "1969--20-0 = 1969-01-01" - , "1969--20-1 = 1969-01-01" - , "1969--20-2 = 1969-01-02" - , "1969--20-27 = 1969-01-27" - , "1969--20-28 = 1969-01-28" - , "1969--20-29 = 1969-01-29" - , "1969--20-30 = 1969-01-30" - , "1969--20-31 = 1969-01-31" - , "1969--20-32 = 1969-01-31" - , "1969--20-40 = 1969-01-31" - , "1969--1--7 = 1969-01-01" - , "1969--1--1 = 1969-01-01" - , "1969--1-0 = 1969-01-01" - , "1969--1-1 = 1969-01-01" - , "1969--1-2 = 1969-01-02" - , "1969--1-27 = 1969-01-27" - , "1969--1-28 = 1969-01-28" - , "1969--1-29 = 1969-01-29" - , "1969--1-30 = 1969-01-30" - , "1969--1-31 = 1969-01-31" - , "1969--1-32 = 1969-01-31" - , "1969--1-40 = 1969-01-31" - , "1969-0--7 = 1969-01-01" - , "1969-0--1 = 1969-01-01" - , "1969-0-0 = 1969-01-01" - , "1969-0-1 = 1969-01-01" - , "1969-0-2 = 1969-01-02" - , "1969-0-27 = 1969-01-27" - , "1969-0-28 = 1969-01-28" - , "1969-0-29 = 1969-01-29" - , "1969-0-30 = 1969-01-30" - , "1969-0-31 = 1969-01-31" - , "1969-0-32 = 1969-01-31" - , "1969-0-40 = 1969-01-31" - , "1969-1--7 = 1969-01-01" - , "1969-1--1 = 1969-01-01" - , "1969-1-0 = 1969-01-01" - , "1969-1-1 = 1969-01-01" - , "1969-1-2 = 1969-01-02" - , "1969-1-27 = 1969-01-27" - , "1969-1-28 = 1969-01-28" - , "1969-1-29 = 1969-01-29" - , "1969-1-30 = 1969-01-30" - , "1969-1-31 = 1969-01-31" - , "1969-1-32 = 1969-01-31" - , "1969-1-40 = 1969-01-31" - , "1969-2--7 = 1969-02-01" - , "1969-2--1 = 1969-02-01" - , "1969-2-0 = 1969-02-01" - , "1969-2-1 = 1969-02-01" - , "1969-2-2 = 1969-02-02" - , "1969-2-27 = 1969-02-27" - , "1969-2-28 = 1969-02-28" - , "1969-2-29 = 1969-02-28" - , "1969-2-30 = 1969-02-28" - , "1969-2-31 = 1969-02-28" - , "1969-2-32 = 1969-02-28" - , "1969-2-40 = 1969-02-28" - , "1969-12--7 = 1969-12-01" - , "1969-12--1 = 1969-12-01" - , "1969-12-0 = 1969-12-01" - , "1969-12-1 = 1969-12-01" - , "1969-12-2 = 1969-12-02" - , "1969-12-27 = 1969-12-27" - , "1969-12-28 = 1969-12-28" - , "1969-12-29 = 1969-12-29" - , "1969-12-30 = 1969-12-30" - , "1969-12-31 = 1969-12-31" - , "1969-12-32 = 1969-12-31" - , "1969-12-40 = 1969-12-31" - , "1969-13--7 = 1969-12-01" - , "1969-13--1 = 1969-12-01" - , "1969-13-0 = 1969-12-01" - , "1969-13-1 = 1969-12-01" - , "1969-13-2 = 1969-12-02" - , "1969-13-27 = 1969-12-27" - , "1969-13-28 = 1969-12-28" - , "1969-13-29 = 1969-12-29" - , "1969-13-30 = 1969-12-30" - , "1969-13-31 = 1969-12-31" - , "1969-13-32 = 1969-12-31" - , "1969-13-40 = 1969-12-31" - , "1969-17--7 = 1969-12-01" - , "1969-17--1 = 1969-12-01" - , "1969-17-0 = 1969-12-01" - , "1969-17-1 = 1969-12-01" - , "1969-17-2 = 1969-12-02" - , "1969-17-27 = 1969-12-27" - , "1969-17-28 = 1969-12-28" - , "1969-17-29 = 1969-12-29" - , "1969-17-30 = 1969-12-30" - , "1969-17-31 = 1969-12-31" - , "1969-17-32 = 1969-12-31" - , "1969-17-40 = 1969-12-31" - , "1971--20--7 = 1971-01-01" - , "1971--20--1 = 1971-01-01" - , "1971--20-0 = 1971-01-01" - , "1971--20-1 = 1971-01-01" - , "1971--20-2 = 1971-01-02" - , "1971--20-27 = 1971-01-27" - , "1971--20-28 = 1971-01-28" - , "1971--20-29 = 1971-01-29" - , "1971--20-30 = 1971-01-30" - , "1971--20-31 = 1971-01-31" - , "1971--20-32 = 1971-01-31" - , "1971--20-40 = 1971-01-31" - , "1971--1--7 = 1971-01-01" - , "1971--1--1 = 1971-01-01" - , "1971--1-0 = 1971-01-01" - , "1971--1-1 = 1971-01-01" - , "1971--1-2 = 1971-01-02" - , "1971--1-27 = 1971-01-27" - , "1971--1-28 = 1971-01-28" - , "1971--1-29 = 1971-01-29" - , "1971--1-30 = 1971-01-30" - , "1971--1-31 = 1971-01-31" - , "1971--1-32 = 1971-01-31" - , "1971--1-40 = 1971-01-31" - , "1971-0--7 = 1971-01-01" - , "1971-0--1 = 1971-01-01" - , "1971-0-0 = 1971-01-01" - , "1971-0-1 = 1971-01-01" - , "1971-0-2 = 1971-01-02" - , "1971-0-27 = 1971-01-27" - , "1971-0-28 = 1971-01-28" - , "1971-0-29 = 1971-01-29" - , "1971-0-30 = 1971-01-30" - , "1971-0-31 = 1971-01-31" - , "1971-0-32 = 1971-01-31" - , "1971-0-40 = 1971-01-31" - , "1971-1--7 = 1971-01-01" - , "1971-1--1 = 1971-01-01" - , "1971-1-0 = 1971-01-01" - , "1971-1-1 = 1971-01-01" - , "1971-1-2 = 1971-01-02" - , "1971-1-27 = 1971-01-27" - , "1971-1-28 = 1971-01-28" - , "1971-1-29 = 1971-01-29" - , "1971-1-30 = 1971-01-30" - , "1971-1-31 = 1971-01-31" - , "1971-1-32 = 1971-01-31" - , "1971-1-40 = 1971-01-31" - , "1971-2--7 = 1971-02-01" - , "1971-2--1 = 1971-02-01" - , "1971-2-0 = 1971-02-01" - , "1971-2-1 = 1971-02-01" - , "1971-2-2 = 1971-02-02" - , "1971-2-27 = 1971-02-27" - , "1971-2-28 = 1971-02-28" - , "1971-2-29 = 1971-02-28" - , "1971-2-30 = 1971-02-28" - , "1971-2-31 = 1971-02-28" - , "1971-2-32 = 1971-02-28" - , "1971-2-40 = 1971-02-28" - , "1971-12--7 = 1971-12-01" - , "1971-12--1 = 1971-12-01" - , "1971-12-0 = 1971-12-01" - , "1971-12-1 = 1971-12-01" - , "1971-12-2 = 1971-12-02" - , "1971-12-27 = 1971-12-27" - , "1971-12-28 = 1971-12-28" - , "1971-12-29 = 1971-12-29" - , "1971-12-30 = 1971-12-30" - , "1971-12-31 = 1971-12-31" - , "1971-12-32 = 1971-12-31" - , "1971-12-40 = 1971-12-31" - , "1971-13--7 = 1971-12-01" - , "1971-13--1 = 1971-12-01" - , "1971-13-0 = 1971-12-01" - , "1971-13-1 = 1971-12-01" - , "1971-13-2 = 1971-12-02" - , "1971-13-27 = 1971-12-27" - , "1971-13-28 = 1971-12-28" - , "1971-13-29 = 1971-12-29" - , "1971-13-30 = 1971-12-30" - , "1971-13-31 = 1971-12-31" - , "1971-13-32 = 1971-12-31" - , "1971-13-40 = 1971-12-31" - , "1971-17--7 = 1971-12-01" - , "1971-17--1 = 1971-12-01" - , "1971-17-0 = 1971-12-01" - , "1971-17-1 = 1971-12-01" - , "1971-17-2 = 1971-12-02" - , "1971-17-27 = 1971-12-27" - , "1971-17-28 = 1971-12-28" - , "1971-17-29 = 1971-12-29" - , "1971-17-30 = 1971-12-30" - , "1971-17-31 = 1971-12-31" - , "1971-17-32 = 1971-12-31" - , "1971-17-40 = 1971-12-31" - , "ISOWeekDay" - , "1968-W-20--2 = 1968-W01-1" - , "1968-W-20--1 = 1968-W01-1" - , "1968-W-20-0 = 1968-W01-1" - , "1968-W-20-1 = 1968-W01-1" - , "1968-W-20-4 = 1968-W01-4" - , "1968-W-20-6 = 1968-W01-6" - , "1968-W-20-7 = 1968-W01-7" - , "1968-W-20-8 = 1968-W01-7" - , "1968-W-20-9 = 1968-W01-7" - , "1968-W-1--2 = 1968-W01-1" - , "1968-W-1--1 = 1968-W01-1" - , "1968-W-1-0 = 1968-W01-1" - , "1968-W-1-1 = 1968-W01-1" - , "1968-W-1-4 = 1968-W01-4" - , "1968-W-1-6 = 1968-W01-6" - , "1968-W-1-7 = 1968-W01-7" - , "1968-W-1-8 = 1968-W01-7" - , "1968-W-1-9 = 1968-W01-7" - , "1968-W0--2 = 1968-W01-1" - , "1968-W0--1 = 1968-W01-1" - , "1968-W0-0 = 1968-W01-1" - , "1968-W0-1 = 1968-W01-1" - , "1968-W0-4 = 1968-W01-4" - , "1968-W0-6 = 1968-W01-6" - , "1968-W0-7 = 1968-W01-7" - , "1968-W0-8 = 1968-W01-7" - , "1968-W0-9 = 1968-W01-7" - , "1968-W1--2 = 1968-W01-1" - , "1968-W1--1 = 1968-W01-1" - , "1968-W1-0 = 1968-W01-1" - , "1968-W1-1 = 1968-W01-1" - , "1968-W1-4 = 1968-W01-4" - , "1968-W1-6 = 1968-W01-6" - , "1968-W1-7 = 1968-W01-7" - , "1968-W1-8 = 1968-W01-7" - , "1968-W1-9 = 1968-W01-7" - , "1968-W20--2 = 1968-W20-1" - , "1968-W20--1 = 1968-W20-1" - , "1968-W20-0 = 1968-W20-1" - , "1968-W20-1 = 1968-W20-1" - , "1968-W20-4 = 1968-W20-4" - , "1968-W20-6 = 1968-W20-6" - , "1968-W20-7 = 1968-W20-7" - , "1968-W20-8 = 1968-W20-7" - , "1968-W20-9 = 1968-W20-7" - , "1968-W51--2 = 1968-W51-1" - , "1968-W51--1 = 1968-W51-1" - , "1968-W51-0 = 1968-W51-1" - , "1968-W51-1 = 1968-W51-1" - , "1968-W51-4 = 1968-W51-4" - , "1968-W51-6 = 1968-W51-6" - , "1968-W51-7 = 1968-W51-7" - , "1968-W51-8 = 1968-W51-7" - , "1968-W51-9 = 1968-W51-7" - , "1968-W52--2 = 1968-W52-1" - , "1968-W52--1 = 1968-W52-1" - , "1968-W52-0 = 1968-W52-1" - , "1968-W52-1 = 1968-W52-1" - , "1968-W52-4 = 1968-W52-4" - , "1968-W52-6 = 1968-W52-6" - , "1968-W52-7 = 1968-W52-7" - , "1968-W52-8 = 1968-W52-7" - , "1968-W52-9 = 1968-W52-7" - , "1968-W53--2 = 1968-W52-1" - , "1968-W53--1 = 1968-W52-1" - , "1968-W53-0 = 1968-W52-1" - , "1968-W53-1 = 1968-W52-1" - , "1968-W53-4 = 1968-W52-4" - , "1968-W53-6 = 1968-W52-6" - , "1968-W53-7 = 1968-W52-7" - , "1968-W53-8 = 1968-W52-7" - , "1968-W53-9 = 1968-W52-7" - , "1968-W54--2 = 1968-W52-1" - , "1968-W54--1 = 1968-W52-1" - , "1968-W54-0 = 1968-W52-1" - , "1968-W54-1 = 1968-W52-1" - , "1968-W54-4 = 1968-W52-4" - , "1968-W54-6 = 1968-W52-6" - , "1968-W54-7 = 1968-W52-7" - , "1968-W54-8 = 1968-W52-7" - , "1968-W54-9 = 1968-W52-7" - , "1969-W-20--2 = 1969-W01-1" - , "1969-W-20--1 = 1969-W01-1" - , "1969-W-20-0 = 1969-W01-1" - , "1969-W-20-1 = 1969-W01-1" - , "1969-W-20-4 = 1969-W01-4" - , "1969-W-20-6 = 1969-W01-6" - , "1969-W-20-7 = 1969-W01-7" - , "1969-W-20-8 = 1969-W01-7" - , "1969-W-20-9 = 1969-W01-7" - , "1969-W-1--2 = 1969-W01-1" - , "1969-W-1--1 = 1969-W01-1" - , "1969-W-1-0 = 1969-W01-1" - , "1969-W-1-1 = 1969-W01-1" - , "1969-W-1-4 = 1969-W01-4" - , "1969-W-1-6 = 1969-W01-6" - , "1969-W-1-7 = 1969-W01-7" - , "1969-W-1-8 = 1969-W01-7" - , "1969-W-1-9 = 1969-W01-7" - , "1969-W0--2 = 1969-W01-1" - , "1969-W0--1 = 1969-W01-1" - , "1969-W0-0 = 1969-W01-1" - , "1969-W0-1 = 1969-W01-1" - , "1969-W0-4 = 1969-W01-4" - , "1969-W0-6 = 1969-W01-6" - , "1969-W0-7 = 1969-W01-7" - , "1969-W0-8 = 1969-W01-7" - , "1969-W0-9 = 1969-W01-7" - , "1969-W1--2 = 1969-W01-1" - , "1969-W1--1 = 1969-W01-1" - , "1969-W1-0 = 1969-W01-1" - , "1969-W1-1 = 1969-W01-1" - , "1969-W1-4 = 1969-W01-4" - , "1969-W1-6 = 1969-W01-6" - , "1969-W1-7 = 1969-W01-7" - , "1969-W1-8 = 1969-W01-7" - , "1969-W1-9 = 1969-W01-7" - , "1969-W20--2 = 1969-W20-1" - , "1969-W20--1 = 1969-W20-1" - , "1969-W20-0 = 1969-W20-1" - , "1969-W20-1 = 1969-W20-1" - , "1969-W20-4 = 1969-W20-4" - , "1969-W20-6 = 1969-W20-6" - , "1969-W20-7 = 1969-W20-7" - , "1969-W20-8 = 1969-W20-7" - , "1969-W20-9 = 1969-W20-7" - , "1969-W51--2 = 1969-W51-1" - , "1969-W51--1 = 1969-W51-1" - , "1969-W51-0 = 1969-W51-1" - , "1969-W51-1 = 1969-W51-1" - , "1969-W51-4 = 1969-W51-4" - , "1969-W51-6 = 1969-W51-6" - , "1969-W51-7 = 1969-W51-7" - , "1969-W51-8 = 1969-W51-7" - , "1969-W51-9 = 1969-W51-7" - , "1969-W52--2 = 1969-W52-1" - , "1969-W52--1 = 1969-W52-1" - , "1969-W52-0 = 1969-W52-1" - , "1969-W52-1 = 1969-W52-1" - , "1969-W52-4 = 1969-W52-4" - , "1969-W52-6 = 1969-W52-6" - , "1969-W52-7 = 1969-W52-7" - , "1969-W52-8 = 1969-W52-7" - , "1969-W52-9 = 1969-W52-7" - , "1969-W53--2 = 1969-W52-1" - , "1969-W53--1 = 1969-W52-1" - , "1969-W53-0 = 1969-W52-1" - , "1969-W53-1 = 1969-W52-1" - , "1969-W53-4 = 1969-W52-4" - , "1969-W53-6 = 1969-W52-6" - , "1969-W53-7 = 1969-W52-7" - , "1969-W53-8 = 1969-W52-7" - , "1969-W53-9 = 1969-W52-7" - , "1969-W54--2 = 1969-W52-1" - , "1969-W54--1 = 1969-W52-1" - , "1969-W54-0 = 1969-W52-1" - , "1969-W54-1 = 1969-W52-1" - , "1969-W54-4 = 1969-W52-4" - , "1969-W54-6 = 1969-W52-6" - , "1969-W54-7 = 1969-W52-7" - , "1969-W54-8 = 1969-W52-7" - , "1969-W54-9 = 1969-W52-7" - , "2004-W-20--2 = 2004-W01-1" - , "2004-W-20--1 = 2004-W01-1" - , "2004-W-20-0 = 2004-W01-1" - , "2004-W-20-1 = 2004-W01-1" - , "2004-W-20-4 = 2004-W01-4" - , "2004-W-20-6 = 2004-W01-6" - , "2004-W-20-7 = 2004-W01-7" - , "2004-W-20-8 = 2004-W01-7" - , "2004-W-20-9 = 2004-W01-7" - , "2004-W-1--2 = 2004-W01-1" - , "2004-W-1--1 = 2004-W01-1" - , "2004-W-1-0 = 2004-W01-1" - , "2004-W-1-1 = 2004-W01-1" - , "2004-W-1-4 = 2004-W01-4" - , "2004-W-1-6 = 2004-W01-6" - , "2004-W-1-7 = 2004-W01-7" - , "2004-W-1-8 = 2004-W01-7" - , "2004-W-1-9 = 2004-W01-7" - , "2004-W0--2 = 2004-W01-1" - , "2004-W0--1 = 2004-W01-1" - , "2004-W0-0 = 2004-W01-1" - , "2004-W0-1 = 2004-W01-1" - , "2004-W0-4 = 2004-W01-4" - , "2004-W0-6 = 2004-W01-6" - , "2004-W0-7 = 2004-W01-7" - , "2004-W0-8 = 2004-W01-7" - , "2004-W0-9 = 2004-W01-7" - , "2004-W1--2 = 2004-W01-1" - , "2004-W1--1 = 2004-W01-1" - , "2004-W1-0 = 2004-W01-1" - , "2004-W1-1 = 2004-W01-1" - , "2004-W1-4 = 2004-W01-4" - , "2004-W1-6 = 2004-W01-6" - , "2004-W1-7 = 2004-W01-7" - , "2004-W1-8 = 2004-W01-7" - , "2004-W1-9 = 2004-W01-7" - , "2004-W20--2 = 2004-W20-1" - , "2004-W20--1 = 2004-W20-1" - , "2004-W20-0 = 2004-W20-1" - , "2004-W20-1 = 2004-W20-1" - , "2004-W20-4 = 2004-W20-4" - , "2004-W20-6 = 2004-W20-6" - , "2004-W20-7 = 2004-W20-7" - , "2004-W20-8 = 2004-W20-7" - , "2004-W20-9 = 2004-W20-7" - , "2004-W51--2 = 2004-W51-1" - , "2004-W51--1 = 2004-W51-1" - , "2004-W51-0 = 2004-W51-1" - , "2004-W51-1 = 2004-W51-1" - , "2004-W51-4 = 2004-W51-4" - , "2004-W51-6 = 2004-W51-6" - , "2004-W51-7 = 2004-W51-7" - , "2004-W51-8 = 2004-W51-7" - , "2004-W51-9 = 2004-W51-7" - , "2004-W52--2 = 2004-W52-1" - , "2004-W52--1 = 2004-W52-1" - , "2004-W52-0 = 2004-W52-1" - , "2004-W52-1 = 2004-W52-1" - , "2004-W52-4 = 2004-W52-4" - , "2004-W52-6 = 2004-W52-6" - , "2004-W52-7 = 2004-W52-7" - , "2004-W52-8 = 2004-W52-7" - , "2004-W52-9 = 2004-W52-7" - , "2004-W53--2 = 2004-W53-1" - , "2004-W53--1 = 2004-W53-1" - , "2004-W53-0 = 2004-W53-1" - , "2004-W53-1 = 2004-W53-1" - , "2004-W53-4 = 2004-W53-4" - , "2004-W53-6 = 2004-W53-6" - , "2004-W53-7 = 2004-W53-7" - , "2004-W53-8 = 2004-W53-7" - , "2004-W53-9 = 2004-W53-7" - , "2004-W54--2 = 2004-W53-1" - , "2004-W54--1 = 2004-W53-1" - , "2004-W54-0 = 2004-W53-1" - , "2004-W54-1 = 2004-W53-1" - , "2004-W54-4 = 2004-W53-4" - , "2004-W54-6 = 2004-W53-6" - , "2004-W54-7 = 2004-W53-7" - , "2004-W54-8 = 2004-W53-7" - , "2004-W54-9 = 2004-W53-7" ] diff --git a/test/Test/ConvertBack.hs b/test/Test/ConvertBack.hs deleted file mode 100644 --- a/test/Test/ConvertBack.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Test.ConvertBack where - -import Data.Time.Calendar.OrdinalDate -import Data.Time.Calendar.Julian -import Data.Time.Calendar.WeekDate -import Data.Time.Calendar -import Test.TestUtil - -checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String -checkDay encodeDay decodeDay decodeDayValid day = let - st = encodeDay day - day' = decodeDay st - mday' = decodeDayValid st - - a = if day /= day' - then unwords [ show day, "-> " - , show st, "-> " - , show day' - , "(diff", show (diffDays day' day) ++ ")" ] - else "" - - b = if Just day /= mday' - then unwords [show day, "->", show st, "->", show mday'] - else "" - in a ++ b - -checkers :: [Day -> String] -checkers - = [ checkDay toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d) - , checkDay toWeekDate (\(y,w,d) -> fromWeekDate y w d) (\(y,w,d) -> fromWeekDateValid y w d) - , checkDay toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d) - , checkDay toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d) ] - -days :: [Day] -days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++ - (fmap (\year -> (fromGregorian year 1 4)) [1980..2000]) - -convertBack :: Test -convertBack = pureTest "convertBack" $ - diff "" $ concatMap (\ch -> concatMap ch days) checkers diff --git a/test/Test/LongWeekYears.hs b/test/Test/LongWeekYears.hs deleted file mode 100644 --- a/test/Test/LongWeekYears.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Test.LongWeekYears where - -import Data.Time.Calendar.WeekDate -import Data.Time.Calendar -import Test.TestUtil -import Test.LongWeekYearsRef - -longYear :: Integer -> Bool -longYear year = case toWeekDate (fromGregorian year 12 31) of - (_,53,_) -> True - _ -> False - -showLongYear :: Integer -> String -showLongYear year - = unwords [ show year ++ ":" - , (if isLeapYear year then "L" else " ") ++ (if longYear year then "*" else " ") ] - -longWeekYears :: Test -longWeekYears = pureTest "longWeekYears" $ - diff longWeekYearsRef $ unlines $ map showLongYear [1901 .. 2050] diff --git a/test/Test/LongWeekYearsRef.hs b/test/Test/LongWeekYearsRef.hs deleted file mode 100644 --- a/test/Test/LongWeekYearsRef.hs +++ /dev/null @@ -1,155 +0,0 @@ -module Test.LongWeekYearsRef where - -longWeekYearsRef :: String -longWeekYearsRef = - unlines - [ "1901: " - , "1902: " - , "1903: *" - , "1904: L " - , "1905: " - , "1906: " - , "1907: " - , "1908: L*" - , "1909: " - , "1910: " - , "1911: " - , "1912: L " - , "1913: " - , "1914: *" - , "1915: " - , "1916: L " - , "1917: " - , "1918: " - , "1919: " - , "1920: L*" - , "1921: " - , "1922: " - , "1923: " - , "1924: L " - , "1925: *" - , "1926: " - , "1927: " - , "1928: L " - , "1929: " - , "1930: " - , "1931: *" - , "1932: L " - , "1933: " - , "1934: " - , "1935: " - , "1936: L*" - , "1937: " - , "1938: " - , "1939: " - , "1940: L " - , "1941: " - , "1942: *" - , "1943: " - , "1944: L " - , "1945: " - , "1946: " - , "1947: " - , "1948: L*" - , "1949: " - , "1950: " - , "1951: " - , "1952: L " - , "1953: *" - , "1954: " - , "1955: " - , "1956: L " - , "1957: " - , "1958: " - , "1959: *" - , "1960: L " - , "1961: " - , "1962: " - , "1963: " - , "1964: L*" - , "1965: " - , "1966: " - , "1967: " - , "1968: L " - , "1969: " - , "1970: *" - , "1971: " - , "1972: L " - , "1973: " - , "1974: " - , "1975: " - , "1976: L*" - , "1977: " - , "1978: " - , "1979: " - , "1980: L " - , "1981: *" - , "1982: " - , "1983: " - , "1984: L " - , "1985: " - , "1986: " - , "1987: *" - , "1988: L " - , "1989: " - , "1990: " - , "1991: " - , "1992: L*" - , "1993: " - , "1994: " - , "1995: " - , "1996: L " - , "1997: " - , "1998: *" - , "1999: " - , "2000: L " - , "2001: " - , "2002: " - , "2003: " - , "2004: L*" - , "2005: " - , "2006: " - , "2007: " - , "2008: L " - , "2009: *" - , "2010: " - , "2011: " - , "2012: L " - , "2013: " - , "2014: " - , "2015: *" - , "2016: L " - , "2017: " - , "2018: " - , "2019: " - , "2020: L*" - , "2021: " - , "2022: " - , "2023: " - , "2024: L " - , "2025: " - , "2026: *" - , "2027: " - , "2028: L " - , "2029: " - , "2030: " - , "2031: " - , "2032: L*" - , "2033: " - , "2034: " - , "2035: " - , "2036: L " - , "2037: *" - , "2038: " - , "2039: " - , "2040: L " - , "2041: " - , "2042: " - , "2043: *" - , "2044: L " - , "2045: " - , "2046: " - , "2047: " - , "2048: L*" - , "2049: " - , "2050: " ] diff --git a/test/Test/TestCalendars.hs b/test/Test/TestCalendars.hs deleted file mode 100644 --- a/test/Test/TestCalendars.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Test.TestCalendars where - -import Data.Time.Calendar.Julian -import Data.Time.Calendar.WeekDate -import Data.Time.Calendar -import Test.TestUtil -import Test.TestCalendarsRef - -showers :: [(String,Day -> String)] -showers = [ - ("MJD",show . toModifiedJulianDay), - ("Gregorian",showGregorian), - ("Julian",showJulian), - ("ISO 8601",showWeekDate) - ] - -days :: [Day] -days = [ - fromGregorian 0 12 31, - fromJulian 1752 9 2, - fromGregorian 1752 9 14, - fromGregorian 2005 1 23 - ] - -testCalendars :: Test -testCalendars = pureTest "testCalendars" $ - diff testCalendarsRef $ unlines $ map (\d -> showShowers d) days - where - showShowers day = - concatMap (\(nm,shower) -> unwords [" ==", nm, shower day]) showers diff --git a/test/Test/TestCalendarsRef.hs b/test/Test/TestCalendarsRef.hs deleted file mode 100644 --- a/test/Test/TestCalendarsRef.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Test.TestCalendarsRef where - -testCalendarsRef :: String -testCalendarsRef = - unlines - [ " == MJD -678576 == Gregorian 0000-12-31 == Julian 0001-01-02 == ISO 8601 0000-W52-7" - , " == MJD -38780 == Gregorian 1752-09-13 == Julian 1752-09-02 == ISO 8601 1752-W37-3" - , " == MJD -38779 == Gregorian 1752-09-14 == Julian 1752-09-03 == ISO 8601 1752-W37-4" - , " == MJD 53393 == Gregorian 2005-01-23 == Julian 2005-01-10 == ISO 8601 2005-W03-7" ] diff --git a/test/Test/TestEaster.hs b/test/Test/TestEaster.hs deleted file mode 100644 --- a/test/Test/TestEaster.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# OPTIONS -Wall -Werror #-} - -module Test.TestEaster where - -import Data.Time.Calendar.Easter -import Data.Time.Calendar -import Data.Time.Format - -import Test.TestUtil -import Test.TestEasterRef - --- - -days :: [Day] -days = [ModifiedJulianDay 53000 .. ModifiedJulianDay 53014] - -showWithWDay :: Day -> String -showWithWDay = formatTime defaultTimeLocale "%F %A" - -testEaster :: Test -testEaster = pureTest "testEaster" $ let - ds = unlines $ map (\day -> - unwords [ showWithWDay day, "->" - , showWithWDay (sundayAfter day)]) days - - f y = unwords [ show y ++ ", Gregorian: moon," - , show (gregorianPaschalMoon y) ++ ": Easter," - , showWithWDay (gregorianEaster y)] - ++ "\n" - - g y = unwords [ show y ++ ", Orthodox : moon," - , show (orthodoxPaschalMoon y) ++ ": Easter," - , showWithWDay (orthodoxEaster y)] - ++ "\n" - - in diff testEasterRef $ ds ++ concatMap (\y -> f y ++ g y) [2000..2020] diff --git a/test/Test/TestEasterRef.hs b/test/Test/TestEasterRef.hs deleted file mode 100644 --- a/test/Test/TestEasterRef.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Test.TestEasterRef where - -testEasterRef :: String -testEasterRef = - unlines - [ "2003-12-27 Saturday -> 2003-12-28 Sunday" - , "2003-12-28 Sunday -> 2004-01-04 Sunday" - , "2003-12-29 Monday -> 2004-01-04 Sunday" - , "2003-12-30 Tuesday -> 2004-01-04 Sunday" - , "2003-12-31 Wednesday -> 2004-01-04 Sunday" - , "2004-01-01 Thursday -> 2004-01-04 Sunday" - , "2004-01-02 Friday -> 2004-01-04 Sunday" - , "2004-01-03 Saturday -> 2004-01-04 Sunday" - , "2004-01-04 Sunday -> 2004-01-11 Sunday" - , "2004-01-05 Monday -> 2004-01-11 Sunday" - , "2004-01-06 Tuesday -> 2004-01-11 Sunday" - , "2004-01-07 Wednesday -> 2004-01-11 Sunday" - , "2004-01-08 Thursday -> 2004-01-11 Sunday" - , "2004-01-09 Friday -> 2004-01-11 Sunday" - , "2004-01-10 Saturday -> 2004-01-11 Sunday" - , "2000, Gregorian: moon, 2000-04-18: Easter, 2000-04-23 Sunday" - , "2000, Orthodox : moon, 2000-04-23: Easter, 2000-04-30 Sunday" - , "2001, Gregorian: moon, 2001-04-08: Easter, 2001-04-15 Sunday" - , "2001, Orthodox : moon, 2001-04-12: Easter, 2001-04-15 Sunday" - , "2002, Gregorian: moon, 2002-03-28: Easter, 2002-03-31 Sunday" - , "2002, Orthodox : moon, 2002-05-01: Easter, 2002-05-05 Sunday" - , "2003, Gregorian: moon, 2003-04-16: Easter, 2003-04-20 Sunday" - , "2003, Orthodox : moon, 2003-04-20: Easter, 2003-04-27 Sunday" - , "2004, Gregorian: moon, 2004-04-05: Easter, 2004-04-11 Sunday" - , "2004, Orthodox : moon, 2004-04-09: Easter, 2004-04-11 Sunday" - , "2005, Gregorian: moon, 2005-03-25: Easter, 2005-03-27 Sunday" - , "2005, Orthodox : moon, 2005-04-28: Easter, 2005-05-01 Sunday" - , "2006, Gregorian: moon, 2006-04-13: Easter, 2006-04-16 Sunday" - , "2006, Orthodox : moon, 2006-04-17: Easter, 2006-04-23 Sunday" - , "2007, Gregorian: moon, 2007-04-02: Easter, 2007-04-08 Sunday" - , "2007, Orthodox : moon, 2007-04-06: Easter, 2007-04-08 Sunday" - , "2008, Gregorian: moon, 2008-03-22: Easter, 2008-03-23 Sunday" - , "2008, Orthodox : moon, 2008-04-25: Easter, 2008-04-27 Sunday" - , "2009, Gregorian: moon, 2009-04-10: Easter, 2009-04-12 Sunday" - , "2009, Orthodox : moon, 2009-04-14: Easter, 2009-04-19 Sunday" - , "2010, Gregorian: moon, 2010-03-30: Easter, 2010-04-04 Sunday" - , "2010, Orthodox : moon, 2010-04-03: Easter, 2010-04-04 Sunday" - , "2011, Gregorian: moon, 2011-04-18: Easter, 2011-04-24 Sunday" - , "2011, Orthodox : moon, 2011-04-22: Easter, 2011-04-24 Sunday" - , "2012, Gregorian: moon, 2012-04-07: Easter, 2012-04-08 Sunday" - , "2012, Orthodox : moon, 2012-04-11: Easter, 2012-04-15 Sunday" - , "2013, Gregorian: moon, 2013-03-27: Easter, 2013-03-31 Sunday" - , "2013, Orthodox : moon, 2013-04-30: Easter, 2013-05-05 Sunday" - , "2014, Gregorian: moon, 2014-04-14: Easter, 2014-04-20 Sunday" - , "2014, Orthodox : moon, 2014-04-18: Easter, 2014-04-20 Sunday" - , "2015, Gregorian: moon, 2015-04-03: Easter, 2015-04-05 Sunday" - , "2015, Orthodox : moon, 2015-04-07: Easter, 2015-04-12 Sunday" - , "2016, Gregorian: moon, 2016-03-23: Easter, 2016-03-27 Sunday" - , "2016, Orthodox : moon, 2016-04-26: Easter, 2016-05-01 Sunday" - , "2017, Gregorian: moon, 2017-04-11: Easter, 2017-04-16 Sunday" - , "2017, Orthodox : moon, 2017-04-15: Easter, 2017-04-16 Sunday" - , "2018, Gregorian: moon, 2018-03-31: Easter, 2018-04-01 Sunday" - , "2018, Orthodox : moon, 2018-04-04: Easter, 2018-04-08 Sunday" - , "2019, Gregorian: moon, 2019-04-18: Easter, 2019-04-21 Sunday" - , "2019, Orthodox : moon, 2019-04-23: Easter, 2019-04-28 Sunday" - , "2020, Gregorian: moon, 2020-04-08: Easter, 2020-04-12 Sunday" - , "2020, Orthodox : moon, 2020-04-12: Easter, 2020-04-19 Sunday" ] diff --git a/test/Test/TestFormat.hs b/test/Test/TestFormat.hs deleted file mode 100644 --- a/test/Test/TestFormat.hs +++ /dev/null @@ -1,185 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module Test.TestFormat where - -import Data.Time -import Data.Time.Clock.POSIX -import Data.Char -import Foreign -import Foreign.C -import Control.Exception; -import Test.TestUtil - -{- - size_t format_time ( - char *s, size_t maxsize, - const char *format, - int isdst,int gmtoff,time_t t); --} - -foreign import ccall unsafe "TestFormatStuff.h format_time" format_time :: CString -> CSize -> CString -> CInt -> CInt -> CString -> CTime -> IO CSize - -withBuffer :: Int -> (CString -> IO CSize) -> IO String -withBuffer n f = withArray (replicate n 0) (\buffer -> do - len <- f buffer - peekCStringLen (buffer,fromIntegral len) - ) - -unixFormatTime :: String -> TimeZone -> UTCTime -> IO String -unixFormatTime fmt zone time = withCString fmt (\pfmt -> withCString (timeZoneName zone) (\pzonename -> - withBuffer 100 (\buffer -> format_time buffer 100 pfmt - (if timeZoneSummerOnly zone then 1 else 0) - (fromIntegral (timeZoneMinutes zone * 60)) - pzonename - (fromInteger (truncate (utcTimeToPOSIXSeconds time))) - ) - )) - -locale :: TimeLocale -locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"} - -zones :: [TimeZone] -zones = [utc,TimeZone 87 True "Fenwickian Daylight Time"] - -baseTime0 :: UTCTime -baseTime0 = localTimeToUTC utc (LocalTime (fromGregorian 1970 01 01) midnight) - -baseTime1 :: UTCTime -baseTime1 = localTimeToUTC utc (LocalTime (fromGregorian 2000 01 01) midnight) - -getDay :: Integer -> UTCTime -getDay day = addUTCTime ((fromInteger day) * posixDayLength) baseTime1 - -getYearP1 :: Integer -> UTCTime -getYearP1 year = localTimeToUTC utc (LocalTime (fromGregorian year 01 01) midnight) - -getYearP2 :: Integer -> UTCTime -getYearP2 year = localTimeToUTC utc (LocalTime (fromGregorian year 02 04) midnight) - -getYearP3 :: Integer -> UTCTime -getYearP3 year = localTimeToUTC utc (LocalTime (fromGregorian year 03 04) midnight) - -getYearP4 :: Integer -> UTCTime -getYearP4 year = localTimeToUTC utc (LocalTime (fromGregorian year 12 31) midnight) - -years :: [Integer] -years = [999,1000,1899,1900,1901] ++ [1980..2000] ++ [9999,10000] - -times :: [UTCTime] -times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++ - (fmap getYearP1 years) ++ (fmap getYearP2 years) ++ (fmap getYearP3 years) ++ (fmap getYearP4 years) - -padN :: Int -> Char -> String -> String -padN n _ s | n <= (length s) = s -padN n c s = (replicate (n - length s) c) ++ s - -unixWorkarounds :: String -> String -> String -unixWorkarounds "%_Y" s = padN 4 ' ' s -unixWorkarounds "%0Y" s = padN 4 '0' s -unixWorkarounds "%_C" s = padN 2 ' ' s -unixWorkarounds "%0C" s = padN 2 '0' s -unixWorkarounds "%_G" s = padN 4 ' ' s -unixWorkarounds "%0G" s = padN 4 '0' s -unixWorkarounds "%_f" s = padN 2 ' ' s -unixWorkarounds "%0f" s = padN 2 '0' s -unixWorkarounds _ s = s - -compareFormat :: String -> (String -> String) -> String -> TimeZone -> UTCTime -> Test -compareFormat testname modUnix fmt zone time = let - ctime = utcToZonedTime zone time - haskellText = formatTime locale fmt ctime - in ioTest (testname ++ ": " ++ (show fmt) ++ " of " ++ (show ctime)) $ - do - unixText <- unixFormatTime fmt zone time - let expectedText = unixWorkarounds fmt (modUnix unixText) - return $ diff expectedText haskellText - --- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html --- plus FgGklz --- f not supported --- P not always supported --- s time-zone dependent -chars :: [Char] -chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%" - --- as found in "man strftime" on a glibc system. '#' is different, though -modifiers :: [Char] -modifiers = "_-0^" - -formats :: [String] -formats = ["%G-W%V-%u","%U-%w","%W-%u"] ++ (fmap (\char -> '%':char:[]) chars) - ++ (concat (fmap (\char -> fmap (\modifier -> '%':modifier:char:[]) modifiers) chars)) - -hashformats :: [String] -hashformats = (fmap (\char -> '%':'#':char:[]) chars) - -somestrings :: [String] -somestrings = ["", " ", "-", "\n"] - -getBottom :: a -> IO (Maybe Control.Exception.SomeException); -getBottom a = Control.Exception.catch (seq a (return Nothing)) (return . Just); - -safeString :: String -> IO String -safeString s = do - msx <- getBottom s - case msx of - Just sx -> return (show sx) - Nothing -> case s of - (c:cc) -> do - mcx <- getBottom c - case mcx of - Just cx -> return (show cx) - Nothing -> do - ss <- safeString cc - return (c:ss) - [] -> return "" - -compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> Maybe t -> Test -compareExpected testname fmt str expected = ioTest (testname ++ ": " ++ (show fmt) ++ " on " ++ (show str)) $ do - let found = parseTimeM False defaultTimeLocale fmt str - mex <- getBottom found - case mex of - Just ex -> return $ Fail $ unwords [ "Exception: expected" , show expected ++ ", caught", show ex] - Nothing -> return $ diff expected found - -class (ParseTime t) => TestParse t where - expectedParse :: String -> String -> Maybe t - expectedParse "%Z" "" = buildTime defaultTimeLocale [] - expectedParse "%_Z" "" = buildTime defaultTimeLocale [] - expectedParse "%-Z" "" = buildTime defaultTimeLocale [] - expectedParse "%0Z" "" = buildTime defaultTimeLocale [] - expectedParse _ _ = Nothing - -instance TestParse Day -instance TestParse TimeOfDay -instance TestParse LocalTime -instance TestParse TimeZone -instance TestParse ZonedTime -instance TestParse UTCTime - -checkParse :: String -> String -> [Test] -checkParse fmt str - = [ compareExpected "Day" fmt str (expectedParse fmt str :: Maybe Day) - , compareExpected "TimeOfDay" fmt str (expectedParse fmt str :: Maybe TimeOfDay) - , compareExpected "LocalTime" fmt str (expectedParse fmt str :: Maybe LocalTime) - , compareExpected "TimeZone" fmt str (expectedParse fmt str :: Maybe TimeZone) - , compareExpected "UTCTime" fmt str (expectedParse fmt str :: Maybe UTCTime) ] - -testCheckParse :: [Test] -testCheckParse = concatMap (\fmt -> concatMap (\str -> checkParse fmt str) somestrings) formats - -testCompareFormat :: [Test] -testCompareFormat = concatMap (\fmt -> concatMap (\time -> fmap (\zone -> compareFormat "compare format" id fmt zone time) zones) times) formats - -testCompareHashFormat :: [Test] -testCompareHashFormat = concatMap (\fmt -> concatMap (\time -> fmap (\zone -> compareFormat "compare hashformat" (fmap toLower) fmt zone time) zones) times) hashformats - -testFormats :: [Test] -testFormats = [ - testGroup "checkParse" testCheckParse, - testGroup "compare format" testCompareFormat, - testGroup "compare hashformat" testCompareHashFormat - ] - -testFormat :: Test -testFormat = testGroup "testFormat" testFormats diff --git a/test/Test/TestFormatStuff.c b/test/Test/TestFormatStuff.c deleted file mode 100644 --- a/test/Test/TestFormatStuff.c +++ /dev/null @@ -1,15 +0,0 @@ -#include "TestFormatStuff.h" - -size_t format_time ( - char* buffer, size_t maxsize, - const char* format, - int isdst,int gmtoff,char* zonename,time_t t) -{ - t += gmtoff; - struct tm tmd; - gmtime_r(&t,&tmd); - tmd.tm_isdst = isdst; - tmd.tm_gmtoff = gmtoff; - tmd.tm_zone = zonename; - return strftime(buffer,maxsize,format,&tmd); -} diff --git a/test/Test/TestFormatStuff.h b/test/Test/TestFormatStuff.h deleted file mode 100644 --- a/test/Test/TestFormatStuff.h +++ /dev/null @@ -1,6 +0,0 @@ -#include - -size_t format_time ( - char *s, size_t maxsize, - const char *format, - int isdst,int gmtoff,char* zonename,time_t t); diff --git a/test/Test/TestMonthDay.hs b/test/Test/TestMonthDay.hs deleted file mode 100644 --- a/test/Test/TestMonthDay.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Test.TestMonthDay where - -import Data.Time.Calendar.MonthDay -import Test.TestUtil -import Test.TestMonthDayRef - -showCompare :: (Eq a,Show a) => a -> String -> a -> String -showCompare a1 b a2 | a1 == a2 = (show a1) ++ " == " ++ b -showCompare a1 b a2 = "DIFF: " ++ (show a1) ++ " -> " ++ b ++ " -> " ++ (show a2) - -testMonthDay :: Test -testMonthDay = pureTest "testMonthDay" $ - diff testMonthDayRef $ concat $ map (\isL -> unlines (leap isL : yearDays isL)) [False,True] - where - leap isLeap = if isLeap then "Leap:" else "Regular:" - yearDays isLeap = - map (\yd -> let - (m,d) = dayOfYearToMonthAndDay isLeap yd - yd' = monthAndDayToDayOfYear isLeap m d - mdtext = show m ++ "-" ++ show d - in showCompare yd mdtext yd') - [-2..369] diff --git a/test/Test/TestMonthDayRef.hs b/test/Test/TestMonthDayRef.hs deleted file mode 100644 --- a/test/Test/TestMonthDayRef.hs +++ /dev/null @@ -1,751 +0,0 @@ -module Test.TestMonthDayRef where - -testMonthDayRef :: String -testMonthDayRef = - unlines - [ "Regular:" - , "DIFF: -2 -> 1-1 -> 1" - , "DIFF: -1 -> 1-1 -> 1" - , "DIFF: 0 -> 1-1 -> 1" - , "1 == 1-1" - , "2 == 1-2" - , "3 == 1-3" - , "4 == 1-4" - , "5 == 1-5" - , "6 == 1-6" - , "7 == 1-7" - , "8 == 1-8" - , "9 == 1-9" - , "10 == 1-10" - , "11 == 1-11" - , "12 == 1-12" - , "13 == 1-13" - , "14 == 1-14" - , "15 == 1-15" - , "16 == 1-16" - , "17 == 1-17" - , "18 == 1-18" - , "19 == 1-19" - , "20 == 1-20" - , "21 == 1-21" - , "22 == 1-22" - , "23 == 1-23" - , "24 == 1-24" - , "25 == 1-25" - , "26 == 1-26" - , "27 == 1-27" - , "28 == 1-28" - , "29 == 1-29" - , "30 == 1-30" - , "31 == 1-31" - , "32 == 2-1" - , "33 == 2-2" - , "34 == 2-3" - , "35 == 2-4" - , "36 == 2-5" - , "37 == 2-6" - , "38 == 2-7" - , "39 == 2-8" - , "40 == 2-9" - , "41 == 2-10" - , "42 == 2-11" - , "43 == 2-12" - , "44 == 2-13" - , "45 == 2-14" - , "46 == 2-15" - , "47 == 2-16" - , "48 == 2-17" - , "49 == 2-18" - , "50 == 2-19" - , "51 == 2-20" - , "52 == 2-21" - , "53 == 2-22" - , "54 == 2-23" - , "55 == 2-24" - , "56 == 2-25" - , "57 == 2-26" - , "58 == 2-27" - , "59 == 2-28" - , "60 == 3-1" - , "61 == 3-2" - , "62 == 3-3" - , "63 == 3-4" - , "64 == 3-5" - , "65 == 3-6" - , "66 == 3-7" - , "67 == 3-8" - , "68 == 3-9" - , "69 == 3-10" - , "70 == 3-11" - , "71 == 3-12" - , "72 == 3-13" - , "73 == 3-14" - , "74 == 3-15" - , "75 == 3-16" - , "76 == 3-17" - , "77 == 3-18" - , "78 == 3-19" - , "79 == 3-20" - , "80 == 3-21" - , "81 == 3-22" - , "82 == 3-23" - , "83 == 3-24" - , "84 == 3-25" - , "85 == 3-26" - , "86 == 3-27" - , "87 == 3-28" - , "88 == 3-29" - , "89 == 3-30" - , "90 == 3-31" - , "91 == 4-1" - , "92 == 4-2" - , "93 == 4-3" - , "94 == 4-4" - , "95 == 4-5" - , "96 == 4-6" - , "97 == 4-7" - , "98 == 4-8" - , "99 == 4-9" - , "100 == 4-10" - , "101 == 4-11" - , "102 == 4-12" - , "103 == 4-13" - , "104 == 4-14" - , "105 == 4-15" - , "106 == 4-16" - , "107 == 4-17" - , "108 == 4-18" - , "109 == 4-19" - , "110 == 4-20" - , "111 == 4-21" - , "112 == 4-22" - , "113 == 4-23" - , "114 == 4-24" - , "115 == 4-25" - , "116 == 4-26" - , "117 == 4-27" - , "118 == 4-28" - , "119 == 4-29" - , "120 == 4-30" - , "121 == 5-1" - , "122 == 5-2" - , "123 == 5-3" - , "124 == 5-4" - , "125 == 5-5" - , "126 == 5-6" - , "127 == 5-7" - , "128 == 5-8" - , "129 == 5-9" - , "130 == 5-10" - , "131 == 5-11" - , "132 == 5-12" - , "133 == 5-13" - , "134 == 5-14" - , "135 == 5-15" - , "136 == 5-16" - , "137 == 5-17" - , "138 == 5-18" - , "139 == 5-19" - , "140 == 5-20" - , "141 == 5-21" - , "142 == 5-22" - , "143 == 5-23" - , "144 == 5-24" - , "145 == 5-25" - , "146 == 5-26" - , "147 == 5-27" - , "148 == 5-28" - , "149 == 5-29" - , "150 == 5-30" - , "151 == 5-31" - , "152 == 6-1" - , "153 == 6-2" - , "154 == 6-3" - , "155 == 6-4" - , "156 == 6-5" - , "157 == 6-6" - , "158 == 6-7" - , "159 == 6-8" - , "160 == 6-9" - , "161 == 6-10" - , "162 == 6-11" - , "163 == 6-12" - , "164 == 6-13" - , "165 == 6-14" - , "166 == 6-15" - , "167 == 6-16" - , "168 == 6-17" - , "169 == 6-18" - , "170 == 6-19" - , "171 == 6-20" - , "172 == 6-21" - , "173 == 6-22" - , "174 == 6-23" - , "175 == 6-24" - , "176 == 6-25" - , "177 == 6-26" - , "178 == 6-27" - , "179 == 6-28" - , "180 == 6-29" - , "181 == 6-30" - , "182 == 7-1" - , "183 == 7-2" - , "184 == 7-3" - , "185 == 7-4" - , "186 == 7-5" - , "187 == 7-6" - , "188 == 7-7" - , "189 == 7-8" - , "190 == 7-9" - , "191 == 7-10" - , "192 == 7-11" - , "193 == 7-12" - , "194 == 7-13" - , "195 == 7-14" - , "196 == 7-15" - , "197 == 7-16" - , "198 == 7-17" - , "199 == 7-18" - , "200 == 7-19" - , "201 == 7-20" - , "202 == 7-21" - , "203 == 7-22" - , "204 == 7-23" - , "205 == 7-24" - , "206 == 7-25" - , "207 == 7-26" - , "208 == 7-27" - , "209 == 7-28" - , "210 == 7-29" - , "211 == 7-30" - , "212 == 7-31" - , "213 == 8-1" - , "214 == 8-2" - , "215 == 8-3" - , "216 == 8-4" - , "217 == 8-5" - , "218 == 8-6" - , "219 == 8-7" - , "220 == 8-8" - , "221 == 8-9" - , "222 == 8-10" - , "223 == 8-11" - , "224 == 8-12" - , "225 == 8-13" - , "226 == 8-14" - , "227 == 8-15" - , "228 == 8-16" - , "229 == 8-17" - , "230 == 8-18" - , "231 == 8-19" - , "232 == 8-20" - , "233 == 8-21" - , "234 == 8-22" - , "235 == 8-23" - , "236 == 8-24" - , "237 == 8-25" - , "238 == 8-26" - , "239 == 8-27" - , "240 == 8-28" - , "241 == 8-29" - , "242 == 8-30" - , "243 == 8-31" - , "244 == 9-1" - , "245 == 9-2" - , "246 == 9-3" - , "247 == 9-4" - , "248 == 9-5" - , "249 == 9-6" - , "250 == 9-7" - , "251 == 9-8" - , "252 == 9-9" - , "253 == 9-10" - , "254 == 9-11" - , "255 == 9-12" - , "256 == 9-13" - , "257 == 9-14" - , "258 == 9-15" - , "259 == 9-16" - , "260 == 9-17" - , "261 == 9-18" - , "262 == 9-19" - , "263 == 9-20" - , "264 == 9-21" - , "265 == 9-22" - , "266 == 9-23" - , "267 == 9-24" - , "268 == 9-25" - , "269 == 9-26" - , "270 == 9-27" - , "271 == 9-28" - , "272 == 9-29" - , "273 == 9-30" - , "274 == 10-1" - , "275 == 10-2" - , "276 == 10-3" - , "277 == 10-4" - , "278 == 10-5" - , "279 == 10-6" - , "280 == 10-7" - , "281 == 10-8" - , "282 == 10-9" - , "283 == 10-10" - , "284 == 10-11" - , "285 == 10-12" - , "286 == 10-13" - , "287 == 10-14" - , "288 == 10-15" - , "289 == 10-16" - , "290 == 10-17" - , "291 == 10-18" - , "292 == 10-19" - , "293 == 10-20" - , "294 == 10-21" - , "295 == 10-22" - , "296 == 10-23" - , "297 == 10-24" - , "298 == 10-25" - , "299 == 10-26" - , "300 == 10-27" - , "301 == 10-28" - , "302 == 10-29" - , "303 == 10-30" - , "304 == 10-31" - , "305 == 11-1" - , "306 == 11-2" - , "307 == 11-3" - , "308 == 11-4" - , "309 == 11-5" - , "310 == 11-6" - , "311 == 11-7" - , "312 == 11-8" - , "313 == 11-9" - , "314 == 11-10" - , "315 == 11-11" - , "316 == 11-12" - , "317 == 11-13" - , "318 == 11-14" - , "319 == 11-15" - , "320 == 11-16" - , "321 == 11-17" - , "322 == 11-18" - , "323 == 11-19" - , "324 == 11-20" - , "325 == 11-21" - , "326 == 11-22" - , "327 == 11-23" - , "328 == 11-24" - , "329 == 11-25" - , "330 == 11-26" - , "331 == 11-27" - , "332 == 11-28" - , "333 == 11-29" - , "334 == 11-30" - , "335 == 12-1" - , "336 == 12-2" - , "337 == 12-3" - , "338 == 12-4" - , "339 == 12-5" - , "340 == 12-6" - , "341 == 12-7" - , "342 == 12-8" - , "343 == 12-9" - , "344 == 12-10" - , "345 == 12-11" - , "346 == 12-12" - , "347 == 12-13" - , "348 == 12-14" - , "349 == 12-15" - , "350 == 12-16" - , "351 == 12-17" - , "352 == 12-18" - , "353 == 12-19" - , "354 == 12-20" - , "355 == 12-21" - , "356 == 12-22" - , "357 == 12-23" - , "358 == 12-24" - , "359 == 12-25" - , "360 == 12-26" - , "361 == 12-27" - , "362 == 12-28" - , "363 == 12-29" - , "364 == 12-30" - , "365 == 12-31" - , "DIFF: 366 -> 12-31 -> 365" - , "DIFF: 367 -> 12-31 -> 365" - , "DIFF: 368 -> 12-31 -> 365" - , "DIFF: 369 -> 12-31 -> 365" - , "Leap:" - , "DIFF: -2 -> 1-1 -> 1" - , "DIFF: -1 -> 1-1 -> 1" - , "DIFF: 0 -> 1-1 -> 1" - , "1 == 1-1" - , "2 == 1-2" - , "3 == 1-3" - , "4 == 1-4" - , "5 == 1-5" - , "6 == 1-6" - , "7 == 1-7" - , "8 == 1-8" - , "9 == 1-9" - , "10 == 1-10" - , "11 == 1-11" - , "12 == 1-12" - , "13 == 1-13" - , "14 == 1-14" - , "15 == 1-15" - , "16 == 1-16" - , "17 == 1-17" - , "18 == 1-18" - , "19 == 1-19" - , "20 == 1-20" - , "21 == 1-21" - , "22 == 1-22" - , "23 == 1-23" - , "24 == 1-24" - , "25 == 1-25" - , "26 == 1-26" - , "27 == 1-27" - , "28 == 1-28" - , "29 == 1-29" - , "30 == 1-30" - , "31 == 1-31" - , "32 == 2-1" - , "33 == 2-2" - , "34 == 2-3" - , "35 == 2-4" - , "36 == 2-5" - , "37 == 2-6" - , "38 == 2-7" - , "39 == 2-8" - , "40 == 2-9" - , "41 == 2-10" - , "42 == 2-11" - , "43 == 2-12" - , "44 == 2-13" - , "45 == 2-14" - , "46 == 2-15" - , "47 == 2-16" - , "48 == 2-17" - , "49 == 2-18" - , "50 == 2-19" - , "51 == 2-20" - , "52 == 2-21" - , "53 == 2-22" - , "54 == 2-23" - , "55 == 2-24" - , "56 == 2-25" - , "57 == 2-26" - , "58 == 2-27" - , "59 == 2-28" - , "60 == 2-29" - , "61 == 3-1" - , "62 == 3-2" - , "63 == 3-3" - , "64 == 3-4" - , "65 == 3-5" - , "66 == 3-6" - , "67 == 3-7" - , "68 == 3-8" - , "69 == 3-9" - , "70 == 3-10" - , "71 == 3-11" - , "72 == 3-12" - , "73 == 3-13" - , "74 == 3-14" - , "75 == 3-15" - , "76 == 3-16" - , "77 == 3-17" - , "78 == 3-18" - , "79 == 3-19" - , "80 == 3-20" - , "81 == 3-21" - , "82 == 3-22" - , "83 == 3-23" - , "84 == 3-24" - , "85 == 3-25" - , "86 == 3-26" - , "87 == 3-27" - , "88 == 3-28" - , "89 == 3-29" - , "90 == 3-30" - , "91 == 3-31" - , "92 == 4-1" - , "93 == 4-2" - , "94 == 4-3" - , "95 == 4-4" - , "96 == 4-5" - , "97 == 4-6" - , "98 == 4-7" - , "99 == 4-8" - , "100 == 4-9" - , "101 == 4-10" - , "102 == 4-11" - , "103 == 4-12" - , "104 == 4-13" - , "105 == 4-14" - , "106 == 4-15" - , "107 == 4-16" - , "108 == 4-17" - , "109 == 4-18" - , "110 == 4-19" - , "111 == 4-20" - , "112 == 4-21" - , "113 == 4-22" - , "114 == 4-23" - , "115 == 4-24" - , "116 == 4-25" - , "117 == 4-26" - , "118 == 4-27" - , "119 == 4-28" - , "120 == 4-29" - , "121 == 4-30" - , "122 == 5-1" - , "123 == 5-2" - , "124 == 5-3" - , "125 == 5-4" - , "126 == 5-5" - , "127 == 5-6" - , "128 == 5-7" - , "129 == 5-8" - , "130 == 5-9" - , "131 == 5-10" - , "132 == 5-11" - , "133 == 5-12" - , "134 == 5-13" - , "135 == 5-14" - , "136 == 5-15" - , "137 == 5-16" - , "138 == 5-17" - , "139 == 5-18" - , "140 == 5-19" - , "141 == 5-20" - , "142 == 5-21" - , "143 == 5-22" - , "144 == 5-23" - , "145 == 5-24" - , "146 == 5-25" - , "147 == 5-26" - , "148 == 5-27" - , "149 == 5-28" - , "150 == 5-29" - , "151 == 5-30" - , "152 == 5-31" - , "153 == 6-1" - , "154 == 6-2" - , "155 == 6-3" - , "156 == 6-4" - , "157 == 6-5" - , "158 == 6-6" - , "159 == 6-7" - , "160 == 6-8" - , "161 == 6-9" - , "162 == 6-10" - , "163 == 6-11" - , "164 == 6-12" - , "165 == 6-13" - , "166 == 6-14" - , "167 == 6-15" - , "168 == 6-16" - , "169 == 6-17" - , "170 == 6-18" - , "171 == 6-19" - , "172 == 6-20" - , "173 == 6-21" - , "174 == 6-22" - , "175 == 6-23" - , "176 == 6-24" - , "177 == 6-25" - , "178 == 6-26" - , "179 == 6-27" - , "180 == 6-28" - , "181 == 6-29" - , "182 == 6-30" - , "183 == 7-1" - , "184 == 7-2" - , "185 == 7-3" - , "186 == 7-4" - , "187 == 7-5" - , "188 == 7-6" - , "189 == 7-7" - , "190 == 7-8" - , "191 == 7-9" - , "192 == 7-10" - , "193 == 7-11" - , "194 == 7-12" - , "195 == 7-13" - , "196 == 7-14" - , "197 == 7-15" - , "198 == 7-16" - , "199 == 7-17" - , "200 == 7-18" - , "201 == 7-19" - , "202 == 7-20" - , "203 == 7-21" - , "204 == 7-22" - , "205 == 7-23" - , "206 == 7-24" - , "207 == 7-25" - , "208 == 7-26" - , "209 == 7-27" - , "210 == 7-28" - , "211 == 7-29" - , "212 == 7-30" - , "213 == 7-31" - , "214 == 8-1" - , "215 == 8-2" - , "216 == 8-3" - , "217 == 8-4" - , "218 == 8-5" - , "219 == 8-6" - , "220 == 8-7" - , "221 == 8-8" - , "222 == 8-9" - , "223 == 8-10" - , "224 == 8-11" - , "225 == 8-12" - , "226 == 8-13" - , "227 == 8-14" - , "228 == 8-15" - , "229 == 8-16" - , "230 == 8-17" - , "231 == 8-18" - , "232 == 8-19" - , "233 == 8-20" - , "234 == 8-21" - , "235 == 8-22" - , "236 == 8-23" - , "237 == 8-24" - , "238 == 8-25" - , "239 == 8-26" - , "240 == 8-27" - , "241 == 8-28" - , "242 == 8-29" - , "243 == 8-30" - , "244 == 8-31" - , "245 == 9-1" - , "246 == 9-2" - , "247 == 9-3" - , "248 == 9-4" - , "249 == 9-5" - , "250 == 9-6" - , "251 == 9-7" - , "252 == 9-8" - , "253 == 9-9" - , "254 == 9-10" - , "255 == 9-11" - , "256 == 9-12" - , "257 == 9-13" - , "258 == 9-14" - , "259 == 9-15" - , "260 == 9-16" - , "261 == 9-17" - , "262 == 9-18" - , "263 == 9-19" - , "264 == 9-20" - , "265 == 9-21" - , "266 == 9-22" - , "267 == 9-23" - , "268 == 9-24" - , "269 == 9-25" - , "270 == 9-26" - , "271 == 9-27" - , "272 == 9-28" - , "273 == 9-29" - , "274 == 9-30" - , "275 == 10-1" - , "276 == 10-2" - , "277 == 10-3" - , "278 == 10-4" - , "279 == 10-5" - , "280 == 10-6" - , "281 == 10-7" - , "282 == 10-8" - , "283 == 10-9" - , "284 == 10-10" - , "285 == 10-11" - , "286 == 10-12" - , "287 == 10-13" - , "288 == 10-14" - , "289 == 10-15" - , "290 == 10-16" - , "291 == 10-17" - , "292 == 10-18" - , "293 == 10-19" - , "294 == 10-20" - , "295 == 10-21" - , "296 == 10-22" - , "297 == 10-23" - , "298 == 10-24" - , "299 == 10-25" - , "300 == 10-26" - , "301 == 10-27" - , "302 == 10-28" - , "303 == 10-29" - , "304 == 10-30" - , "305 == 10-31" - , "306 == 11-1" - , "307 == 11-2" - , "308 == 11-3" - , "309 == 11-4" - , "310 == 11-5" - , "311 == 11-6" - , "312 == 11-7" - , "313 == 11-8" - , "314 == 11-9" - , "315 == 11-10" - , "316 == 11-11" - , "317 == 11-12" - , "318 == 11-13" - , "319 == 11-14" - , "320 == 11-15" - , "321 == 11-16" - , "322 == 11-17" - , "323 == 11-18" - , "324 == 11-19" - , "325 == 11-20" - , "326 == 11-21" - , "327 == 11-22" - , "328 == 11-23" - , "329 == 11-24" - , "330 == 11-25" - , "331 == 11-26" - , "332 == 11-27" - , "333 == 11-28" - , "334 == 11-29" - , "335 == 11-30" - , "336 == 12-1" - , "337 == 12-2" - , "338 == 12-3" - , "339 == 12-4" - , "340 == 12-5" - , "341 == 12-6" - , "342 == 12-7" - , "343 == 12-8" - , "344 == 12-9" - , "345 == 12-10" - , "346 == 12-11" - , "347 == 12-12" - , "348 == 12-13" - , "349 == 12-14" - , "350 == 12-15" - , "351 == 12-16" - , "352 == 12-17" - , "353 == 12-18" - , "354 == 12-19" - , "355 == 12-20" - , "356 == 12-21" - , "357 == 12-22" - , "358 == 12-23" - , "359 == 12-24" - , "360 == 12-25" - , "361 == 12-26" - , "362 == 12-27" - , "363 == 12-28" - , "364 == 12-29" - , "365 == 12-30" - , "366 == 12-31" - , "DIFF: 367 -> 12-31 -> 366" - , "DIFF: 368 -> 12-31 -> 366" - , "DIFF: 369 -> 12-31 -> 366" ] diff --git a/test/Test/TestParseTime.hs b/test/Test/TestParseTime.hs deleted file mode 100644 --- a/test/Test/TestParseTime.hs +++ /dev/null @@ -1,601 +0,0 @@ -{-# OPTIONS -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-orphans #-} -{-# LANGUAGE FlexibleInstances, ExistentialQuantification #-} - -module Test.TestParseTime where - -import Control.Monad -import Data.Char -import Data.Ratio -import Data.Time -import Data.Time.Calendar.OrdinalDate -import Data.Time.Calendar.WeekDate -import Data.Time.Clock.POSIX -import Test.QuickCheck hiding (Result,reason) -import Test.QuickCheck.Property -import Test.TestUtil hiding (Result) - -ntest :: Int -ntest = 1000 - -type NamedProperty = (String, Property) - -testParseTime :: Test -testParseTime = testGroup "testParseTime" - [ - readOtherTypesTest, - readTests, - simpleFormatTests, - extests, - particularParseTests, - badParseTests, - defaultTimeZoneTests, - militaryTimeZoneTests, - testGroup "properties" (fmap (\(n,prop) -> testProperty n prop) properties) - ] - -yearDays :: Integer -> [Day] -yearDays y = [(fromGregorian y 1 1) .. (fromGregorian y 12 31)] - -makeExhaustiveTest :: String -> [t] -> (t -> Test) -> Test -makeExhaustiveTest name cases f = testGroup name (fmap f cases) - -extests :: Test -extests = testGroup "exhaustive" ([ - makeExhaustiveTest "parse %y" [0..99] parseYY, - makeExhaustiveTest "parse %-C %y 1900s" [0,1,50,99] (parseCYY 19), - makeExhaustiveTest "parse %-C %y 2000s" [0,1,50,99] (parseCYY 20), - makeExhaustiveTest "parse %-C %y 1400s" [0,1,50,99] (parseCYY 14), - makeExhaustiveTest "parse %C %y 0700s" [0,1,50,99] (parseCYY2 7), - makeExhaustiveTest "parse %-C %y 700s" [0,1,50,99] (parseCYY 7), - makeExhaustiveTest "parse %-C %y 10000s" [0,1,50,99] (parseCYY 100), - makeExhaustiveTest "parse %-C centuries" [20..100] (parseCentury " "), - makeExhaustiveTest "parse %-C century X" [1,10,20,100] (parseCentury "X"), - makeExhaustiveTest "parse %-C century 2sp" [1,10,20,100] (parseCentury " "), - makeExhaustiveTest "parse %-C century 5sp" [1,10,20,100] (parseCentury " ") - ] ++ - (concat $ fmap - (\y -> [ - (makeExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD), - (makeExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD), - (makeExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE) - ]) [1,4,20,753,2000,2011,10001])) - -readTest :: (Eq a,Show a,Read a) => [(a,String)] -> String -> Test -readTest expected target = let - found = reads target - result = diff expected found - name = show target - in pureTest name result - -readTestsParensSpaces :: forall a. (Eq a,Show a,Read a) => a -> String -> Test -readTestsParensSpaces expected target = testGroup target - [ - readTest [(expected,"")] $ target, - readTest [(expected,"")] $ "("++target++")", - readTest [(expected,"")] $ " ("++target++")", - readTest [(expected," ")] $ " ( "++target++" ) ", - readTest [(expected," ")] $ " (( "++target++" )) ", - readTest ([] :: [(a,String)]) $ "("++target, - readTest [(expected,")")] $ ""++target++")", - readTest [(expected,"")] $ "(("++target++"))", - readTest [(expected," ")] $ " ( ( "++target++" ) ) " - ] where - -readOtherTypesTest :: Test -readOtherTypesTest = testGroup "read other types" - [ - readTestsParensSpaces 3 "3", - readTestsParensSpaces "a" "\"a\"" - ] - -readTests :: Test -readTests = testGroup "read times" - [ - readTestsParensSpaces testDay "1912-07-08", - --readTestsParensSpaces testDay "1912-7-8", - readTestsParensSpaces testTimeOfDay "08:04:02" - --,readTestsParensSpaces testTimeOfDay "8:4:2" - ] where - testDay = fromGregorian 1912 7 8 - testTimeOfDay = TimeOfDay 8 4 2 - -epoch :: LocalTime -epoch = LocalTime (fromGregorian 1970 0 0) midnight - -simpleFormatTests :: Test -simpleFormatTests = testGroup "simple" - [ - readsTest [(epoch,"")] "" "", - readsTest [(epoch," ")] "" " ", - readsTest [(epoch,"")] " " " ", - readsTest [(epoch,"")] " " " ", - readsTest [(epoch,"")] "%k" "0", - readsTest [(epoch,"")] "%k" " 0", - readsTest [(epoch,"")] "%m" "01", - readsTest [(epoch," ")] "%m" "01 ", - readsTest [(epoch," ")] " %m" " 01 ", - readsTest [(epoch,"")] " %m" " 01", - -- https://ghc.haskell.org/trac/ghc/ticket/9150 - readsTest [(epoch,"")] " %M" " 00", - readsTest [(epoch,"")] "%M " "00 ", - readsTest [(epoch,"")] "%Q" "", - readsTest [(epoch," ")] "%Q" " ", - readsTest [(epoch,"X")] "%Q" "X", - readsTest [(epoch," X")] "%Q" " X", - readsTest [(epoch,"")] "%Q " " ", - readsTest [(epoch,"")] "%Q X" " X", - readsTest [(epoch,"")] "%QX" "X" - ] where - readsTest :: (Show a, Eq a, ParseTime a) => [(a,String)] -> String -> String -> Test - readsTest expected formatStr target = let - found = readSTime False defaultTimeLocale formatStr target - result = diff expected found - name = (show formatStr) ++ " of " ++ (show target) - in pureTest name result - -spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> Test -spacingTests expected formatStr target = testGroup "particular" - [ - parseTest False (Just expected) formatStr target, - parseTest True (Just expected) formatStr target, - parseTest False (Just expected) (formatStr ++ " ") (target ++ " "), - parseTest True (Just expected) (formatStr ++ " ") (target ++ " "), - parseTest False (Just expected) (" " ++ formatStr) (" " ++ target), - parseTest True (Just expected) (" " ++ formatStr) (" " ++ target), - parseTest True (Just expected) ("" ++ formatStr) (" " ++ target), - parseTest True (Just expected) (" " ++ formatStr) (" " ++ target) - ] - -particularParseTests :: Test -particularParseTests = testGroup "particular" - [ - spacingTests epoch "%Q" "", - spacingTests epoch "%Q" ".0", - spacingTests epoch "%k" " 0", - spacingTests epoch "%M" "00", - spacingTests epoch "%m" "01", - spacingTests (TimeZone 120 False "") "%z" "+0200", - spacingTests (TimeZone 120 False "") "%Z" "+0200", - spacingTests (TimeZone (-480) False "PST") "%Z" "PST" - ] - -badParseTests :: Test -badParseTests = testGroup "bad" - [ - parseTest False (Nothing :: Maybe Day) "%Y" "" - ] - -parseYMD :: Day -> Test -parseYMD day = case toGregorian day of - (y,m,d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d)) - -parseYearDayD :: Day -> Test -parseYearDayD day = case toGregorian day of - (y,m,d) -> parseTest False (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d)) - -parseYearDayE :: Day -> Test -parseYearDayE day = case toGregorian day of - (y,m,d) -> parseTest False (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d)) - --- | 1969 - 2068 -expectedYear :: Integer -> Integer -expectedYear i | i >= 69 = 1900 + i -expectedYear i = 2000 + i - -show2 :: (Show n,Integral n) => n -> String -show2 i = (show (div i 10)) ++ (show (mod i 10)) - -parseYY :: Integer -> Test -parseYY i = parseTest False (Just (fromGregorian (expectedYear i) 1 1)) "%y" (show2 i) - -parseCYY :: Integer -> Integer -> Test -parseCYY c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%-C %y" ((show c) ++ " " ++ (show2 i)) - -parseCYY2 :: Integer -> Integer -> Test -parseCYY2 c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%C %y" ((show2 c) ++ " " ++ (show2 i)) - -parseCentury :: String -> Integer -> Test -parseCentury int c = parseTest False (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00") - -parseTest :: (Show t, Eq t, ParseTime t) => Bool -> Maybe t -> String -> String -> Test -parseTest sp expected formatStr target = - let - found = parse sp formatStr target - result = diff expected found - name = (show formatStr) ++ " of " ++ (show target) ++ (if sp then " allowing spaces" else "") - in pureTest name result -{- -readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> Test -readsTest (Just e) = readsTest' [(e,"")] -readsTest Nothing = readsTest' ([] :: [(t,String)]) --} - -enumAdd :: (Enum a) => Int -> a -> a -enumAdd i a = toEnum (i + fromEnum a) - -getMilZoneLetter :: Int -> Char -getMilZoneLetter 0 = 'Z' -getMilZoneLetter h | h < 0 = enumAdd (negate h) 'M' -getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A' -getMilZoneLetter h = enumAdd (h - 10) 'K' - -getMilZone :: Int -> TimeZone -getMilZone hour = TimeZone (hour * 60) False [getMilZoneLetter hour] - -testParseTimeZone :: TimeZone -> Test -testParseTimeZone tz = parseTest False (Just tz) "%Z" (timeZoneName tz) - -defaultTimeZoneTests :: Test -defaultTimeZoneTests = testGroup "default time zones" (fmap testParseTimeZone (knownTimeZones defaultTimeLocale)) - -militaryTimeZoneTests :: Test -militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12]) - - -parse :: ParseTime t => Bool -> String -> String -> Maybe t -parse sp f t = parseTimeM sp defaultTimeLocale f t - -format :: (FormatTime t) => String -> t -> String -format f t = formatTime defaultTimeLocale f t - -instance Arbitrary Day where - arbitrary = liftM ModifiedJulianDay $ choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31 - -instance CoArbitrary Day where - coarbitrary (ModifiedJulianDay d) = coarbitrary d - -instance Arbitrary DiffTime where - arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second - where intSecs = liftM secondsToDiffTime' $ choose (0, 86400) - fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86400 * 10^12) - secondsToDiffTime' :: Integer -> DiffTime - secondsToDiffTime' = fromInteger - picosecondsToDiffTime' :: Integer -> DiffTime - picosecondsToDiffTime' x = fromRational (x % 10^12) - -instance CoArbitrary DiffTime where - coarbitrary t = coarbitrary (fromEnum t) - -instance Arbitrary TimeOfDay where - arbitrary = liftM timeToTimeOfDay arbitrary - -instance CoArbitrary TimeOfDay where - coarbitrary t = coarbitrary (timeOfDayToTime t) - -instance Arbitrary LocalTime where - arbitrary = liftM2 LocalTime arbitrary arbitrary - -instance CoArbitrary LocalTime where - coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer) - -instance Arbitrary TimeZone where - arbitrary = liftM minutesToTimeZone $ choose (-720,720) - -instance CoArbitrary TimeZone where - coarbitrary tz = coarbitrary (timeZoneMinutes tz) - -instance Arbitrary ZonedTime where - arbitrary = liftM2 ZonedTime arbitrary arbitrary - -instance CoArbitrary ZonedTime where - coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) - -instance Arbitrary UTCTime where - arbitrary = liftM2 UTCTime arbitrary arbitrary - -instance CoArbitrary UTCTime where - coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds t) :: Integer) - -instance Arbitrary UniversalTime where - arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) where -- 1000-01-1 to 9999-12-31 - k = 86400 - -instance CoArbitrary UniversalTime where - coarbitrary (ModJulianDate d) = coarbitrary d - --- missing from the time package -instance Eq ZonedTime where - ZonedTime t1 tz1 == ZonedTime t2 tz2 = t1 == t2 && tz1 == tz2 - -compareResult' :: (Eq a,Show a) => String -> a -> a -> Result -compareResult' extra expected found - | expected == found = succeeded - | otherwise = failed {reason = "expected " ++ (show expected) ++ ", found " ++ (show found) ++ extra} - -compareResult :: (Eq a,Show a) => a -> a -> Result -compareResult = compareResult' "" - -compareParse :: forall a. (Eq a,Show a,ParseTime a) => a -> String -> String -> Result -compareParse expected fmt text = compareResult' (", parsing " ++ (show text)) (Just expected) (parse False fmt text) - --- --- * tests for dbugging failing cases --- - -test_parse_format :: (FormatTime t,ParseTime t,Show t) => String -> t -> (String,String,Maybe t) -test_parse_format f t = let s = format f t in (show t, s, parse False f s `asTypeOf` Just t) - --- --- * show and read --- - -prop_read_show :: (Read a, Show a, Eq a) => a -> Result -prop_read_show t = compareResult [(t,"")] (reads (show t)) - -prop_read_show' :: (Read a, Show a, Eq a) => a -> Result -prop_read_show' t = compareResult t (read (show t)) - --- --- * special show functions --- - -prop_parse_showWeekDate :: Day -> Result -prop_parse_showWeekDate d = compareParse d "%G-W%V-%u" (showWeekDate d) - -prop_parse_showGregorian :: Day -> Result -prop_parse_showGregorian d = compareParse d "%Y-%m-%d" (showGregorian d) - -prop_parse_showOrdinalDate :: Day -> Result -prop_parse_showOrdinalDate d = compareParse d "%Y-%j" (showOrdinalDate d) - --- --- * fromMondayStartWeek and fromSundayStartWeek --- - -prop_fromMondayStartWeek :: Day -> Result -prop_fromMondayStartWeek d = - let (w,wd) = mondayStartWeek d - (y,_,_) = toGregorian d - in compareResult d (fromMondayStartWeek y w wd) - -prop_fromSundayStartWeek :: Day -> Result -prop_fromSundayStartWeek d = - let (w,wd) = sundayStartWeek d - (y,_,_) = toGregorian d - in compareResult d (fromSundayStartWeek y w wd) - --- --- * format and parse --- - --- | Helper for defining named properties. -prop_named :: (Arbitrary t, Show t, Testable a) - => String -> (FormatString s -> t -> a) -> String -> FormatString s -> NamedProperty -prop_named n prop typeName f = (n ++ " " ++ typeName ++ " " ++ show f, property (prop f)) - -prop_parse_format :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result -prop_parse_format (FormatString f) t = compareParse t f (format f t) - -prop_parse_format_named :: (Arbitrary t, Eq t, Show t, FormatTime t, ParseTime t) - => String -> FormatString t -> NamedProperty -prop_parse_format_named = prop_named "prop_parse_format" prop_parse_format - --- Verify case-insensitivity with upper case. -prop_parse_format_upper :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result -prop_parse_format_upper (FormatString f) t = compareParse t f (map toUpper $ format f t) - -prop_parse_format_upper_named :: (Arbitrary t, Eq t, Show t, FormatTime t, ParseTime t) - => String -> FormatString t -> NamedProperty -prop_parse_format_upper_named = prop_named "prop_parse_format_upper" prop_parse_format_upper - --- Verify case-insensitivity with lower case. -prop_parse_format_lower :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result -prop_parse_format_lower (FormatString f) t = compareParse t f (map toLower $ format f t) - -prop_parse_format_lower_named :: (Arbitrary t, Eq t, Show t, FormatTime t, ParseTime t) - => String -> FormatString t -> NamedProperty -prop_parse_format_lower_named = prop_named "prop_parse_format_lower" prop_parse_format_lower - -prop_format_parse_format :: (FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result -prop_format_parse_format (FormatString f) t = compareResult - (Just (format f t)) - (fmap (format f) (parse False f (format f t) `asTypeOf` Just t)) - -prop_format_parse_format_named :: (Arbitrary t, Show t, FormatTime t, ParseTime t) - => String -> FormatString t -> NamedProperty -prop_format_parse_format_named = prop_named "prop_format_parse_format" prop_format_parse_format - --- --- * crashes in parse --- - -newtype Input = Input String - -instance Show Input where - show (Input s) = s - -instance Arbitrary Input where - arbitrary = liftM Input $ list cs - where cs = elements (['0'..'9'] ++ ['-',' ','/'] ++ ['a'..'z'] ++ ['A' .. 'Z']) - list g = sized (\n -> choose (0,n) >>= \l -> replicateM l g) -instance CoArbitrary Input where - coarbitrary (Input s) = coarbitrary (sum (map ord s)) - -prop_no_crash_bad_input :: (Eq t, ParseTime t) => FormatString t -> Input -> Property -prop_no_crash_bad_input fs@(FormatString f) (Input s) = property $ - case parse False f s of - Nothing -> True - Just t -> t == t `asTypeOf` formatType fs - where -prop_no_crash_bad_input_named :: (Eq t, ParseTime t) - => String -> FormatString t -> NamedProperty -prop_no_crash_bad_input_named = prop_named "prop_no_crash_bad_input" prop_no_crash_bad_input - --- --- --- - -newtype FormatString a = FormatString String - -formatType :: FormatString t -> t -formatType _ = undefined - -castFormatString :: FormatString a -> FormatString b -castFormatString (FormatString f) = FormatString f - -instance Show (FormatString a) where - show (FormatString f) = show f - -properties :: [NamedProperty] -properties = - [("prop_fromMondayStartWeek", property prop_fromMondayStartWeek), - ("prop_fromSundayStartWeek", property prop_fromSundayStartWeek)] - ++ [("prop_read_show Day", property (prop_read_show :: Day -> Result)), - ("prop_read_show TimeOfDay", property (prop_read_show :: TimeOfDay -> Result)), - ("prop_read_show LocalTime", property (prop_read_show :: LocalTime -> Result)), - ("prop_read_show TimeZone", property (prop_read_show :: TimeZone -> Result)), - ("prop_read_show ZonedTime", property (prop_read_show :: ZonedTime -> Result)), - ("prop_read_show UTCTime", property (prop_read_show :: UTCTime -> Result)), - ("prop_read_show UniversalTime", property (prop_read_show :: UniversalTime -> Result))] - ++ [("prop_parse_showWeekDate", property prop_parse_showWeekDate), - ("prop_parse_showGregorian", property prop_parse_showGregorian), - ("prop_parse_showOrdinalDate", property prop_parse_showOrdinalDate)] - - ++ map (prop_parse_format_named "Day") dayFormats - ++ map (prop_parse_format_named "TimeOfDay") timeOfDayFormats - ++ map (prop_parse_format_named "LocalTime") localTimeFormats - ++ map (prop_parse_format_named "TimeZone") timeZoneFormats - ++ map (prop_parse_format_named "ZonedTime") zonedTimeFormats - ++ map (prop_parse_format_named "UTCTime") utcTimeFormats - ++ map (prop_parse_format_named "UniversalTime") universalTimeFormats - - ++ map (prop_parse_format_upper_named "Day") dayFormats - ++ map (prop_parse_format_upper_named "TimeOfDay") timeOfDayFormats - ++ map (prop_parse_format_upper_named "LocalTime") localTimeFormats - ++ map (prop_parse_format_upper_named "TimeZone") timeZoneFormats - ++ map (prop_parse_format_upper_named "ZonedTime") zonedTimeFormats - ++ map (prop_parse_format_upper_named "UTCTime") utcTimeFormats - ++ map (prop_parse_format_upper_named "UniversalTime") universalTimeFormats - - ++ map (prop_parse_format_lower_named "Day") dayFormats - ++ map (prop_parse_format_lower_named "TimeOfDay") timeOfDayFormats - ++ map (prop_parse_format_lower_named "LocalTime") localTimeFormats - ++ map (prop_parse_format_lower_named "TimeZone") timeZoneFormats - ++ map (prop_parse_format_lower_named "ZonedTime") zonedTimeFormats - ++ map (prop_parse_format_lower_named "UTCTime") utcTimeFormats - ++ map (prop_parse_format_lower_named "UniversalTime") universalTimeFormats - - ++ map (prop_format_parse_format_named "Day") partialDayFormats - ++ map (prop_format_parse_format_named "TimeOfDay") partialTimeOfDayFormats - ++ map (prop_format_parse_format_named "LocalTime") partialLocalTimeFormats - ++ map (prop_format_parse_format_named "ZonedTime") partialZonedTimeFormats - ++ map (prop_format_parse_format_named "UTCTime") partialUTCTimeFormats - ++ map (prop_format_parse_format_named "UniversalTime") partialUniversalTimeFormats - - ++ map (prop_no_crash_bad_input_named "Day") (dayFormats ++ partialDayFormats ++ failingPartialDayFormats) - ++ map (prop_no_crash_bad_input_named "TimeOfDay") (timeOfDayFormats ++ partialTimeOfDayFormats) - ++ map (prop_no_crash_bad_input_named "LocalTime") (localTimeFormats ++ partialLocalTimeFormats) - ++ map (prop_no_crash_bad_input_named "TimeZone") (timeZoneFormats) - ++ map (prop_no_crash_bad_input_named "ZonedTime") (zonedTimeFormats ++ partialZonedTimeFormats) - ++ map (prop_no_crash_bad_input_named "UTCTime") (utcTimeFormats ++ partialUTCTimeFormats) - ++ map (prop_no_crash_bad_input_named "UniversalTime") (universalTimeFormats ++ partialUniversalTimeFormats) - - - -dayFormats :: [FormatString Day] -dayFormats = map FormatString - [ - -- numeric year, month, day - "%Y-%m-%d","%Y%m%d","%C%y%m%d","%Y %m %e","%m/%d/%Y","%d/%m/%Y","%Y/%d/%m","%D %C","%F", - -- month names - "%Y-%B-%d","%Y-%b-%d","%Y-%h-%d", - -- ordinal dates - "%Y-%j", - -- ISO week dates - "%G-%V-%u","%G-%V-%a","%G-%V-%A","%G-%V-%w", "%A week %V, %G", "day %V, week %A, %G", - "%G-W%V-%u", - "%f%g-%V-%u","%f%g-%V-%a","%f%g-%V-%A","%f%g-%V-%w", "%A week %V, %f%g", "day %V, week %A, %f%g", - "%f%g-W%V-%u", - -- monday and sunday week dates - "%Y-w%U-%A", "%Y-w%W-%A", "%Y-%A-w%U", "%Y-%A-w%W", "%A week %U, %Y", "%A week %W, %Y" - ] - -timeOfDayFormats :: [FormatString TimeOfDay] -timeOfDayFormats = map FormatString - [ - -- 24 h formats - "%H:%M:%S.%q","%k:%M:%S.%q","%H%M%S.%q","%T.%q","%X.%q","%R:%S.%q", - "%H:%M:%S%Q","%k:%M:%S%Q","%H%M%S%Q","%T%Q","%X%Q","%R:%S%Q", - -- 12 h formats - "%I:%M:%S.%q %p","%I:%M:%S.%q %P","%l:%M:%S.%q %p","%r %q", - "%I:%M:%S%Q %p","%I:%M:%S%Q %P","%l:%M:%S%Q %p","%r %Q" - ] - -localTimeFormats' :: [FormatString LocalTime] -localTimeFormats' = map FormatString $ - concat [ [df ++ " " ++ tf, tf ++ " " ++ df] | FormatString df <- dayFormats, - FormatString tf <- timeOfDayFormats] - -localTimeFormats :: [FormatString LocalTime] -localTimeFormats = map FormatString [{-"%Q","%Q ","%QX"-}] - -timeZoneFormats :: [FormatString TimeZone] -timeZoneFormats = map FormatString ["%z","%z%Z","%Z%z","%Z"] - -zonedTimeFormats :: [FormatString ZonedTime] -zonedTimeFormats = map FormatString - ["%a, %d %b %Y %H:%M:%S.%q %z", "%a, %d %b %Y %H:%M:%S%Q %z", "%s.%q %z", "%s%Q %z", - "%a, %d %b %Y %H:%M:%S.%q %Z", "%a, %d %b %Y %H:%M:%S%Q %Z", "%s.%q %Z", "%s%Q %Z"] - -utcTimeFormats :: [FormatString UTCTime] -utcTimeFormats = map FormatString - ["%s.%q","%s%Q"] - -universalTimeFormats :: [FormatString UniversalTime] -universalTimeFormats = map FormatString [] - --- --- * Formats that do not include all the information --- - -partialDayFormats :: [FormatString Day] -partialDayFormats = map FormatString - [ ] - -partialTimeOfDayFormats :: [FormatString TimeOfDay] -partialTimeOfDayFormats = map FormatString - [ ] - -partialLocalTimeFormats :: [FormatString LocalTime] -partialLocalTimeFormats = map FormatString - [ ] - -partialZonedTimeFormats :: [FormatString ZonedTime] -partialZonedTimeFormats = map FormatString - [ - -- %s does not include second decimals - "%s %z", - -- %S does not include second decimals - "%c", "%a, %d %b %Y %H:%M:%S %Z" - ] - -partialUTCTimeFormats :: [FormatString UTCTime] -partialUTCTimeFormats = map FormatString - [ - -- %s does not include second decimals - "%s", - -- %c does not include second decimals - "%c" - ] - -partialUniversalTimeFormats :: [FormatString UniversalTime] -partialUniversalTimeFormats = map FormatString - [ ] - - --- --- * Known failures --- - -knownFailures :: [NamedProperty] -knownFailures = - map (prop_format_parse_format_named "Day") failingPartialDayFormats - -failingPartialDayFormats :: [FormatString Day] -failingPartialDayFormats = map FormatString - [ -- ISO week dates with two digit year. - -- This can fail in the beginning or the end of a year where - -- the ISO week date year does not match the gregorian year. - "%g-%V-%u","%g-%V-%a","%g-%V-%A","%g-%V-%w", "%A week %V, %g", "day %V, week %A, %g", - "%g-W%V-%u" - ] diff --git a/test/Test/TestTAI.hs b/test/Test/TestTAI.hs deleted file mode 100644 --- a/test/Test/TestTAI.hs +++ /dev/null @@ -1,60 +0,0 @@ -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 - ] - ] diff --git a/test/Test/TestTime.hs b/test/Test/TestTime.hs deleted file mode 100644 --- a/test/Test/TestTime.hs +++ /dev/null @@ -1,106 +0,0 @@ -module Test.TestTime where - -import Data.Time.Calendar.OrdinalDate -import Data.Time.Calendar.WeekDate -import Data.Time -import Test.TestUtil -import Test.TestTimeRef - -showCal :: Integer -> String -showCal mjd - = let date = ModifiedJulianDay mjd - (y,m,d) = toGregorian date - date' = fromGregorian y m d - in concat [ show mjd ++ "=" - ++ showGregorian date ++ "=" - ++ showOrdinalDate date ++ "=" - ++ showWeekDate date - ++ "\n" - - , if date == date' - then "" - else "=" ++ (show $ toModifiedJulianDay date') ++ "!" ] - -testCal :: String -testCal - = concat - -- days around 1 BCE/1 CE - [ concatMap showCal [-678950 .. -678930] - - -- days around 1000 CE - , concatMap showCal [-313710 .. -313690] - - -- days around MJD zero - , concatMap showCal [-30..30] - , showCal 40000 - , showCal 50000 - - -- 1900 not a leap year - , showCal 15078 - , showCal 15079 - - -- 1980 is a leap year - , showCal 44297 - , showCal 44298 - , showCal 44299 - - -- 1990 not a leap year - , showCal 47950 - , showCal 47951 - - -- 2000 is a leap year - , showCal 51602 - , showCal 51603 - , showCal 51604 - - -- years 2000 and 2001, plus some slop - , concatMap showCal [51540..52280] ] - -showUTCTime :: UTCTime -> String -showUTCTime (UTCTime d t) = show (toModifiedJulianDay d) ++ "," ++ show t - -myzone :: TimeZone -myzone = hoursToTimeZone (- 8) - -leapSec1998Cal :: LocalTime -leapSec1998Cal = LocalTime (fromGregorian 1998 12 31) (TimeOfDay 23 59 60.5) - -leapSec1998 :: UTCTime -leapSec1998 = localTimeToUTC utc leapSec1998Cal - -testUTC :: String -testUTC - = let lsMineCal = utcToLocalTime myzone leapSec1998 - lsMine = localTimeToUTC myzone lsMineCal - in unlines [ showCal 51178 - , show leapSec1998Cal - , showUTCTime leapSec1998 - , show lsMineCal - , showUTCTime lsMine ] - -neglong :: Rational -neglong = -120 - -poslong :: Rational -poslong = 120 - -testUT1 :: String -testUT1 - = unlines [ show $ ut1ToLocalTime 0 $ ModJulianDate 51604.0 - , show $ ut1ToLocalTime 0 $ ModJulianDate 51604.5 - , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.0 - , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.5 - , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.0 - , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.5 ] - -testTimeOfDayToDayFraction :: String -testTimeOfDayToDayFraction - = let f = dayFractionToTimeOfDay . timeOfDayToDayFraction - in unlines [ show $ f $ TimeOfDay 12 34 56.789 - , show $ f $ TimeOfDay 12 34 56.789123 - , show $ f $ TimeOfDay 12 34 56.789123456 - , show $ f $ TimeOfDay 12 34 56.789123456789 ] - -testTime :: Test -testTime = pureTest "testTime" $ - diff testTimeRef $ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction] diff --git a/test/Test/TestTimeRef.hs b/test/Test/TestTimeRef.hs deleted file mode 100644 --- a/test/Test/TestTimeRef.hs +++ /dev/null @@ -1,881 +0,0 @@ -module Test.TestTimeRef where - -testTimeRef :: String -testTimeRef = - unlines [ - "-678950=-0001-12-23=-0001-357=-0001-W51-4" - ,"-678949=-0001-12-24=-0001-358=-0001-W51-5" - ,"-678948=-0001-12-25=-0001-359=-0001-W51-6" - ,"-678947=-0001-12-26=-0001-360=-0001-W51-7" - ,"-678946=-0001-12-27=-0001-361=-0001-W52-1" - ,"-678945=-0001-12-28=-0001-362=-0001-W52-2" - ,"-678944=-0001-12-29=-0001-363=-0001-W52-3" - ,"-678943=-0001-12-30=-0001-364=-0001-W52-4" - ,"-678942=-0001-12-31=-0001-365=-0001-W52-5" - ,"-678941=0000-01-01=0000-001=-0001-W52-6" - ,"-678940=0000-01-02=0000-002=-0001-W52-7" - ,"-678939=0000-01-03=0000-003=0000-W01-1" - ,"-678938=0000-01-04=0000-004=0000-W01-2" - ,"-678937=0000-01-05=0000-005=0000-W01-3" - ,"-678936=0000-01-06=0000-006=0000-W01-4" - ,"-678935=0000-01-07=0000-007=0000-W01-5" - ,"-678934=0000-01-08=0000-008=0000-W01-6" - ,"-678933=0000-01-09=0000-009=0000-W01-7" - ,"-678932=0000-01-10=0000-010=0000-W02-1" - ,"-678931=0000-01-11=0000-011=0000-W02-2" - ,"-678930=0000-01-12=0000-012=0000-W02-3" - ,"-313710=0999-12-20=0999-354=0999-W51-5" - ,"-313709=0999-12-21=0999-355=0999-W51-6" - ,"-313708=0999-12-22=0999-356=0999-W51-7" - ,"-313707=0999-12-23=0999-357=0999-W52-1" - ,"-313706=0999-12-24=0999-358=0999-W52-2" - ,"-313705=0999-12-25=0999-359=0999-W52-3" - ,"-313704=0999-12-26=0999-360=0999-W52-4" - ,"-313703=0999-12-27=0999-361=0999-W52-5" - ,"-313702=0999-12-28=0999-362=0999-W52-6" - ,"-313701=0999-12-29=0999-363=0999-W52-7" - ,"-313700=0999-12-30=0999-364=1000-W01-1" - ,"-313699=0999-12-31=0999-365=1000-W01-2" - ,"-313698=1000-01-01=1000-001=1000-W01-3" - ,"-313697=1000-01-02=1000-002=1000-W01-4" - ,"-313696=1000-01-03=1000-003=1000-W01-5" - ,"-313695=1000-01-04=1000-004=1000-W01-6" - ,"-313694=1000-01-05=1000-005=1000-W01-7" - ,"-313693=1000-01-06=1000-006=1000-W02-1" - ,"-313692=1000-01-07=1000-007=1000-W02-2" - ,"-313691=1000-01-08=1000-008=1000-W02-3" - ,"-313690=1000-01-09=1000-009=1000-W02-4" - ,"-30=1858-10-18=1858-291=1858-W42-1" - ,"-29=1858-10-19=1858-292=1858-W42-2" - ,"-28=1858-10-20=1858-293=1858-W42-3" - ,"-27=1858-10-21=1858-294=1858-W42-4" - ,"-26=1858-10-22=1858-295=1858-W42-5" - ,"-25=1858-10-23=1858-296=1858-W42-6" - ,"-24=1858-10-24=1858-297=1858-W42-7" - ,"-23=1858-10-25=1858-298=1858-W43-1" - ,"-22=1858-10-26=1858-299=1858-W43-2" - ,"-21=1858-10-27=1858-300=1858-W43-3" - ,"-20=1858-10-28=1858-301=1858-W43-4" - ,"-19=1858-10-29=1858-302=1858-W43-5" - ,"-18=1858-10-30=1858-303=1858-W43-6" - ,"-17=1858-10-31=1858-304=1858-W43-7" - ,"-16=1858-11-01=1858-305=1858-W44-1" - ,"-15=1858-11-02=1858-306=1858-W44-2" - ,"-14=1858-11-03=1858-307=1858-W44-3" - ,"-13=1858-11-04=1858-308=1858-W44-4" - ,"-12=1858-11-05=1858-309=1858-W44-5" - ,"-11=1858-11-06=1858-310=1858-W44-6" - ,"-10=1858-11-07=1858-311=1858-W44-7" - ,"-9=1858-11-08=1858-312=1858-W45-1" - ,"-8=1858-11-09=1858-313=1858-W45-2" - ,"-7=1858-11-10=1858-314=1858-W45-3" - ,"-6=1858-11-11=1858-315=1858-W45-4" - ,"-5=1858-11-12=1858-316=1858-W45-5" - ,"-4=1858-11-13=1858-317=1858-W45-6" - ,"-3=1858-11-14=1858-318=1858-W45-7" - ,"-2=1858-11-15=1858-319=1858-W46-1" - ,"-1=1858-11-16=1858-320=1858-W46-2" - ,"0=1858-11-17=1858-321=1858-W46-3" - ,"1=1858-11-18=1858-322=1858-W46-4" - ,"2=1858-11-19=1858-323=1858-W46-5" - ,"3=1858-11-20=1858-324=1858-W46-6" - ,"4=1858-11-21=1858-325=1858-W46-7" - ,"5=1858-11-22=1858-326=1858-W47-1" - ,"6=1858-11-23=1858-327=1858-W47-2" - ,"7=1858-11-24=1858-328=1858-W47-3" - ,"8=1858-11-25=1858-329=1858-W47-4" - ,"9=1858-11-26=1858-330=1858-W47-5" - ,"10=1858-11-27=1858-331=1858-W47-6" - ,"11=1858-11-28=1858-332=1858-W47-7" - ,"12=1858-11-29=1858-333=1858-W48-1" - ,"13=1858-11-30=1858-334=1858-W48-2" - ,"14=1858-12-01=1858-335=1858-W48-3" - ,"15=1858-12-02=1858-336=1858-W48-4" - ,"16=1858-12-03=1858-337=1858-W48-5" - ,"17=1858-12-04=1858-338=1858-W48-6" - ,"18=1858-12-05=1858-339=1858-W48-7" - ,"19=1858-12-06=1858-340=1858-W49-1" - ,"20=1858-12-07=1858-341=1858-W49-2" - ,"21=1858-12-08=1858-342=1858-W49-3" - ,"22=1858-12-09=1858-343=1858-W49-4" - ,"23=1858-12-10=1858-344=1858-W49-5" - ,"24=1858-12-11=1858-345=1858-W49-6" - ,"25=1858-12-12=1858-346=1858-W49-7" - ,"26=1858-12-13=1858-347=1858-W50-1" - ,"27=1858-12-14=1858-348=1858-W50-2" - ,"28=1858-12-15=1858-349=1858-W50-3" - ,"29=1858-12-16=1858-350=1858-W50-4" - ,"30=1858-12-17=1858-351=1858-W50-5" - ,"40000=1968-05-24=1968-145=1968-W21-5" - ,"50000=1995-10-10=1995-283=1995-W41-2" - ,"15078=1900-02-28=1900-059=1900-W09-3" - ,"15079=1900-03-01=1900-060=1900-W09-4" - ,"44297=1980-02-28=1980-059=1980-W09-4" - ,"44298=1980-02-29=1980-060=1980-W09-5" - ,"44299=1980-03-01=1980-061=1980-W09-6" - ,"47950=1990-02-28=1990-059=1990-W09-3" - ,"47951=1990-03-01=1990-060=1990-W09-4" - ,"51602=2000-02-28=2000-059=2000-W09-1" - ,"51603=2000-02-29=2000-060=2000-W09-2" - ,"51604=2000-03-01=2000-061=2000-W09-3" - ,"51540=1999-12-28=1999-362=1999-W52-2" - ,"51541=1999-12-29=1999-363=1999-W52-3" - ,"51542=1999-12-30=1999-364=1999-W52-4" - ,"51543=1999-12-31=1999-365=1999-W52-5" - ,"51544=2000-01-01=2000-001=1999-W52-6" - ,"51545=2000-01-02=2000-002=1999-W52-7" - ,"51546=2000-01-03=2000-003=2000-W01-1" - ,"51547=2000-01-04=2000-004=2000-W01-2" - ,"51548=2000-01-05=2000-005=2000-W01-3" - ,"51549=2000-01-06=2000-006=2000-W01-4" - ,"51550=2000-01-07=2000-007=2000-W01-5" - ,"51551=2000-01-08=2000-008=2000-W01-6" - ,"51552=2000-01-09=2000-009=2000-W01-7" - ,"51553=2000-01-10=2000-010=2000-W02-1" - ,"51554=2000-01-11=2000-011=2000-W02-2" - ,"51555=2000-01-12=2000-012=2000-W02-3" - ,"51556=2000-01-13=2000-013=2000-W02-4" - ,"51557=2000-01-14=2000-014=2000-W02-5" - ,"51558=2000-01-15=2000-015=2000-W02-6" - ,"51559=2000-01-16=2000-016=2000-W02-7" - ,"51560=2000-01-17=2000-017=2000-W03-1" - ,"51561=2000-01-18=2000-018=2000-W03-2" - ,"51562=2000-01-19=2000-019=2000-W03-3" - ,"51563=2000-01-20=2000-020=2000-W03-4" - ,"51564=2000-01-21=2000-021=2000-W03-5" - ,"51565=2000-01-22=2000-022=2000-W03-6" - ,"51566=2000-01-23=2000-023=2000-W03-7" - ,"51567=2000-01-24=2000-024=2000-W04-1" - ,"51568=2000-01-25=2000-025=2000-W04-2" - ,"51569=2000-01-26=2000-026=2000-W04-3" - ,"51570=2000-01-27=2000-027=2000-W04-4" - ,"51571=2000-01-28=2000-028=2000-W04-5" - ,"51572=2000-01-29=2000-029=2000-W04-6" - ,"51573=2000-01-30=2000-030=2000-W04-7" - ,"51574=2000-01-31=2000-031=2000-W05-1" - ,"51575=2000-02-01=2000-032=2000-W05-2" - ,"51576=2000-02-02=2000-033=2000-W05-3" - ,"51577=2000-02-03=2000-034=2000-W05-4" - ,"51578=2000-02-04=2000-035=2000-W05-5" - ,"51579=2000-02-05=2000-036=2000-W05-6" - ,"51580=2000-02-06=2000-037=2000-W05-7" - ,"51581=2000-02-07=2000-038=2000-W06-1" - ,"51582=2000-02-08=2000-039=2000-W06-2" - ,"51583=2000-02-09=2000-040=2000-W06-3" - ,"51584=2000-02-10=2000-041=2000-W06-4" - ,"51585=2000-02-11=2000-042=2000-W06-5" - ,"51586=2000-02-12=2000-043=2000-W06-6" - ,"51587=2000-02-13=2000-044=2000-W06-7" - ,"51588=2000-02-14=2000-045=2000-W07-1" - ,"51589=2000-02-15=2000-046=2000-W07-2" - ,"51590=2000-02-16=2000-047=2000-W07-3" - ,"51591=2000-02-17=2000-048=2000-W07-4" - ,"51592=2000-02-18=2000-049=2000-W07-5" - ,"51593=2000-02-19=2000-050=2000-W07-6" - ,"51594=2000-02-20=2000-051=2000-W07-7" - ,"51595=2000-02-21=2000-052=2000-W08-1" - ,"51596=2000-02-22=2000-053=2000-W08-2" - ,"51597=2000-02-23=2000-054=2000-W08-3" - ,"51598=2000-02-24=2000-055=2000-W08-4" - ,"51599=2000-02-25=2000-056=2000-W08-5" - ,"51600=2000-02-26=2000-057=2000-W08-6" - ,"51601=2000-02-27=2000-058=2000-W08-7" - ,"51602=2000-02-28=2000-059=2000-W09-1" - ,"51603=2000-02-29=2000-060=2000-W09-2" - ,"51604=2000-03-01=2000-061=2000-W09-3" - ,"51605=2000-03-02=2000-062=2000-W09-4" - ,"51606=2000-03-03=2000-063=2000-W09-5" - ,"51607=2000-03-04=2000-064=2000-W09-6" - ,"51608=2000-03-05=2000-065=2000-W09-7" - ,"51609=2000-03-06=2000-066=2000-W10-1" - ,"51610=2000-03-07=2000-067=2000-W10-2" - ,"51611=2000-03-08=2000-068=2000-W10-3" - ,"51612=2000-03-09=2000-069=2000-W10-4" - ,"51613=2000-03-10=2000-070=2000-W10-5" - ,"51614=2000-03-11=2000-071=2000-W10-6" - ,"51615=2000-03-12=2000-072=2000-W10-7" - ,"51616=2000-03-13=2000-073=2000-W11-1" - ,"51617=2000-03-14=2000-074=2000-W11-2" - ,"51618=2000-03-15=2000-075=2000-W11-3" - ,"51619=2000-03-16=2000-076=2000-W11-4" - ,"51620=2000-03-17=2000-077=2000-W11-5" - ,"51621=2000-03-18=2000-078=2000-W11-6" - ,"51622=2000-03-19=2000-079=2000-W11-7" - ,"51623=2000-03-20=2000-080=2000-W12-1" - ,"51624=2000-03-21=2000-081=2000-W12-2" - ,"51625=2000-03-22=2000-082=2000-W12-3" - ,"51626=2000-03-23=2000-083=2000-W12-4" - ,"51627=2000-03-24=2000-084=2000-W12-5" - ,"51628=2000-03-25=2000-085=2000-W12-6" - ,"51629=2000-03-26=2000-086=2000-W12-7" - ,"51630=2000-03-27=2000-087=2000-W13-1" - ,"51631=2000-03-28=2000-088=2000-W13-2" - ,"51632=2000-03-29=2000-089=2000-W13-3" - ,"51633=2000-03-30=2000-090=2000-W13-4" - ,"51634=2000-03-31=2000-091=2000-W13-5" - ,"51635=2000-04-01=2000-092=2000-W13-6" - ,"51636=2000-04-02=2000-093=2000-W13-7" - ,"51637=2000-04-03=2000-094=2000-W14-1" - ,"51638=2000-04-04=2000-095=2000-W14-2" - ,"51639=2000-04-05=2000-096=2000-W14-3" - ,"51640=2000-04-06=2000-097=2000-W14-4" - ,"51641=2000-04-07=2000-098=2000-W14-5" - ,"51642=2000-04-08=2000-099=2000-W14-6" - ,"51643=2000-04-09=2000-100=2000-W14-7" - ,"51644=2000-04-10=2000-101=2000-W15-1" - ,"51645=2000-04-11=2000-102=2000-W15-2" - ,"51646=2000-04-12=2000-103=2000-W15-3" - ,"51647=2000-04-13=2000-104=2000-W15-4" - ,"51648=2000-04-14=2000-105=2000-W15-5" - ,"51649=2000-04-15=2000-106=2000-W15-6" - ,"51650=2000-04-16=2000-107=2000-W15-7" - ,"51651=2000-04-17=2000-108=2000-W16-1" - ,"51652=2000-04-18=2000-109=2000-W16-2" - ,"51653=2000-04-19=2000-110=2000-W16-3" - ,"51654=2000-04-20=2000-111=2000-W16-4" - ,"51655=2000-04-21=2000-112=2000-W16-5" - ,"51656=2000-04-22=2000-113=2000-W16-6" - ,"51657=2000-04-23=2000-114=2000-W16-7" - ,"51658=2000-04-24=2000-115=2000-W17-1" - ,"51659=2000-04-25=2000-116=2000-W17-2" - ,"51660=2000-04-26=2000-117=2000-W17-3" - ,"51661=2000-04-27=2000-118=2000-W17-4" - ,"51662=2000-04-28=2000-119=2000-W17-5" - ,"51663=2000-04-29=2000-120=2000-W17-6" - ,"51664=2000-04-30=2000-121=2000-W17-7" - ,"51665=2000-05-01=2000-122=2000-W18-1" - ,"51666=2000-05-02=2000-123=2000-W18-2" - ,"51667=2000-05-03=2000-124=2000-W18-3" - ,"51668=2000-05-04=2000-125=2000-W18-4" - ,"51669=2000-05-05=2000-126=2000-W18-5" - ,"51670=2000-05-06=2000-127=2000-W18-6" - ,"51671=2000-05-07=2000-128=2000-W18-7" - ,"51672=2000-05-08=2000-129=2000-W19-1" - ,"51673=2000-05-09=2000-130=2000-W19-2" - ,"51674=2000-05-10=2000-131=2000-W19-3" - ,"51675=2000-05-11=2000-132=2000-W19-4" - ,"51676=2000-05-12=2000-133=2000-W19-5" - ,"51677=2000-05-13=2000-134=2000-W19-6" - ,"51678=2000-05-14=2000-135=2000-W19-7" - ,"51679=2000-05-15=2000-136=2000-W20-1" - ,"51680=2000-05-16=2000-137=2000-W20-2" - ,"51681=2000-05-17=2000-138=2000-W20-3" - ,"51682=2000-05-18=2000-139=2000-W20-4" - ,"51683=2000-05-19=2000-140=2000-W20-5" - ,"51684=2000-05-20=2000-141=2000-W20-6" - ,"51685=2000-05-21=2000-142=2000-W20-7" - ,"51686=2000-05-22=2000-143=2000-W21-1" - ,"51687=2000-05-23=2000-144=2000-W21-2" - ,"51688=2000-05-24=2000-145=2000-W21-3" - ,"51689=2000-05-25=2000-146=2000-W21-4" - ,"51690=2000-05-26=2000-147=2000-W21-5" - ,"51691=2000-05-27=2000-148=2000-W21-6" - ,"51692=2000-05-28=2000-149=2000-W21-7" - ,"51693=2000-05-29=2000-150=2000-W22-1" - ,"51694=2000-05-30=2000-151=2000-W22-2" - ,"51695=2000-05-31=2000-152=2000-W22-3" - ,"51696=2000-06-01=2000-153=2000-W22-4" - ,"51697=2000-06-02=2000-154=2000-W22-5" - ,"51698=2000-06-03=2000-155=2000-W22-6" - ,"51699=2000-06-04=2000-156=2000-W22-7" - ,"51700=2000-06-05=2000-157=2000-W23-1" - ,"51701=2000-06-06=2000-158=2000-W23-2" - ,"51702=2000-06-07=2000-159=2000-W23-3" - ,"51703=2000-06-08=2000-160=2000-W23-4" - ,"51704=2000-06-09=2000-161=2000-W23-5" - ,"51705=2000-06-10=2000-162=2000-W23-6" - ,"51706=2000-06-11=2000-163=2000-W23-7" - ,"51707=2000-06-12=2000-164=2000-W24-1" - ,"51708=2000-06-13=2000-165=2000-W24-2" - ,"51709=2000-06-14=2000-166=2000-W24-3" - ,"51710=2000-06-15=2000-167=2000-W24-4" - ,"51711=2000-06-16=2000-168=2000-W24-5" - ,"51712=2000-06-17=2000-169=2000-W24-6" - ,"51713=2000-06-18=2000-170=2000-W24-7" - ,"51714=2000-06-19=2000-171=2000-W25-1" - ,"51715=2000-06-20=2000-172=2000-W25-2" - ,"51716=2000-06-21=2000-173=2000-W25-3" - ,"51717=2000-06-22=2000-174=2000-W25-4" - ,"51718=2000-06-23=2000-175=2000-W25-5" - ,"51719=2000-06-24=2000-176=2000-W25-6" - ,"51720=2000-06-25=2000-177=2000-W25-7" - ,"51721=2000-06-26=2000-178=2000-W26-1" - ,"51722=2000-06-27=2000-179=2000-W26-2" - ,"51723=2000-06-28=2000-180=2000-W26-3" - ,"51724=2000-06-29=2000-181=2000-W26-4" - ,"51725=2000-06-30=2000-182=2000-W26-5" - ,"51726=2000-07-01=2000-183=2000-W26-6" - ,"51727=2000-07-02=2000-184=2000-W26-7" - ,"51728=2000-07-03=2000-185=2000-W27-1" - ,"51729=2000-07-04=2000-186=2000-W27-2" - ,"51730=2000-07-05=2000-187=2000-W27-3" - ,"51731=2000-07-06=2000-188=2000-W27-4" - ,"51732=2000-07-07=2000-189=2000-W27-5" - ,"51733=2000-07-08=2000-190=2000-W27-6" - ,"51734=2000-07-09=2000-191=2000-W27-7" - ,"51735=2000-07-10=2000-192=2000-W28-1" - ,"51736=2000-07-11=2000-193=2000-W28-2" - ,"51737=2000-07-12=2000-194=2000-W28-3" - ,"51738=2000-07-13=2000-195=2000-W28-4" - ,"51739=2000-07-14=2000-196=2000-W28-5" - ,"51740=2000-07-15=2000-197=2000-W28-6" - ,"51741=2000-07-16=2000-198=2000-W28-7" - ,"51742=2000-07-17=2000-199=2000-W29-1" - ,"51743=2000-07-18=2000-200=2000-W29-2" - ,"51744=2000-07-19=2000-201=2000-W29-3" - ,"51745=2000-07-20=2000-202=2000-W29-4" - ,"51746=2000-07-21=2000-203=2000-W29-5" - ,"51747=2000-07-22=2000-204=2000-W29-6" - ,"51748=2000-07-23=2000-205=2000-W29-7" - ,"51749=2000-07-24=2000-206=2000-W30-1" - ,"51750=2000-07-25=2000-207=2000-W30-2" - ,"51751=2000-07-26=2000-208=2000-W30-3" - ,"51752=2000-07-27=2000-209=2000-W30-4" - ,"51753=2000-07-28=2000-210=2000-W30-5" - ,"51754=2000-07-29=2000-211=2000-W30-6" - ,"51755=2000-07-30=2000-212=2000-W30-7" - ,"51756=2000-07-31=2000-213=2000-W31-1" - ,"51757=2000-08-01=2000-214=2000-W31-2" - ,"51758=2000-08-02=2000-215=2000-W31-3" - ,"51759=2000-08-03=2000-216=2000-W31-4" - ,"51760=2000-08-04=2000-217=2000-W31-5" - ,"51761=2000-08-05=2000-218=2000-W31-6" - ,"51762=2000-08-06=2000-219=2000-W31-7" - ,"51763=2000-08-07=2000-220=2000-W32-1" - ,"51764=2000-08-08=2000-221=2000-W32-2" - ,"51765=2000-08-09=2000-222=2000-W32-3" - ,"51766=2000-08-10=2000-223=2000-W32-4" - ,"51767=2000-08-11=2000-224=2000-W32-5" - ,"51768=2000-08-12=2000-225=2000-W32-6" - ,"51769=2000-08-13=2000-226=2000-W32-7" - ,"51770=2000-08-14=2000-227=2000-W33-1" - ,"51771=2000-08-15=2000-228=2000-W33-2" - ,"51772=2000-08-16=2000-229=2000-W33-3" - ,"51773=2000-08-17=2000-230=2000-W33-4" - ,"51774=2000-08-18=2000-231=2000-W33-5" - ,"51775=2000-08-19=2000-232=2000-W33-6" - ,"51776=2000-08-20=2000-233=2000-W33-7" - ,"51777=2000-08-21=2000-234=2000-W34-1" - ,"51778=2000-08-22=2000-235=2000-W34-2" - ,"51779=2000-08-23=2000-236=2000-W34-3" - ,"51780=2000-08-24=2000-237=2000-W34-4" - ,"51781=2000-08-25=2000-238=2000-W34-5" - ,"51782=2000-08-26=2000-239=2000-W34-6" - ,"51783=2000-08-27=2000-240=2000-W34-7" - ,"51784=2000-08-28=2000-241=2000-W35-1" - ,"51785=2000-08-29=2000-242=2000-W35-2" - ,"51786=2000-08-30=2000-243=2000-W35-3" - ,"51787=2000-08-31=2000-244=2000-W35-4" - ,"51788=2000-09-01=2000-245=2000-W35-5" - ,"51789=2000-09-02=2000-246=2000-W35-6" - ,"51790=2000-09-03=2000-247=2000-W35-7" - ,"51791=2000-09-04=2000-248=2000-W36-1" - ,"51792=2000-09-05=2000-249=2000-W36-2" - ,"51793=2000-09-06=2000-250=2000-W36-3" - ,"51794=2000-09-07=2000-251=2000-W36-4" - ,"51795=2000-09-08=2000-252=2000-W36-5" - ,"51796=2000-09-09=2000-253=2000-W36-6" - ,"51797=2000-09-10=2000-254=2000-W36-7" - ,"51798=2000-09-11=2000-255=2000-W37-1" - ,"51799=2000-09-12=2000-256=2000-W37-2" - ,"51800=2000-09-13=2000-257=2000-W37-3" - ,"51801=2000-09-14=2000-258=2000-W37-4" - ,"51802=2000-09-15=2000-259=2000-W37-5" - ,"51803=2000-09-16=2000-260=2000-W37-6" - ,"51804=2000-09-17=2000-261=2000-W37-7" - ,"51805=2000-09-18=2000-262=2000-W38-1" - ,"51806=2000-09-19=2000-263=2000-W38-2" - ,"51807=2000-09-20=2000-264=2000-W38-3" - ,"51808=2000-09-21=2000-265=2000-W38-4" - ,"51809=2000-09-22=2000-266=2000-W38-5" - ,"51810=2000-09-23=2000-267=2000-W38-6" - ,"51811=2000-09-24=2000-268=2000-W38-7" - ,"51812=2000-09-25=2000-269=2000-W39-1" - ,"51813=2000-09-26=2000-270=2000-W39-2" - ,"51814=2000-09-27=2000-271=2000-W39-3" - ,"51815=2000-09-28=2000-272=2000-W39-4" - ,"51816=2000-09-29=2000-273=2000-W39-5" - ,"51817=2000-09-30=2000-274=2000-W39-6" - ,"51818=2000-10-01=2000-275=2000-W39-7" - ,"51819=2000-10-02=2000-276=2000-W40-1" - ,"51820=2000-10-03=2000-277=2000-W40-2" - ,"51821=2000-10-04=2000-278=2000-W40-3" - ,"51822=2000-10-05=2000-279=2000-W40-4" - ,"51823=2000-10-06=2000-280=2000-W40-5" - ,"51824=2000-10-07=2000-281=2000-W40-6" - ,"51825=2000-10-08=2000-282=2000-W40-7" - ,"51826=2000-10-09=2000-283=2000-W41-1" - ,"51827=2000-10-10=2000-284=2000-W41-2" - ,"51828=2000-10-11=2000-285=2000-W41-3" - ,"51829=2000-10-12=2000-286=2000-W41-4" - ,"51830=2000-10-13=2000-287=2000-W41-5" - ,"51831=2000-10-14=2000-288=2000-W41-6" - ,"51832=2000-10-15=2000-289=2000-W41-7" - ,"51833=2000-10-16=2000-290=2000-W42-1" - ,"51834=2000-10-17=2000-291=2000-W42-2" - ,"51835=2000-10-18=2000-292=2000-W42-3" - ,"51836=2000-10-19=2000-293=2000-W42-4" - ,"51837=2000-10-20=2000-294=2000-W42-5" - ,"51838=2000-10-21=2000-295=2000-W42-6" - ,"51839=2000-10-22=2000-296=2000-W42-7" - ,"51840=2000-10-23=2000-297=2000-W43-1" - ,"51841=2000-10-24=2000-298=2000-W43-2" - ,"51842=2000-10-25=2000-299=2000-W43-3" - ,"51843=2000-10-26=2000-300=2000-W43-4" - ,"51844=2000-10-27=2000-301=2000-W43-5" - ,"51845=2000-10-28=2000-302=2000-W43-6" - ,"51846=2000-10-29=2000-303=2000-W43-7" - ,"51847=2000-10-30=2000-304=2000-W44-1" - ,"51848=2000-10-31=2000-305=2000-W44-2" - ,"51849=2000-11-01=2000-306=2000-W44-3" - ,"51850=2000-11-02=2000-307=2000-W44-4" - ,"51851=2000-11-03=2000-308=2000-W44-5" - ,"51852=2000-11-04=2000-309=2000-W44-6" - ,"51853=2000-11-05=2000-310=2000-W44-7" - ,"51854=2000-11-06=2000-311=2000-W45-1" - ,"51855=2000-11-07=2000-312=2000-W45-2" - ,"51856=2000-11-08=2000-313=2000-W45-3" - ,"51857=2000-11-09=2000-314=2000-W45-4" - ,"51858=2000-11-10=2000-315=2000-W45-5" - ,"51859=2000-11-11=2000-316=2000-W45-6" - ,"51860=2000-11-12=2000-317=2000-W45-7" - ,"51861=2000-11-13=2000-318=2000-W46-1" - ,"51862=2000-11-14=2000-319=2000-W46-2" - ,"51863=2000-11-15=2000-320=2000-W46-3" - ,"51864=2000-11-16=2000-321=2000-W46-4" - ,"51865=2000-11-17=2000-322=2000-W46-5" - ,"51866=2000-11-18=2000-323=2000-W46-6" - ,"51867=2000-11-19=2000-324=2000-W46-7" - ,"51868=2000-11-20=2000-325=2000-W47-1" - ,"51869=2000-11-21=2000-326=2000-W47-2" - ,"51870=2000-11-22=2000-327=2000-W47-3" - ,"51871=2000-11-23=2000-328=2000-W47-4" - ,"51872=2000-11-24=2000-329=2000-W47-5" - ,"51873=2000-11-25=2000-330=2000-W47-6" - ,"51874=2000-11-26=2000-331=2000-W47-7" - ,"51875=2000-11-27=2000-332=2000-W48-1" - ,"51876=2000-11-28=2000-333=2000-W48-2" - ,"51877=2000-11-29=2000-334=2000-W48-3" - ,"51878=2000-11-30=2000-335=2000-W48-4" - ,"51879=2000-12-01=2000-336=2000-W48-5" - ,"51880=2000-12-02=2000-337=2000-W48-6" - ,"51881=2000-12-03=2000-338=2000-W48-7" - ,"51882=2000-12-04=2000-339=2000-W49-1" - ,"51883=2000-12-05=2000-340=2000-W49-2" - ,"51884=2000-12-06=2000-341=2000-W49-3" - ,"51885=2000-12-07=2000-342=2000-W49-4" - ,"51886=2000-12-08=2000-343=2000-W49-5" - ,"51887=2000-12-09=2000-344=2000-W49-6" - ,"51888=2000-12-10=2000-345=2000-W49-7" - ,"51889=2000-12-11=2000-346=2000-W50-1" - ,"51890=2000-12-12=2000-347=2000-W50-2" - ,"51891=2000-12-13=2000-348=2000-W50-3" - ,"51892=2000-12-14=2000-349=2000-W50-4" - ,"51893=2000-12-15=2000-350=2000-W50-5" - ,"51894=2000-12-16=2000-351=2000-W50-6" - ,"51895=2000-12-17=2000-352=2000-W50-7" - ,"51896=2000-12-18=2000-353=2000-W51-1" - ,"51897=2000-12-19=2000-354=2000-W51-2" - ,"51898=2000-12-20=2000-355=2000-W51-3" - ,"51899=2000-12-21=2000-356=2000-W51-4" - ,"51900=2000-12-22=2000-357=2000-W51-5" - ,"51901=2000-12-23=2000-358=2000-W51-6" - ,"51902=2000-12-24=2000-359=2000-W51-7" - ,"51903=2000-12-25=2000-360=2000-W52-1" - ,"51904=2000-12-26=2000-361=2000-W52-2" - ,"51905=2000-12-27=2000-362=2000-W52-3" - ,"51906=2000-12-28=2000-363=2000-W52-4" - ,"51907=2000-12-29=2000-364=2000-W52-5" - ,"51908=2000-12-30=2000-365=2000-W52-6" - ,"51909=2000-12-31=2000-366=2000-W52-7" - ,"51910=2001-01-01=2001-001=2001-W01-1" - ,"51911=2001-01-02=2001-002=2001-W01-2" - ,"51912=2001-01-03=2001-003=2001-W01-3" - ,"51913=2001-01-04=2001-004=2001-W01-4" - ,"51914=2001-01-05=2001-005=2001-W01-5" - ,"51915=2001-01-06=2001-006=2001-W01-6" - ,"51916=2001-01-07=2001-007=2001-W01-7" - ,"51917=2001-01-08=2001-008=2001-W02-1" - ,"51918=2001-01-09=2001-009=2001-W02-2" - ,"51919=2001-01-10=2001-010=2001-W02-3" - ,"51920=2001-01-11=2001-011=2001-W02-4" - ,"51921=2001-01-12=2001-012=2001-W02-5" - ,"51922=2001-01-13=2001-013=2001-W02-6" - ,"51923=2001-01-14=2001-014=2001-W02-7" - ,"51924=2001-01-15=2001-015=2001-W03-1" - ,"51925=2001-01-16=2001-016=2001-W03-2" - ,"51926=2001-01-17=2001-017=2001-W03-3" - ,"51927=2001-01-18=2001-018=2001-W03-4" - ,"51928=2001-01-19=2001-019=2001-W03-5" - ,"51929=2001-01-20=2001-020=2001-W03-6" - ,"51930=2001-01-21=2001-021=2001-W03-7" - ,"51931=2001-01-22=2001-022=2001-W04-1" - ,"51932=2001-01-23=2001-023=2001-W04-2" - ,"51933=2001-01-24=2001-024=2001-W04-3" - ,"51934=2001-01-25=2001-025=2001-W04-4" - ,"51935=2001-01-26=2001-026=2001-W04-5" - ,"51936=2001-01-27=2001-027=2001-W04-6" - ,"51937=2001-01-28=2001-028=2001-W04-7" - ,"51938=2001-01-29=2001-029=2001-W05-1" - ,"51939=2001-01-30=2001-030=2001-W05-2" - ,"51940=2001-01-31=2001-031=2001-W05-3" - ,"51941=2001-02-01=2001-032=2001-W05-4" - ,"51942=2001-02-02=2001-033=2001-W05-5" - ,"51943=2001-02-03=2001-034=2001-W05-6" - ,"51944=2001-02-04=2001-035=2001-W05-7" - ,"51945=2001-02-05=2001-036=2001-W06-1" - ,"51946=2001-02-06=2001-037=2001-W06-2" - ,"51947=2001-02-07=2001-038=2001-W06-3" - ,"51948=2001-02-08=2001-039=2001-W06-4" - ,"51949=2001-02-09=2001-040=2001-W06-5" - ,"51950=2001-02-10=2001-041=2001-W06-6" - ,"51951=2001-02-11=2001-042=2001-W06-7" - ,"51952=2001-02-12=2001-043=2001-W07-1" - ,"51953=2001-02-13=2001-044=2001-W07-2" - ,"51954=2001-02-14=2001-045=2001-W07-3" - ,"51955=2001-02-15=2001-046=2001-W07-4" - ,"51956=2001-02-16=2001-047=2001-W07-5" - ,"51957=2001-02-17=2001-048=2001-W07-6" - ,"51958=2001-02-18=2001-049=2001-W07-7" - ,"51959=2001-02-19=2001-050=2001-W08-1" - ,"51960=2001-02-20=2001-051=2001-W08-2" - ,"51961=2001-02-21=2001-052=2001-W08-3" - ,"51962=2001-02-22=2001-053=2001-W08-4" - ,"51963=2001-02-23=2001-054=2001-W08-5" - ,"51964=2001-02-24=2001-055=2001-W08-6" - ,"51965=2001-02-25=2001-056=2001-W08-7" - ,"51966=2001-02-26=2001-057=2001-W09-1" - ,"51967=2001-02-27=2001-058=2001-W09-2" - ,"51968=2001-02-28=2001-059=2001-W09-3" - ,"51969=2001-03-01=2001-060=2001-W09-4" - ,"51970=2001-03-02=2001-061=2001-W09-5" - ,"51971=2001-03-03=2001-062=2001-W09-6" - ,"51972=2001-03-04=2001-063=2001-W09-7" - ,"51973=2001-03-05=2001-064=2001-W10-1" - ,"51974=2001-03-06=2001-065=2001-W10-2" - ,"51975=2001-03-07=2001-066=2001-W10-3" - ,"51976=2001-03-08=2001-067=2001-W10-4" - ,"51977=2001-03-09=2001-068=2001-W10-5" - ,"51978=2001-03-10=2001-069=2001-W10-6" - ,"51979=2001-03-11=2001-070=2001-W10-7" - ,"51980=2001-03-12=2001-071=2001-W11-1" - ,"51981=2001-03-13=2001-072=2001-W11-2" - ,"51982=2001-03-14=2001-073=2001-W11-3" - ,"51983=2001-03-15=2001-074=2001-W11-4" - ,"51984=2001-03-16=2001-075=2001-W11-5" - ,"51985=2001-03-17=2001-076=2001-W11-6" - ,"51986=2001-03-18=2001-077=2001-W11-7" - ,"51987=2001-03-19=2001-078=2001-W12-1" - ,"51988=2001-03-20=2001-079=2001-W12-2" - ,"51989=2001-03-21=2001-080=2001-W12-3" - ,"51990=2001-03-22=2001-081=2001-W12-4" - ,"51991=2001-03-23=2001-082=2001-W12-5" - ,"51992=2001-03-24=2001-083=2001-W12-6" - ,"51993=2001-03-25=2001-084=2001-W12-7" - ,"51994=2001-03-26=2001-085=2001-W13-1" - ,"51995=2001-03-27=2001-086=2001-W13-2" - ,"51996=2001-03-28=2001-087=2001-W13-3" - ,"51997=2001-03-29=2001-088=2001-W13-4" - ,"51998=2001-03-30=2001-089=2001-W13-5" - ,"51999=2001-03-31=2001-090=2001-W13-6" - ,"52000=2001-04-01=2001-091=2001-W13-7" - ,"52001=2001-04-02=2001-092=2001-W14-1" - ,"52002=2001-04-03=2001-093=2001-W14-2" - ,"52003=2001-04-04=2001-094=2001-W14-3" - ,"52004=2001-04-05=2001-095=2001-W14-4" - ,"52005=2001-04-06=2001-096=2001-W14-5" - ,"52006=2001-04-07=2001-097=2001-W14-6" - ,"52007=2001-04-08=2001-098=2001-W14-7" - ,"52008=2001-04-09=2001-099=2001-W15-1" - ,"52009=2001-04-10=2001-100=2001-W15-2" - ,"52010=2001-04-11=2001-101=2001-W15-3" - ,"52011=2001-04-12=2001-102=2001-W15-4" - ,"52012=2001-04-13=2001-103=2001-W15-5" - ,"52013=2001-04-14=2001-104=2001-W15-6" - ,"52014=2001-04-15=2001-105=2001-W15-7" - ,"52015=2001-04-16=2001-106=2001-W16-1" - ,"52016=2001-04-17=2001-107=2001-W16-2" - ,"52017=2001-04-18=2001-108=2001-W16-3" - ,"52018=2001-04-19=2001-109=2001-W16-4" - ,"52019=2001-04-20=2001-110=2001-W16-5" - ,"52020=2001-04-21=2001-111=2001-W16-6" - ,"52021=2001-04-22=2001-112=2001-W16-7" - ,"52022=2001-04-23=2001-113=2001-W17-1" - ,"52023=2001-04-24=2001-114=2001-W17-2" - ,"52024=2001-04-25=2001-115=2001-W17-3" - ,"52025=2001-04-26=2001-116=2001-W17-4" - ,"52026=2001-04-27=2001-117=2001-W17-5" - ,"52027=2001-04-28=2001-118=2001-W17-6" - ,"52028=2001-04-29=2001-119=2001-W17-7" - ,"52029=2001-04-30=2001-120=2001-W18-1" - ,"52030=2001-05-01=2001-121=2001-W18-2" - ,"52031=2001-05-02=2001-122=2001-W18-3" - ,"52032=2001-05-03=2001-123=2001-W18-4" - ,"52033=2001-05-04=2001-124=2001-W18-5" - ,"52034=2001-05-05=2001-125=2001-W18-6" - ,"52035=2001-05-06=2001-126=2001-W18-7" - ,"52036=2001-05-07=2001-127=2001-W19-1" - ,"52037=2001-05-08=2001-128=2001-W19-2" - ,"52038=2001-05-09=2001-129=2001-W19-3" - ,"52039=2001-05-10=2001-130=2001-W19-4" - ,"52040=2001-05-11=2001-131=2001-W19-5" - ,"52041=2001-05-12=2001-132=2001-W19-6" - ,"52042=2001-05-13=2001-133=2001-W19-7" - ,"52043=2001-05-14=2001-134=2001-W20-1" - ,"52044=2001-05-15=2001-135=2001-W20-2" - ,"52045=2001-05-16=2001-136=2001-W20-3" - ,"52046=2001-05-17=2001-137=2001-W20-4" - ,"52047=2001-05-18=2001-138=2001-W20-5" - ,"52048=2001-05-19=2001-139=2001-W20-6" - ,"52049=2001-05-20=2001-140=2001-W20-7" - ,"52050=2001-05-21=2001-141=2001-W21-1" - ,"52051=2001-05-22=2001-142=2001-W21-2" - ,"52052=2001-05-23=2001-143=2001-W21-3" - ,"52053=2001-05-24=2001-144=2001-W21-4" - ,"52054=2001-05-25=2001-145=2001-W21-5" - ,"52055=2001-05-26=2001-146=2001-W21-6" - ,"52056=2001-05-27=2001-147=2001-W21-7" - ,"52057=2001-05-28=2001-148=2001-W22-1" - ,"52058=2001-05-29=2001-149=2001-W22-2" - ,"52059=2001-05-30=2001-150=2001-W22-3" - ,"52060=2001-05-31=2001-151=2001-W22-4" - ,"52061=2001-06-01=2001-152=2001-W22-5" - ,"52062=2001-06-02=2001-153=2001-W22-6" - ,"52063=2001-06-03=2001-154=2001-W22-7" - ,"52064=2001-06-04=2001-155=2001-W23-1" - ,"52065=2001-06-05=2001-156=2001-W23-2" - ,"52066=2001-06-06=2001-157=2001-W23-3" - ,"52067=2001-06-07=2001-158=2001-W23-4" - ,"52068=2001-06-08=2001-159=2001-W23-5" - ,"52069=2001-06-09=2001-160=2001-W23-6" - ,"52070=2001-06-10=2001-161=2001-W23-7" - ,"52071=2001-06-11=2001-162=2001-W24-1" - ,"52072=2001-06-12=2001-163=2001-W24-2" - ,"52073=2001-06-13=2001-164=2001-W24-3" - ,"52074=2001-06-14=2001-165=2001-W24-4" - ,"52075=2001-06-15=2001-166=2001-W24-5" - ,"52076=2001-06-16=2001-167=2001-W24-6" - ,"52077=2001-06-17=2001-168=2001-W24-7" - ,"52078=2001-06-18=2001-169=2001-W25-1" - ,"52079=2001-06-19=2001-170=2001-W25-2" - ,"52080=2001-06-20=2001-171=2001-W25-3" - ,"52081=2001-06-21=2001-172=2001-W25-4" - ,"52082=2001-06-22=2001-173=2001-W25-5" - ,"52083=2001-06-23=2001-174=2001-W25-6" - ,"52084=2001-06-24=2001-175=2001-W25-7" - ,"52085=2001-06-25=2001-176=2001-W26-1" - ,"52086=2001-06-26=2001-177=2001-W26-2" - ,"52087=2001-06-27=2001-178=2001-W26-3" - ,"52088=2001-06-28=2001-179=2001-W26-4" - ,"52089=2001-06-29=2001-180=2001-W26-5" - ,"52090=2001-06-30=2001-181=2001-W26-6" - ,"52091=2001-07-01=2001-182=2001-W26-7" - ,"52092=2001-07-02=2001-183=2001-W27-1" - ,"52093=2001-07-03=2001-184=2001-W27-2" - ,"52094=2001-07-04=2001-185=2001-W27-3" - ,"52095=2001-07-05=2001-186=2001-W27-4" - ,"52096=2001-07-06=2001-187=2001-W27-5" - ,"52097=2001-07-07=2001-188=2001-W27-6" - ,"52098=2001-07-08=2001-189=2001-W27-7" - ,"52099=2001-07-09=2001-190=2001-W28-1" - ,"52100=2001-07-10=2001-191=2001-W28-2" - ,"52101=2001-07-11=2001-192=2001-W28-3" - ,"52102=2001-07-12=2001-193=2001-W28-4" - ,"52103=2001-07-13=2001-194=2001-W28-5" - ,"52104=2001-07-14=2001-195=2001-W28-6" - ,"52105=2001-07-15=2001-196=2001-W28-7" - ,"52106=2001-07-16=2001-197=2001-W29-1" - ,"52107=2001-07-17=2001-198=2001-W29-2" - ,"52108=2001-07-18=2001-199=2001-W29-3" - ,"52109=2001-07-19=2001-200=2001-W29-4" - ,"52110=2001-07-20=2001-201=2001-W29-5" - ,"52111=2001-07-21=2001-202=2001-W29-6" - ,"52112=2001-07-22=2001-203=2001-W29-7" - ,"52113=2001-07-23=2001-204=2001-W30-1" - ,"52114=2001-07-24=2001-205=2001-W30-2" - ,"52115=2001-07-25=2001-206=2001-W30-3" - ,"52116=2001-07-26=2001-207=2001-W30-4" - ,"52117=2001-07-27=2001-208=2001-W30-5" - ,"52118=2001-07-28=2001-209=2001-W30-6" - ,"52119=2001-07-29=2001-210=2001-W30-7" - ,"52120=2001-07-30=2001-211=2001-W31-1" - ,"52121=2001-07-31=2001-212=2001-W31-2" - ,"52122=2001-08-01=2001-213=2001-W31-3" - ,"52123=2001-08-02=2001-214=2001-W31-4" - ,"52124=2001-08-03=2001-215=2001-W31-5" - ,"52125=2001-08-04=2001-216=2001-W31-6" - ,"52126=2001-08-05=2001-217=2001-W31-7" - ,"52127=2001-08-06=2001-218=2001-W32-1" - ,"52128=2001-08-07=2001-219=2001-W32-2" - ,"52129=2001-08-08=2001-220=2001-W32-3" - ,"52130=2001-08-09=2001-221=2001-W32-4" - ,"52131=2001-08-10=2001-222=2001-W32-5" - ,"52132=2001-08-11=2001-223=2001-W32-6" - ,"52133=2001-08-12=2001-224=2001-W32-7" - ,"52134=2001-08-13=2001-225=2001-W33-1" - ,"52135=2001-08-14=2001-226=2001-W33-2" - ,"52136=2001-08-15=2001-227=2001-W33-3" - ,"52137=2001-08-16=2001-228=2001-W33-4" - ,"52138=2001-08-17=2001-229=2001-W33-5" - ,"52139=2001-08-18=2001-230=2001-W33-6" - ,"52140=2001-08-19=2001-231=2001-W33-7" - ,"52141=2001-08-20=2001-232=2001-W34-1" - ,"52142=2001-08-21=2001-233=2001-W34-2" - ,"52143=2001-08-22=2001-234=2001-W34-3" - ,"52144=2001-08-23=2001-235=2001-W34-4" - ,"52145=2001-08-24=2001-236=2001-W34-5" - ,"52146=2001-08-25=2001-237=2001-W34-6" - ,"52147=2001-08-26=2001-238=2001-W34-7" - ,"52148=2001-08-27=2001-239=2001-W35-1" - ,"52149=2001-08-28=2001-240=2001-W35-2" - ,"52150=2001-08-29=2001-241=2001-W35-3" - ,"52151=2001-08-30=2001-242=2001-W35-4" - ,"52152=2001-08-31=2001-243=2001-W35-5" - ,"52153=2001-09-01=2001-244=2001-W35-6" - ,"52154=2001-09-02=2001-245=2001-W35-7" - ,"52155=2001-09-03=2001-246=2001-W36-1" - ,"52156=2001-09-04=2001-247=2001-W36-2" - ,"52157=2001-09-05=2001-248=2001-W36-3" - ,"52158=2001-09-06=2001-249=2001-W36-4" - ,"52159=2001-09-07=2001-250=2001-W36-5" - ,"52160=2001-09-08=2001-251=2001-W36-6" - ,"52161=2001-09-09=2001-252=2001-W36-7" - ,"52162=2001-09-10=2001-253=2001-W37-1" - ,"52163=2001-09-11=2001-254=2001-W37-2" - ,"52164=2001-09-12=2001-255=2001-W37-3" - ,"52165=2001-09-13=2001-256=2001-W37-4" - ,"52166=2001-09-14=2001-257=2001-W37-5" - ,"52167=2001-09-15=2001-258=2001-W37-6" - ,"52168=2001-09-16=2001-259=2001-W37-7" - ,"52169=2001-09-17=2001-260=2001-W38-1" - ,"52170=2001-09-18=2001-261=2001-W38-2" - ,"52171=2001-09-19=2001-262=2001-W38-3" - ,"52172=2001-09-20=2001-263=2001-W38-4" - ,"52173=2001-09-21=2001-264=2001-W38-5" - ,"52174=2001-09-22=2001-265=2001-W38-6" - ,"52175=2001-09-23=2001-266=2001-W38-7" - ,"52176=2001-09-24=2001-267=2001-W39-1" - ,"52177=2001-09-25=2001-268=2001-W39-2" - ,"52178=2001-09-26=2001-269=2001-W39-3" - ,"52179=2001-09-27=2001-270=2001-W39-4" - ,"52180=2001-09-28=2001-271=2001-W39-5" - ,"52181=2001-09-29=2001-272=2001-W39-6" - ,"52182=2001-09-30=2001-273=2001-W39-7" - ,"52183=2001-10-01=2001-274=2001-W40-1" - ,"52184=2001-10-02=2001-275=2001-W40-2" - ,"52185=2001-10-03=2001-276=2001-W40-3" - ,"52186=2001-10-04=2001-277=2001-W40-4" - ,"52187=2001-10-05=2001-278=2001-W40-5" - ,"52188=2001-10-06=2001-279=2001-W40-6" - ,"52189=2001-10-07=2001-280=2001-W40-7" - ,"52190=2001-10-08=2001-281=2001-W41-1" - ,"52191=2001-10-09=2001-282=2001-W41-2" - ,"52192=2001-10-10=2001-283=2001-W41-3" - ,"52193=2001-10-11=2001-284=2001-W41-4" - ,"52194=2001-10-12=2001-285=2001-W41-5" - ,"52195=2001-10-13=2001-286=2001-W41-6" - ,"52196=2001-10-14=2001-287=2001-W41-7" - ,"52197=2001-10-15=2001-288=2001-W42-1" - ,"52198=2001-10-16=2001-289=2001-W42-2" - ,"52199=2001-10-17=2001-290=2001-W42-3" - ,"52200=2001-10-18=2001-291=2001-W42-4" - ,"52201=2001-10-19=2001-292=2001-W42-5" - ,"52202=2001-10-20=2001-293=2001-W42-6" - ,"52203=2001-10-21=2001-294=2001-W42-7" - ,"52204=2001-10-22=2001-295=2001-W43-1" - ,"52205=2001-10-23=2001-296=2001-W43-2" - ,"52206=2001-10-24=2001-297=2001-W43-3" - ,"52207=2001-10-25=2001-298=2001-W43-4" - ,"52208=2001-10-26=2001-299=2001-W43-5" - ,"52209=2001-10-27=2001-300=2001-W43-6" - ,"52210=2001-10-28=2001-301=2001-W43-7" - ,"52211=2001-10-29=2001-302=2001-W44-1" - ,"52212=2001-10-30=2001-303=2001-W44-2" - ,"52213=2001-10-31=2001-304=2001-W44-3" - ,"52214=2001-11-01=2001-305=2001-W44-4" - ,"52215=2001-11-02=2001-306=2001-W44-5" - ,"52216=2001-11-03=2001-307=2001-W44-6" - ,"52217=2001-11-04=2001-308=2001-W44-7" - ,"52218=2001-11-05=2001-309=2001-W45-1" - ,"52219=2001-11-06=2001-310=2001-W45-2" - ,"52220=2001-11-07=2001-311=2001-W45-3" - ,"52221=2001-11-08=2001-312=2001-W45-4" - ,"52222=2001-11-09=2001-313=2001-W45-5" - ,"52223=2001-11-10=2001-314=2001-W45-6" - ,"52224=2001-11-11=2001-315=2001-W45-7" - ,"52225=2001-11-12=2001-316=2001-W46-1" - ,"52226=2001-11-13=2001-317=2001-W46-2" - ,"52227=2001-11-14=2001-318=2001-W46-3" - ,"52228=2001-11-15=2001-319=2001-W46-4" - ,"52229=2001-11-16=2001-320=2001-W46-5" - ,"52230=2001-11-17=2001-321=2001-W46-6" - ,"52231=2001-11-18=2001-322=2001-W46-7" - ,"52232=2001-11-19=2001-323=2001-W47-1" - ,"52233=2001-11-20=2001-324=2001-W47-2" - ,"52234=2001-11-21=2001-325=2001-W47-3" - ,"52235=2001-11-22=2001-326=2001-W47-4" - ,"52236=2001-11-23=2001-327=2001-W47-5" - ,"52237=2001-11-24=2001-328=2001-W47-6" - ,"52238=2001-11-25=2001-329=2001-W47-7" - ,"52239=2001-11-26=2001-330=2001-W48-1" - ,"52240=2001-11-27=2001-331=2001-W48-2" - ,"52241=2001-11-28=2001-332=2001-W48-3" - ,"52242=2001-11-29=2001-333=2001-W48-4" - ,"52243=2001-11-30=2001-334=2001-W48-5" - ,"52244=2001-12-01=2001-335=2001-W48-6" - ,"52245=2001-12-02=2001-336=2001-W48-7" - ,"52246=2001-12-03=2001-337=2001-W49-1" - ,"52247=2001-12-04=2001-338=2001-W49-2" - ,"52248=2001-12-05=2001-339=2001-W49-3" - ,"52249=2001-12-06=2001-340=2001-W49-4" - ,"52250=2001-12-07=2001-341=2001-W49-5" - ,"52251=2001-12-08=2001-342=2001-W49-6" - ,"52252=2001-12-09=2001-343=2001-W49-7" - ,"52253=2001-12-10=2001-344=2001-W50-1" - ,"52254=2001-12-11=2001-345=2001-W50-2" - ,"52255=2001-12-12=2001-346=2001-W50-3" - ,"52256=2001-12-13=2001-347=2001-W50-4" - ,"52257=2001-12-14=2001-348=2001-W50-5" - ,"52258=2001-12-15=2001-349=2001-W50-6" - ,"52259=2001-12-16=2001-350=2001-W50-7" - ,"52260=2001-12-17=2001-351=2001-W51-1" - ,"52261=2001-12-18=2001-352=2001-W51-2" - ,"52262=2001-12-19=2001-353=2001-W51-3" - ,"52263=2001-12-20=2001-354=2001-W51-4" - ,"52264=2001-12-21=2001-355=2001-W51-5" - ,"52265=2001-12-22=2001-356=2001-W51-6" - ,"52266=2001-12-23=2001-357=2001-W51-7" - ,"52267=2001-12-24=2001-358=2001-W52-1" - ,"52268=2001-12-25=2001-359=2001-W52-2" - ,"52269=2001-12-26=2001-360=2001-W52-3" - ,"52270=2001-12-27=2001-361=2001-W52-4" - ,"52271=2001-12-28=2001-362=2001-W52-5" - ,"52272=2001-12-29=2001-363=2001-W52-6" - ,"52273=2001-12-30=2001-364=2001-W52-7" - ,"52274=2001-12-31=2001-365=2002-W01-1" - ,"52275=2002-01-01=2002-001=2002-W01-2" - ,"52276=2002-01-02=2002-002=2002-W01-3" - ,"52277=2002-01-03=2002-003=2002-W01-4" - ,"52278=2002-01-04=2002-004=2002-W01-5" - ,"52279=2002-01-05=2002-005=2002-W01-6" - ,"52280=2002-01-06=2002-006=2002-W01-7" - ,"" - ,"51178=1998-12-31=1998-365=1998-W53-4" - ,"" - ,"1998-12-31 23:59:60.5" - ,"51178,86400.5s" - ,"1998-12-31 15:59:60.5" - ,"51178,86400.5s" - ,"" - ,"2000-03-01 00:00:00" - ,"2000-03-01 12:00:00" - ,"2000-02-29 16:00:00" - ,"2000-03-01 04:00:00" - ,"2000-03-01 08:00:00" - ,"2000-03-01 20:00:00" - ,"" - ,"12:34:56.789" - ,"12:34:56.789123" - ,"12:34:56.789123456" - ,"12:34:56.789123456789" - ,"" ] diff --git a/test/Test/TestTimeZone.hs b/test/Test/TestTimeZone.hs deleted file mode 100644 --- a/test/Test/TestTimeZone.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# OPTIONS -Wall -Werror #-} - -module Test.TestTimeZone where - -import Data.Time -import System.Posix.Env (putEnv) -import Test.TestUtil - -testTimeZone :: Test -testTimeZone = ioTest "getTimeZone respects TZ env var" $ do - putEnv "TZ=UTC+0" - zone1 <- getTimeZone epoch - putEnv "TZ=EST+5" - zone2 <- getTimeZone epoch - return $ diff False (zone1 == zone2) - where - epoch = UTCTime (ModifiedJulianDay 0) 0 diff --git a/test/Test/TestUtil.hs b/test/Test/TestUtil.hs deleted file mode 100644 --- a/test/Test/TestUtil.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# OPTIONS -fno-warn-overlapping-patterns #-} -module Test.TestUtil - ( - module Test.TestUtil, - module Test.Framework, - module Test.Framework.Providers.QuickCheck2 - ) where - -import Test.Framework -import Test.Framework.Providers.API -import Test.Framework.Providers.QuickCheck2 -import Data.Typeable - -data Result = Pass | Fail String deriving Typeable - -instance Show Result where - show Pass = "passed" - show (Fail s) = "failed: " ++ s - -instance TestResultlike () Result where - testSucceeded Pass = True - testSucceeded (Fail _) = False - -instance Testlike () Result (IO Result) where - testTypeName _ = "Cases" - runTest _ ior = do - r <- ior - return (Finished r,return ()) - -ioTest :: String -> IO Result -> Test -ioTest = Test - -pureTest :: String -> Result -> Test -pureTest name result = ioTest name (return result) - -diff :: (Show a,Eq a) => a -> a -> Result -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" diff --git a/test/Test/TestValid.hs b/test/Test/TestValid.hs deleted file mode 100644 --- a/test/Test/TestValid.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Test.TestValid where - -import Data.Time -import Data.Time.Calendar.OrdinalDate -import Data.Time.Calendar.WeekDate -import Data.Time.Calendar.Julian -import Test.QuickCheck hiding (Result,reason) -import Test.QuickCheck.Property -import Test.TestUtil hiding (Result) - - -validResult :: (Eq c,Show c,Eq t,Show t) => - Bool -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> c -> Result -validResult valid toComponents fromComponents fromComponentsValid c = let - mt = fromComponentsValid c - t' = fromComponents c - c' = toComponents t' - in if valid then - case mt of - Nothing -> rejected - Just t -> if t' /= t - then failed {reason = "'fromValid' gives " ++ show t ++ ", but 'from' gives " ++ show t'} - else if c' /= c - then failed {reason = "found valid, but converts " ++ show c ++ " -> " ++ show t' ++ " -> " ++ show c'} - else succeeded - else case mt of - Nothing -> if c' /= c - then succeeded - else failed {reason = show c ++ " found invalid, but converts with " ++ show t'} - Just _ -> rejected - -validTest :: (Arbitrary c,Eq c,Show c,Eq t,Show t) => - String -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> Test -validTest name toComponents fromComponents fromComponentsValid = testGroup name - [ - testProperty "valid" $ property $ validResult True toComponents fromComponents fromComponentsValid, - testProperty "invalid" $ property $ validResult False toComponents fromComponents fromComponentsValid - ] - -toSundayStartWeek :: Day -> (Integer,Int,Int) -toSundayStartWeek day = let - (y,_) = toOrdinalDate day - (m,d) = sundayStartWeek day - in (y,m,d) - -toMondayStartWeek :: Day -> (Integer,Int,Int) -toMondayStartWeek day = let - (y,_) = toOrdinalDate day - (m,d) = mondayStartWeek day - in (y,m,d) - -testValid :: Test -testValid = testGroup "testValid" - [ - validTest "Gregorian" toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d), - validTest "OrdinalDate" toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d), - validTest "WeekDate" toWeekDate (\(y,m,d) -> fromWeekDate y m d) (\(y,m,d) -> fromWeekDateValid y m d), - validTest "SundayStartWeek" toSundayStartWeek (\(y,m,d) -> fromSundayStartWeek y m d) (\(y,m,d) -> fromSundayStartWeekValid y m d), - validTest "MondayStartWeek" toMondayStartWeek (\(y,m,d) -> fromMondayStartWeek y m d) (\(y,m,d) -> fromMondayStartWeekValid y m d), - validTest "Julian" toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d) - ] diff --git a/test/Test/Tests.hs b/test/Test/Tests.hs deleted file mode 100644 --- a/test/Test/Tests.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Test.Tests where - -import Test.Framework - -import Test.AddDays -import Test.ClipDates -import Test.ConvertBack -import Test.LongWeekYears -import Test.TestCalendars -import Test.TestEaster -import Test.TestFormat -import Test.TestMonthDay -import Test.TestParseTime -import Test.TestTAI -import Test.TestTime -import Test.TestTimeZone -import Test.TestValid - -tests :: [Test] -tests = [ addDaysTest - , clipDates - , convertBack - , longWeekYears - , testCalendars - , testEaster - , testFormat - , testMonthDay - , testParseTime - , testTAI - , testTime - , testTimeZone - , testValid ] diff --git a/test/main/Main.hs b/test/main/Main.hs new file mode 100644 --- /dev/null +++ b/test/main/Main.hs @@ -0,0 +1,52 @@ +module Main where + +import Foreign.C.Types +import Test.Tasty +import Test.Calendar.AddDays +import Test.Calendar.Calendars +import Test.Calendar.ClipDates +import Test.Calendar.ConvertBack +import Test.Calendar.Easter +import Test.Calendar.LongWeekYears +import Test.Calendar.MonthDay +import Test.Calendar.Valid +import Test.Clock.Conversion +import Test.Clock.Resolution +import Test.Clock.TAI +import Test.Format.Format +import Test.Format.ParseTime +import Test.LocalTime.Time + + +tests :: TestTree +tests = testGroup "Time" [ + testGroup "Calendar" [ + addDaysTest, + testCalendars, + clipDates, + convertBack, + longWeekYears, + testMonthDay, + testEaster, + testValid + ], + testGroup "Clock" [ + testClockConversion, + testResolutions, + testTAI + ], + testGroup "Format" [ + testFormat, + testParseTime + ], + testGroup "LocalTime" [ + testTime + ] + ] + +main :: IO () +main = do + if (toRational (1000000000000 :: CTime)) /= (1000000000000 :: Rational) + then putStrLn "WARNING: Some tests will incorrectly fail due to a 32-bit time_t C type." + else return () + defaultMain tests diff --git a/test/main/Test/Calendar/AddDays.hs b/test/main/Test/Calendar/AddDays.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/AddDays.hs @@ -0,0 +1,42 @@ +module Test.Calendar.AddDays(addDaysTest) where + +import Data.Time.Calendar +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.AddDaysRef + +days ::[Day] +days = + [ + fromGregorian 2005 2 28, + fromGregorian 2004 2 29, + fromGregorian 2004 1 31, + fromGregorian 2004 12 31, + fromGregorian 2005 7 1, + fromGregorian 2005 4 21, + fromGregorian 2005 6 30 + ] + +increments :: [Integer] +increments = [-10,-4,-1,0,1,7,83] + +adders :: [(String,Integer -> Day -> Day)] +adders = + [ + ("day",addDays), + ("month (clip)",addGregorianMonthsClip), + ("month (roll over)",addGregorianMonthsRollOver), + ("year (clip)",addGregorianYearsClip), + ("year (roll over)",addGregorianYearsRollOver) + ] + +resultDays :: [String] +resultDays = do + (aname,adder) <- adders + increment <- increments + day <- days + return ((showGregorian day) ++ " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day)) + +addDaysTest :: TestTree +addDaysTest = testCase "addDays" $ + assertEqual "" addDaysRef $ unlines resultDays diff --git a/test/main/Test/Calendar/AddDaysRef.hs b/test/main/Test/Calendar/AddDaysRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/AddDaysRef.hs @@ -0,0 +1,250 @@ +module Test.Calendar.AddDaysRef where + +addDaysRef :: String +addDaysRef = + unlines + [ "2005-02-28 + -10 * day = 2005-02-18" + , "2004-02-29 + -10 * day = 2004-02-19" + , "2004-01-31 + -10 * day = 2004-01-21" + , "2004-12-31 + -10 * day = 2004-12-21" + , "2005-07-01 + -10 * day = 2005-06-21" + , "2005-04-21 + -10 * day = 2005-04-11" + , "2005-06-30 + -10 * day = 2005-06-20" + , "2005-02-28 + -4 * day = 2005-02-24" + , "2004-02-29 + -4 * day = 2004-02-25" + , "2004-01-31 + -4 * day = 2004-01-27" + , "2004-12-31 + -4 * day = 2004-12-27" + , "2005-07-01 + -4 * day = 2005-06-27" + , "2005-04-21 + -4 * day = 2005-04-17" + , "2005-06-30 + -4 * day = 2005-06-26" + , "2005-02-28 + -1 * day = 2005-02-27" + , "2004-02-29 + -1 * day = 2004-02-28" + , "2004-01-31 + -1 * day = 2004-01-30" + , "2004-12-31 + -1 * day = 2004-12-30" + , "2005-07-01 + -1 * day = 2005-06-30" + , "2005-04-21 + -1 * day = 2005-04-20" + , "2005-06-30 + -1 * day = 2005-06-29" + , "2005-02-28 + 0 * day = 2005-02-28" + , "2004-02-29 + 0 * day = 2004-02-29" + , "2004-01-31 + 0 * day = 2004-01-31" + , "2004-12-31 + 0 * day = 2004-12-31" + , "2005-07-01 + 0 * day = 2005-07-01" + , "2005-04-21 + 0 * day = 2005-04-21" + , "2005-06-30 + 0 * day = 2005-06-30" + , "2005-02-28 + 1 * day = 2005-03-01" + , "2004-02-29 + 1 * day = 2004-03-01" + , "2004-01-31 + 1 * day = 2004-02-01" + , "2004-12-31 + 1 * day = 2005-01-01" + , "2005-07-01 + 1 * day = 2005-07-02" + , "2005-04-21 + 1 * day = 2005-04-22" + , "2005-06-30 + 1 * day = 2005-07-01" + , "2005-02-28 + 7 * day = 2005-03-07" + , "2004-02-29 + 7 * day = 2004-03-07" + , "2004-01-31 + 7 * day = 2004-02-07" + , "2004-12-31 + 7 * day = 2005-01-07" + , "2005-07-01 + 7 * day = 2005-07-08" + , "2005-04-21 + 7 * day = 2005-04-28" + , "2005-06-30 + 7 * day = 2005-07-07" + , "2005-02-28 + 83 * day = 2005-05-22" + , "2004-02-29 + 83 * day = 2004-05-22" + , "2004-01-31 + 83 * day = 2004-04-23" + , "2004-12-31 + 83 * day = 2005-03-24" + , "2005-07-01 + 83 * day = 2005-09-22" + , "2005-04-21 + 83 * day = 2005-07-13" + , "2005-06-30 + 83 * day = 2005-09-21" + , "2005-02-28 + -10 * month (clip) = 2004-04-28" + , "2004-02-29 + -10 * month (clip) = 2003-04-29" + , "2004-01-31 + -10 * month (clip) = 2003-03-31" + , "2004-12-31 + -10 * month (clip) = 2004-02-29" + , "2005-07-01 + -10 * month (clip) = 2004-09-01" + , "2005-04-21 + -10 * month (clip) = 2004-06-21" + , "2005-06-30 + -10 * month (clip) = 2004-08-30" + , "2005-02-28 + -4 * month (clip) = 2004-10-28" + , "2004-02-29 + -4 * month (clip) = 2003-10-29" + , "2004-01-31 + -4 * month (clip) = 2003-09-30" + , "2004-12-31 + -4 * month (clip) = 2004-08-31" + , "2005-07-01 + -4 * month (clip) = 2005-03-01" + , "2005-04-21 + -4 * month (clip) = 2004-12-21" + , "2005-06-30 + -4 * month (clip) = 2005-02-28" + , "2005-02-28 + -1 * month (clip) = 2005-01-28" + , "2004-02-29 + -1 * month (clip) = 2004-01-29" + , "2004-01-31 + -1 * month (clip) = 2003-12-31" + , "2004-12-31 + -1 * month (clip) = 2004-11-30" + , "2005-07-01 + -1 * month (clip) = 2005-06-01" + , "2005-04-21 + -1 * month (clip) = 2005-03-21" + , "2005-06-30 + -1 * month (clip) = 2005-05-30" + , "2005-02-28 + 0 * month (clip) = 2005-02-28" + , "2004-02-29 + 0 * month (clip) = 2004-02-29" + , "2004-01-31 + 0 * month (clip) = 2004-01-31" + , "2004-12-31 + 0 * month (clip) = 2004-12-31" + , "2005-07-01 + 0 * month (clip) = 2005-07-01" + , "2005-04-21 + 0 * month (clip) = 2005-04-21" + , "2005-06-30 + 0 * month (clip) = 2005-06-30" + , "2005-02-28 + 1 * month (clip) = 2005-03-28" + , "2004-02-29 + 1 * month (clip) = 2004-03-29" + , "2004-01-31 + 1 * month (clip) = 2004-02-29" + , "2004-12-31 + 1 * month (clip) = 2005-01-31" + , "2005-07-01 + 1 * month (clip) = 2005-08-01" + , "2005-04-21 + 1 * month (clip) = 2005-05-21" + , "2005-06-30 + 1 * month (clip) = 2005-07-30" + , "2005-02-28 + 7 * month (clip) = 2005-09-28" + , "2004-02-29 + 7 * month (clip) = 2004-09-29" + , "2004-01-31 + 7 * month (clip) = 2004-08-31" + , "2004-12-31 + 7 * month (clip) = 2005-07-31" + , "2005-07-01 + 7 * month (clip) = 2006-02-01" + , "2005-04-21 + 7 * month (clip) = 2005-11-21" + , "2005-06-30 + 7 * month (clip) = 2006-01-30" + , "2005-02-28 + 83 * month (clip) = 2012-01-28" + , "2004-02-29 + 83 * month (clip) = 2011-01-29" + , "2004-01-31 + 83 * month (clip) = 2010-12-31" + , "2004-12-31 + 83 * month (clip) = 2011-11-30" + , "2005-07-01 + 83 * month (clip) = 2012-06-01" + , "2005-04-21 + 83 * month (clip) = 2012-03-21" + , "2005-06-30 + 83 * month (clip) = 2012-05-30" + , "2005-02-28 + -10 * month (roll over) = 2004-04-28" + , "2004-02-29 + -10 * month (roll over) = 2003-04-29" + , "2004-01-31 + -10 * month (roll over) = 2003-03-31" + , "2004-12-31 + -10 * month (roll over) = 2004-03-02" + , "2005-07-01 + -10 * month (roll over) = 2004-09-01" + , "2005-04-21 + -10 * month (roll over) = 2004-06-21" + , "2005-06-30 + -10 * month (roll over) = 2004-08-30" + , "2005-02-28 + -4 * month (roll over) = 2004-10-28" + , "2004-02-29 + -4 * month (roll over) = 2003-10-29" + , "2004-01-31 + -4 * month (roll over) = 2003-10-01" + , "2004-12-31 + -4 * month (roll over) = 2004-08-31" + , "2005-07-01 + -4 * month (roll over) = 2005-03-01" + , "2005-04-21 + -4 * month (roll over) = 2004-12-21" + , "2005-06-30 + -4 * month (roll over) = 2005-03-02" + , "2005-02-28 + -1 * month (roll over) = 2005-01-28" + , "2004-02-29 + -1 * month (roll over) = 2004-01-29" + , "2004-01-31 + -1 * month (roll over) = 2003-12-31" + , "2004-12-31 + -1 * month (roll over) = 2004-12-01" + , "2005-07-01 + -1 * month (roll over) = 2005-06-01" + , "2005-04-21 + -1 * month (roll over) = 2005-03-21" + , "2005-06-30 + -1 * month (roll over) = 2005-05-30" + , "2005-02-28 + 0 * month (roll over) = 2005-02-28" + , "2004-02-29 + 0 * month (roll over) = 2004-02-29" + , "2004-01-31 + 0 * month (roll over) = 2004-01-31" + , "2004-12-31 + 0 * month (roll over) = 2004-12-31" + , "2005-07-01 + 0 * month (roll over) = 2005-07-01" + , "2005-04-21 + 0 * month (roll over) = 2005-04-21" + , "2005-06-30 + 0 * month (roll over) = 2005-06-30" + , "2005-02-28 + 1 * month (roll over) = 2005-03-28" + , "2004-02-29 + 1 * month (roll over) = 2004-03-29" + , "2004-01-31 + 1 * month (roll over) = 2004-03-02" + , "2004-12-31 + 1 * month (roll over) = 2005-01-31" + , "2005-07-01 + 1 * month (roll over) = 2005-08-01" + , "2005-04-21 + 1 * month (roll over) = 2005-05-21" + , "2005-06-30 + 1 * month (roll over) = 2005-07-30" + , "2005-02-28 + 7 * month (roll over) = 2005-09-28" + , "2004-02-29 + 7 * month (roll over) = 2004-09-29" + , "2004-01-31 + 7 * month (roll over) = 2004-08-31" + , "2004-12-31 + 7 * month (roll over) = 2005-07-31" + , "2005-07-01 + 7 * month (roll over) = 2006-02-01" + , "2005-04-21 + 7 * month (roll over) = 2005-11-21" + , "2005-06-30 + 7 * month (roll over) = 2006-01-30" + , "2005-02-28 + 83 * month (roll over) = 2012-01-28" + , "2004-02-29 + 83 * month (roll over) = 2011-01-29" + , "2004-01-31 + 83 * month (roll over) = 2010-12-31" + , "2004-12-31 + 83 * month (roll over) = 2011-12-01" + , "2005-07-01 + 83 * month (roll over) = 2012-06-01" + , "2005-04-21 + 83 * month (roll over) = 2012-03-21" + , "2005-06-30 + 83 * month (roll over) = 2012-05-30" + , "2005-02-28 + -10 * year (clip) = 1995-02-28" + , "2004-02-29 + -10 * year (clip) = 1994-02-28" + , "2004-01-31 + -10 * year (clip) = 1994-01-31" + , "2004-12-31 + -10 * year (clip) = 1994-12-31" + , "2005-07-01 + -10 * year (clip) = 1995-07-01" + , "2005-04-21 + -10 * year (clip) = 1995-04-21" + , "2005-06-30 + -10 * year (clip) = 1995-06-30" + , "2005-02-28 + -4 * year (clip) = 2001-02-28" + , "2004-02-29 + -4 * year (clip) = 2000-02-29" + , "2004-01-31 + -4 * year (clip) = 2000-01-31" + , "2004-12-31 + -4 * year (clip) = 2000-12-31" + , "2005-07-01 + -4 * year (clip) = 2001-07-01" + , "2005-04-21 + -4 * year (clip) = 2001-04-21" + , "2005-06-30 + -4 * year (clip) = 2001-06-30" + , "2005-02-28 + -1 * year (clip) = 2004-02-28" + , "2004-02-29 + -1 * year (clip) = 2003-02-28" + , "2004-01-31 + -1 * year (clip) = 2003-01-31" + , "2004-12-31 + -1 * year (clip) = 2003-12-31" + , "2005-07-01 + -1 * year (clip) = 2004-07-01" + , "2005-04-21 + -1 * year (clip) = 2004-04-21" + , "2005-06-30 + -1 * year (clip) = 2004-06-30" + , "2005-02-28 + 0 * year (clip) = 2005-02-28" + , "2004-02-29 + 0 * year (clip) = 2004-02-29" + , "2004-01-31 + 0 * year (clip) = 2004-01-31" + , "2004-12-31 + 0 * year (clip) = 2004-12-31" + , "2005-07-01 + 0 * year (clip) = 2005-07-01" + , "2005-04-21 + 0 * year (clip) = 2005-04-21" + , "2005-06-30 + 0 * year (clip) = 2005-06-30" + , "2005-02-28 + 1 * year (clip) = 2006-02-28" + , "2004-02-29 + 1 * year (clip) = 2005-02-28" + , "2004-01-31 + 1 * year (clip) = 2005-01-31" + , "2004-12-31 + 1 * year (clip) = 2005-12-31" + , "2005-07-01 + 1 * year (clip) = 2006-07-01" + , "2005-04-21 + 1 * year (clip) = 2006-04-21" + , "2005-06-30 + 1 * year (clip) = 2006-06-30" + , "2005-02-28 + 7 * year (clip) = 2012-02-28" + , "2004-02-29 + 7 * year (clip) = 2011-02-28" + , "2004-01-31 + 7 * year (clip) = 2011-01-31" + , "2004-12-31 + 7 * year (clip) = 2011-12-31" + , "2005-07-01 + 7 * year (clip) = 2012-07-01" + , "2005-04-21 + 7 * year (clip) = 2012-04-21" + , "2005-06-30 + 7 * year (clip) = 2012-06-30" + , "2005-02-28 + 83 * year (clip) = 2088-02-28" + , "2004-02-29 + 83 * year (clip) = 2087-02-28" + , "2004-01-31 + 83 * year (clip) = 2087-01-31" + , "2004-12-31 + 83 * year (clip) = 2087-12-31" + , "2005-07-01 + 83 * year (clip) = 2088-07-01" + , "2005-04-21 + 83 * year (clip) = 2088-04-21" + , "2005-06-30 + 83 * year (clip) = 2088-06-30" + , "2005-02-28 + -10 * year (roll over) = 1995-02-28" + , "2004-02-29 + -10 * year (roll over) = 1994-03-01" + , "2004-01-31 + -10 * year (roll over) = 1994-01-31" + , "2004-12-31 + -10 * year (roll over) = 1994-12-31" + , "2005-07-01 + -10 * year (roll over) = 1995-07-01" + , "2005-04-21 + -10 * year (roll over) = 1995-04-21" + , "2005-06-30 + -10 * year (roll over) = 1995-06-30" + , "2005-02-28 + -4 * year (roll over) = 2001-02-28" + , "2004-02-29 + -4 * year (roll over) = 2000-02-29" + , "2004-01-31 + -4 * year (roll over) = 2000-01-31" + , "2004-12-31 + -4 * year (roll over) = 2000-12-31" + , "2005-07-01 + -4 * year (roll over) = 2001-07-01" + , "2005-04-21 + -4 * year (roll over) = 2001-04-21" + , "2005-06-30 + -4 * year (roll over) = 2001-06-30" + , "2005-02-28 + -1 * year (roll over) = 2004-02-28" + , "2004-02-29 + -1 * year (roll over) = 2003-03-01" + , "2004-01-31 + -1 * year (roll over) = 2003-01-31" + , "2004-12-31 + -1 * year (roll over) = 2003-12-31" + , "2005-07-01 + -1 * year (roll over) = 2004-07-01" + , "2005-04-21 + -1 * year (roll over) = 2004-04-21" + , "2005-06-30 + -1 * year (roll over) = 2004-06-30" + , "2005-02-28 + 0 * year (roll over) = 2005-02-28" + , "2004-02-29 + 0 * year (roll over) = 2004-02-29" + , "2004-01-31 + 0 * year (roll over) = 2004-01-31" + , "2004-12-31 + 0 * year (roll over) = 2004-12-31" + , "2005-07-01 + 0 * year (roll over) = 2005-07-01" + , "2005-04-21 + 0 * year (roll over) = 2005-04-21" + , "2005-06-30 + 0 * year (roll over) = 2005-06-30" + , "2005-02-28 + 1 * year (roll over) = 2006-02-28" + , "2004-02-29 + 1 * year (roll over) = 2005-03-01" + , "2004-01-31 + 1 * year (roll over) = 2005-01-31" + , "2004-12-31 + 1 * year (roll over) = 2005-12-31" + , "2005-07-01 + 1 * year (roll over) = 2006-07-01" + , "2005-04-21 + 1 * year (roll over) = 2006-04-21" + , "2005-06-30 + 1 * year (roll over) = 2006-06-30" + , "2005-02-28 + 7 * year (roll over) = 2012-02-28" + , "2004-02-29 + 7 * year (roll over) = 2011-03-01" + , "2004-01-31 + 7 * year (roll over) = 2011-01-31" + , "2004-12-31 + 7 * year (roll over) = 2011-12-31" + , "2005-07-01 + 7 * year (roll over) = 2012-07-01" + , "2005-04-21 + 7 * year (roll over) = 2012-04-21" + , "2005-06-30 + 7 * year (roll over) = 2012-06-30" + , "2005-02-28 + 83 * year (roll over) = 2088-02-28" + , "2004-02-29 + 83 * year (roll over) = 2087-03-01" + , "2004-01-31 + 83 * year (roll over) = 2087-01-31" + , "2004-12-31 + 83 * year (roll over) = 2087-12-31" + , "2005-07-01 + 83 * year (roll over) = 2088-07-01" + , "2005-04-21 + 83 * year (roll over) = 2088-04-21" + , "2005-06-30 + 83 * year (roll over) = 2088-06-30" ] diff --git a/test/main/Test/Calendar/Calendars.hs b/test/main/Test/Calendar/Calendars.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/Calendars.hs @@ -0,0 +1,31 @@ +module Test.Calendar.Calendars(testCalendars) where + +import Data.Time.Calendar.Julian +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.CalendarsRef + +showers :: [(String,Day -> String)] +showers = [ + ("MJD",show . toModifiedJulianDay), + ("Gregorian",showGregorian), + ("Julian",showJulian), + ("ISO 8601",showWeekDate) + ] + +days :: [Day] +days = [ + fromGregorian 0 12 31, + fromJulian 1752 9 2, + fromGregorian 1752 9 14, + fromGregorian 2005 1 23 + ] + +testCalendars :: TestTree +testCalendars = testCase "testCalendars" $ + assertEqual "" testCalendarsRef $ unlines $ map (\d -> showShowers d) days + where + showShowers day = + concatMap (\(nm,shower) -> unwords [" ==", nm, shower day]) showers diff --git a/test/main/Test/Calendar/CalendarsRef.hs b/test/main/Test/Calendar/CalendarsRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/CalendarsRef.hs @@ -0,0 +1,9 @@ +module Test.Calendar.CalendarsRef where + +testCalendarsRef :: String +testCalendarsRef = + unlines + [ " == MJD -678576 == Gregorian 0000-12-31 == Julian 0001-01-02 == ISO 8601 0000-W52-7" + , " == MJD -38780 == Gregorian 1752-09-13 == Julian 1752-09-02 == ISO 8601 1752-W37-3" + , " == MJD -38779 == Gregorian 1752-09-14 == Julian 1752-09-03 == ISO 8601 1752-W37-4" + , " == MJD 53393 == Gregorian 2005-01-23 == Julian 2005-01-10 == ISO 8601 2005-W03-7" ] diff --git a/test/main/Test/Calendar/ClipDates.hs b/test/main/Test/Calendar/ClipDates.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/ClipDates.hs @@ -0,0 +1,47 @@ +{-# Language TupleSections #-} + +module Test.Calendar.ClipDates(clipDates) where + +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.ClipDatesRef + +yearAndDay :: (Integer,Int) -> String +yearAndDay (y,d) = (show y) ++ "-" ++ (show d) ++ " = " ++ (showOrdinalDate (fromOrdinalDate y d)) + +gregorian :: (Integer,Int,Int) -> String +gregorian (y,m,d) = (show y) ++ "-" ++ (show m) ++ "-" ++ (show d) ++ " = " ++ (showGregorian (fromGregorian y m d)) + +iSOWeekDay :: (Integer,Int,Int) -> String +iSOWeekDay (y,w,d) = (show y) ++ "-W" ++ (show w) ++ "-" ++ (show d) ++ " = " ++ (showWeekDate (fromWeekDate y w d)) + +-- + +tupleUp2 :: [a] -> [b] -> [(a, b)] +tupleUp2 l1 l2 = concatMap (\e -> map (e,) l2) l1 + +tupleUp3 :: [a] -> [b] -> [c] -> [(a, b, c)] +tupleUp3 l1 l2 l3 + = let ts = tupleUp2 l2 l3 + in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1 + +-- + +clipDates :: TestTree +clipDates = testCase "clipDates" $ + let + yad = unlines $ map yearAndDay $ + tupleUp2 [1968,1969,1971] [-4,0,1,200,364,365,366,367,700] + + + greg = unlines $ map gregorian $ + tupleUp3 [1968,1969,1971] [-20,-1,0,1,2,12,13,17] [-7,-1,0,1,2,27,28,29,30,31,32,40] + + iso = unlines $ map iSOWeekDay $ + tupleUp3 [1968,1969,2004] [-20,-1,0,1,20,51,52,53,54] [-2,-1,0,1,4,6,7,8,9] + + in assertEqual "" clipDatesRef $ + concat [ "YearAndDay\n", yad, "Gregorian\n", greg, "ISOWeekDay\n", iso ] diff --git a/test/main/Test/Calendar/ClipDatesRef.hs b/test/main/Test/Calendar/ClipDatesRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/ClipDatesRef.hs @@ -0,0 +1,566 @@ +module Test.Calendar.ClipDatesRef where + +clipDatesRef :: String +clipDatesRef = + unlines + [ "YearAndDay" + , "1968--4 = 1968-001" + , "1968-0 = 1968-001" + , "1968-1 = 1968-001" + , "1968-200 = 1968-200" + , "1968-364 = 1968-364" + , "1968-365 = 1968-365" + , "1968-366 = 1968-366" + , "1968-367 = 1968-366" + , "1968-700 = 1968-366" + , "1969--4 = 1969-001" + , "1969-0 = 1969-001" + , "1969-1 = 1969-001" + , "1969-200 = 1969-200" + , "1969-364 = 1969-364" + , "1969-365 = 1969-365" + , "1969-366 = 1969-365" + , "1969-367 = 1969-365" + , "1969-700 = 1969-365" + , "1971--4 = 1971-001" + , "1971-0 = 1971-001" + , "1971-1 = 1971-001" + , "1971-200 = 1971-200" + , "1971-364 = 1971-364" + , "1971-365 = 1971-365" + , "1971-366 = 1971-365" + , "1971-367 = 1971-365" + , "1971-700 = 1971-365" + , "Gregorian" + , "1968--20--7 = 1968-01-01" + , "1968--20--1 = 1968-01-01" + , "1968--20-0 = 1968-01-01" + , "1968--20-1 = 1968-01-01" + , "1968--20-2 = 1968-01-02" + , "1968--20-27 = 1968-01-27" + , "1968--20-28 = 1968-01-28" + , "1968--20-29 = 1968-01-29" + , "1968--20-30 = 1968-01-30" + , "1968--20-31 = 1968-01-31" + , "1968--20-32 = 1968-01-31" + , "1968--20-40 = 1968-01-31" + , "1968--1--7 = 1968-01-01" + , "1968--1--1 = 1968-01-01" + , "1968--1-0 = 1968-01-01" + , "1968--1-1 = 1968-01-01" + , "1968--1-2 = 1968-01-02" + , "1968--1-27 = 1968-01-27" + , "1968--1-28 = 1968-01-28" + , "1968--1-29 = 1968-01-29" + , "1968--1-30 = 1968-01-30" + , "1968--1-31 = 1968-01-31" + , "1968--1-32 = 1968-01-31" + , "1968--1-40 = 1968-01-31" + , "1968-0--7 = 1968-01-01" + , "1968-0--1 = 1968-01-01" + , "1968-0-0 = 1968-01-01" + , "1968-0-1 = 1968-01-01" + , "1968-0-2 = 1968-01-02" + , "1968-0-27 = 1968-01-27" + , "1968-0-28 = 1968-01-28" + , "1968-0-29 = 1968-01-29" + , "1968-0-30 = 1968-01-30" + , "1968-0-31 = 1968-01-31" + , "1968-0-32 = 1968-01-31" + , "1968-0-40 = 1968-01-31" + , "1968-1--7 = 1968-01-01" + , "1968-1--1 = 1968-01-01" + , "1968-1-0 = 1968-01-01" + , "1968-1-1 = 1968-01-01" + , "1968-1-2 = 1968-01-02" + , "1968-1-27 = 1968-01-27" + , "1968-1-28 = 1968-01-28" + , "1968-1-29 = 1968-01-29" + , "1968-1-30 = 1968-01-30" + , "1968-1-31 = 1968-01-31" + , "1968-1-32 = 1968-01-31" + , "1968-1-40 = 1968-01-31" + , "1968-2--7 = 1968-02-01" + , "1968-2--1 = 1968-02-01" + , "1968-2-0 = 1968-02-01" + , "1968-2-1 = 1968-02-01" + , "1968-2-2 = 1968-02-02" + , "1968-2-27 = 1968-02-27" + , "1968-2-28 = 1968-02-28" + , "1968-2-29 = 1968-02-29" + , "1968-2-30 = 1968-02-29" + , "1968-2-31 = 1968-02-29" + , "1968-2-32 = 1968-02-29" + , "1968-2-40 = 1968-02-29" + , "1968-12--7 = 1968-12-01" + , "1968-12--1 = 1968-12-01" + , "1968-12-0 = 1968-12-01" + , "1968-12-1 = 1968-12-01" + , "1968-12-2 = 1968-12-02" + , "1968-12-27 = 1968-12-27" + , "1968-12-28 = 1968-12-28" + , "1968-12-29 = 1968-12-29" + , "1968-12-30 = 1968-12-30" + , "1968-12-31 = 1968-12-31" + , "1968-12-32 = 1968-12-31" + , "1968-12-40 = 1968-12-31" + , "1968-13--7 = 1968-12-01" + , "1968-13--1 = 1968-12-01" + , "1968-13-0 = 1968-12-01" + , "1968-13-1 = 1968-12-01" + , "1968-13-2 = 1968-12-02" + , "1968-13-27 = 1968-12-27" + , "1968-13-28 = 1968-12-28" + , "1968-13-29 = 1968-12-29" + , "1968-13-30 = 1968-12-30" + , "1968-13-31 = 1968-12-31" + , "1968-13-32 = 1968-12-31" + , "1968-13-40 = 1968-12-31" + , "1968-17--7 = 1968-12-01" + , "1968-17--1 = 1968-12-01" + , "1968-17-0 = 1968-12-01" + , "1968-17-1 = 1968-12-01" + , "1968-17-2 = 1968-12-02" + , "1968-17-27 = 1968-12-27" + , "1968-17-28 = 1968-12-28" + , "1968-17-29 = 1968-12-29" + , "1968-17-30 = 1968-12-30" + , "1968-17-31 = 1968-12-31" + , "1968-17-32 = 1968-12-31" + , "1968-17-40 = 1968-12-31" + , "1969--20--7 = 1969-01-01" + , "1969--20--1 = 1969-01-01" + , "1969--20-0 = 1969-01-01" + , "1969--20-1 = 1969-01-01" + , "1969--20-2 = 1969-01-02" + , "1969--20-27 = 1969-01-27" + , "1969--20-28 = 1969-01-28" + , "1969--20-29 = 1969-01-29" + , "1969--20-30 = 1969-01-30" + , "1969--20-31 = 1969-01-31" + , "1969--20-32 = 1969-01-31" + , "1969--20-40 = 1969-01-31" + , "1969--1--7 = 1969-01-01" + , "1969--1--1 = 1969-01-01" + , "1969--1-0 = 1969-01-01" + , "1969--1-1 = 1969-01-01" + , "1969--1-2 = 1969-01-02" + , "1969--1-27 = 1969-01-27" + , "1969--1-28 = 1969-01-28" + , "1969--1-29 = 1969-01-29" + , "1969--1-30 = 1969-01-30" + , "1969--1-31 = 1969-01-31" + , "1969--1-32 = 1969-01-31" + , "1969--1-40 = 1969-01-31" + , "1969-0--7 = 1969-01-01" + , "1969-0--1 = 1969-01-01" + , "1969-0-0 = 1969-01-01" + , "1969-0-1 = 1969-01-01" + , "1969-0-2 = 1969-01-02" + , "1969-0-27 = 1969-01-27" + , "1969-0-28 = 1969-01-28" + , "1969-0-29 = 1969-01-29" + , "1969-0-30 = 1969-01-30" + , "1969-0-31 = 1969-01-31" + , "1969-0-32 = 1969-01-31" + , "1969-0-40 = 1969-01-31" + , "1969-1--7 = 1969-01-01" + , "1969-1--1 = 1969-01-01" + , "1969-1-0 = 1969-01-01" + , "1969-1-1 = 1969-01-01" + , "1969-1-2 = 1969-01-02" + , "1969-1-27 = 1969-01-27" + , "1969-1-28 = 1969-01-28" + , "1969-1-29 = 1969-01-29" + , "1969-1-30 = 1969-01-30" + , "1969-1-31 = 1969-01-31" + , "1969-1-32 = 1969-01-31" + , "1969-1-40 = 1969-01-31" + , "1969-2--7 = 1969-02-01" + , "1969-2--1 = 1969-02-01" + , "1969-2-0 = 1969-02-01" + , "1969-2-1 = 1969-02-01" + , "1969-2-2 = 1969-02-02" + , "1969-2-27 = 1969-02-27" + , "1969-2-28 = 1969-02-28" + , "1969-2-29 = 1969-02-28" + , "1969-2-30 = 1969-02-28" + , "1969-2-31 = 1969-02-28" + , "1969-2-32 = 1969-02-28" + , "1969-2-40 = 1969-02-28" + , "1969-12--7 = 1969-12-01" + , "1969-12--1 = 1969-12-01" + , "1969-12-0 = 1969-12-01" + , "1969-12-1 = 1969-12-01" + , "1969-12-2 = 1969-12-02" + , "1969-12-27 = 1969-12-27" + , "1969-12-28 = 1969-12-28" + , "1969-12-29 = 1969-12-29" + , "1969-12-30 = 1969-12-30" + , "1969-12-31 = 1969-12-31" + , "1969-12-32 = 1969-12-31" + , "1969-12-40 = 1969-12-31" + , "1969-13--7 = 1969-12-01" + , "1969-13--1 = 1969-12-01" + , "1969-13-0 = 1969-12-01" + , "1969-13-1 = 1969-12-01" + , "1969-13-2 = 1969-12-02" + , "1969-13-27 = 1969-12-27" + , "1969-13-28 = 1969-12-28" + , "1969-13-29 = 1969-12-29" + , "1969-13-30 = 1969-12-30" + , "1969-13-31 = 1969-12-31" + , "1969-13-32 = 1969-12-31" + , "1969-13-40 = 1969-12-31" + , "1969-17--7 = 1969-12-01" + , "1969-17--1 = 1969-12-01" + , "1969-17-0 = 1969-12-01" + , "1969-17-1 = 1969-12-01" + , "1969-17-2 = 1969-12-02" + , "1969-17-27 = 1969-12-27" + , "1969-17-28 = 1969-12-28" + , "1969-17-29 = 1969-12-29" + , "1969-17-30 = 1969-12-30" + , "1969-17-31 = 1969-12-31" + , "1969-17-32 = 1969-12-31" + , "1969-17-40 = 1969-12-31" + , "1971--20--7 = 1971-01-01" + , "1971--20--1 = 1971-01-01" + , "1971--20-0 = 1971-01-01" + , "1971--20-1 = 1971-01-01" + , "1971--20-2 = 1971-01-02" + , "1971--20-27 = 1971-01-27" + , "1971--20-28 = 1971-01-28" + , "1971--20-29 = 1971-01-29" + , "1971--20-30 = 1971-01-30" + , "1971--20-31 = 1971-01-31" + , "1971--20-32 = 1971-01-31" + , "1971--20-40 = 1971-01-31" + , "1971--1--7 = 1971-01-01" + , "1971--1--1 = 1971-01-01" + , "1971--1-0 = 1971-01-01" + , "1971--1-1 = 1971-01-01" + , "1971--1-2 = 1971-01-02" + , "1971--1-27 = 1971-01-27" + , "1971--1-28 = 1971-01-28" + , "1971--1-29 = 1971-01-29" + , "1971--1-30 = 1971-01-30" + , "1971--1-31 = 1971-01-31" + , "1971--1-32 = 1971-01-31" + , "1971--1-40 = 1971-01-31" + , "1971-0--7 = 1971-01-01" + , "1971-0--1 = 1971-01-01" + , "1971-0-0 = 1971-01-01" + , "1971-0-1 = 1971-01-01" + , "1971-0-2 = 1971-01-02" + , "1971-0-27 = 1971-01-27" + , "1971-0-28 = 1971-01-28" + , "1971-0-29 = 1971-01-29" + , "1971-0-30 = 1971-01-30" + , "1971-0-31 = 1971-01-31" + , "1971-0-32 = 1971-01-31" + , "1971-0-40 = 1971-01-31" + , "1971-1--7 = 1971-01-01" + , "1971-1--1 = 1971-01-01" + , "1971-1-0 = 1971-01-01" + , "1971-1-1 = 1971-01-01" + , "1971-1-2 = 1971-01-02" + , "1971-1-27 = 1971-01-27" + , "1971-1-28 = 1971-01-28" + , "1971-1-29 = 1971-01-29" + , "1971-1-30 = 1971-01-30" + , "1971-1-31 = 1971-01-31" + , "1971-1-32 = 1971-01-31" + , "1971-1-40 = 1971-01-31" + , "1971-2--7 = 1971-02-01" + , "1971-2--1 = 1971-02-01" + , "1971-2-0 = 1971-02-01" + , "1971-2-1 = 1971-02-01" + , "1971-2-2 = 1971-02-02" + , "1971-2-27 = 1971-02-27" + , "1971-2-28 = 1971-02-28" + , "1971-2-29 = 1971-02-28" + , "1971-2-30 = 1971-02-28" + , "1971-2-31 = 1971-02-28" + , "1971-2-32 = 1971-02-28" + , "1971-2-40 = 1971-02-28" + , "1971-12--7 = 1971-12-01" + , "1971-12--1 = 1971-12-01" + , "1971-12-0 = 1971-12-01" + , "1971-12-1 = 1971-12-01" + , "1971-12-2 = 1971-12-02" + , "1971-12-27 = 1971-12-27" + , "1971-12-28 = 1971-12-28" + , "1971-12-29 = 1971-12-29" + , "1971-12-30 = 1971-12-30" + , "1971-12-31 = 1971-12-31" + , "1971-12-32 = 1971-12-31" + , "1971-12-40 = 1971-12-31" + , "1971-13--7 = 1971-12-01" + , "1971-13--1 = 1971-12-01" + , "1971-13-0 = 1971-12-01" + , "1971-13-1 = 1971-12-01" + , "1971-13-2 = 1971-12-02" + , "1971-13-27 = 1971-12-27" + , "1971-13-28 = 1971-12-28" + , "1971-13-29 = 1971-12-29" + , "1971-13-30 = 1971-12-30" + , "1971-13-31 = 1971-12-31" + , "1971-13-32 = 1971-12-31" + , "1971-13-40 = 1971-12-31" + , "1971-17--7 = 1971-12-01" + , "1971-17--1 = 1971-12-01" + , "1971-17-0 = 1971-12-01" + , "1971-17-1 = 1971-12-01" + , "1971-17-2 = 1971-12-02" + , "1971-17-27 = 1971-12-27" + , "1971-17-28 = 1971-12-28" + , "1971-17-29 = 1971-12-29" + , "1971-17-30 = 1971-12-30" + , "1971-17-31 = 1971-12-31" + , "1971-17-32 = 1971-12-31" + , "1971-17-40 = 1971-12-31" + , "ISOWeekDay" + , "1968-W-20--2 = 1968-W01-1" + , "1968-W-20--1 = 1968-W01-1" + , "1968-W-20-0 = 1968-W01-1" + , "1968-W-20-1 = 1968-W01-1" + , "1968-W-20-4 = 1968-W01-4" + , "1968-W-20-6 = 1968-W01-6" + , "1968-W-20-7 = 1968-W01-7" + , "1968-W-20-8 = 1968-W01-7" + , "1968-W-20-9 = 1968-W01-7" + , "1968-W-1--2 = 1968-W01-1" + , "1968-W-1--1 = 1968-W01-1" + , "1968-W-1-0 = 1968-W01-1" + , "1968-W-1-1 = 1968-W01-1" + , "1968-W-1-4 = 1968-W01-4" + , "1968-W-1-6 = 1968-W01-6" + , "1968-W-1-7 = 1968-W01-7" + , "1968-W-1-8 = 1968-W01-7" + , "1968-W-1-9 = 1968-W01-7" + , "1968-W0--2 = 1968-W01-1" + , "1968-W0--1 = 1968-W01-1" + , "1968-W0-0 = 1968-W01-1" + , "1968-W0-1 = 1968-W01-1" + , "1968-W0-4 = 1968-W01-4" + , "1968-W0-6 = 1968-W01-6" + , "1968-W0-7 = 1968-W01-7" + , "1968-W0-8 = 1968-W01-7" + , "1968-W0-9 = 1968-W01-7" + , "1968-W1--2 = 1968-W01-1" + , "1968-W1--1 = 1968-W01-1" + , "1968-W1-0 = 1968-W01-1" + , "1968-W1-1 = 1968-W01-1" + , "1968-W1-4 = 1968-W01-4" + , "1968-W1-6 = 1968-W01-6" + , "1968-W1-7 = 1968-W01-7" + , "1968-W1-8 = 1968-W01-7" + , "1968-W1-9 = 1968-W01-7" + , "1968-W20--2 = 1968-W20-1" + , "1968-W20--1 = 1968-W20-1" + , "1968-W20-0 = 1968-W20-1" + , "1968-W20-1 = 1968-W20-1" + , "1968-W20-4 = 1968-W20-4" + , "1968-W20-6 = 1968-W20-6" + , "1968-W20-7 = 1968-W20-7" + , "1968-W20-8 = 1968-W20-7" + , "1968-W20-9 = 1968-W20-7" + , "1968-W51--2 = 1968-W51-1" + , "1968-W51--1 = 1968-W51-1" + , "1968-W51-0 = 1968-W51-1" + , "1968-W51-1 = 1968-W51-1" + , "1968-W51-4 = 1968-W51-4" + , "1968-W51-6 = 1968-W51-6" + , "1968-W51-7 = 1968-W51-7" + , "1968-W51-8 = 1968-W51-7" + , "1968-W51-9 = 1968-W51-7" + , "1968-W52--2 = 1968-W52-1" + , "1968-W52--1 = 1968-W52-1" + , "1968-W52-0 = 1968-W52-1" + , "1968-W52-1 = 1968-W52-1" + , "1968-W52-4 = 1968-W52-4" + , "1968-W52-6 = 1968-W52-6" + , "1968-W52-7 = 1968-W52-7" + , "1968-W52-8 = 1968-W52-7" + , "1968-W52-9 = 1968-W52-7" + , "1968-W53--2 = 1968-W52-1" + , "1968-W53--1 = 1968-W52-1" + , "1968-W53-0 = 1968-W52-1" + , "1968-W53-1 = 1968-W52-1" + , "1968-W53-4 = 1968-W52-4" + , "1968-W53-6 = 1968-W52-6" + , "1968-W53-7 = 1968-W52-7" + , "1968-W53-8 = 1968-W52-7" + , "1968-W53-9 = 1968-W52-7" + , "1968-W54--2 = 1968-W52-1" + , "1968-W54--1 = 1968-W52-1" + , "1968-W54-0 = 1968-W52-1" + , "1968-W54-1 = 1968-W52-1" + , "1968-W54-4 = 1968-W52-4" + , "1968-W54-6 = 1968-W52-6" + , "1968-W54-7 = 1968-W52-7" + , "1968-W54-8 = 1968-W52-7" + , "1968-W54-9 = 1968-W52-7" + , "1969-W-20--2 = 1969-W01-1" + , "1969-W-20--1 = 1969-W01-1" + , "1969-W-20-0 = 1969-W01-1" + , "1969-W-20-1 = 1969-W01-1" + , "1969-W-20-4 = 1969-W01-4" + , "1969-W-20-6 = 1969-W01-6" + , "1969-W-20-7 = 1969-W01-7" + , "1969-W-20-8 = 1969-W01-7" + , "1969-W-20-9 = 1969-W01-7" + , "1969-W-1--2 = 1969-W01-1" + , "1969-W-1--1 = 1969-W01-1" + , "1969-W-1-0 = 1969-W01-1" + , "1969-W-1-1 = 1969-W01-1" + , "1969-W-1-4 = 1969-W01-4" + , "1969-W-1-6 = 1969-W01-6" + , "1969-W-1-7 = 1969-W01-7" + , "1969-W-1-8 = 1969-W01-7" + , "1969-W-1-9 = 1969-W01-7" + , "1969-W0--2 = 1969-W01-1" + , "1969-W0--1 = 1969-W01-1" + , "1969-W0-0 = 1969-W01-1" + , "1969-W0-1 = 1969-W01-1" + , "1969-W0-4 = 1969-W01-4" + , "1969-W0-6 = 1969-W01-6" + , "1969-W0-7 = 1969-W01-7" + , "1969-W0-8 = 1969-W01-7" + , "1969-W0-9 = 1969-W01-7" + , "1969-W1--2 = 1969-W01-1" + , "1969-W1--1 = 1969-W01-1" + , "1969-W1-0 = 1969-W01-1" + , "1969-W1-1 = 1969-W01-1" + , "1969-W1-4 = 1969-W01-4" + , "1969-W1-6 = 1969-W01-6" + , "1969-W1-7 = 1969-W01-7" + , "1969-W1-8 = 1969-W01-7" + , "1969-W1-9 = 1969-W01-7" + , "1969-W20--2 = 1969-W20-1" + , "1969-W20--1 = 1969-W20-1" + , "1969-W20-0 = 1969-W20-1" + , "1969-W20-1 = 1969-W20-1" + , "1969-W20-4 = 1969-W20-4" + , "1969-W20-6 = 1969-W20-6" + , "1969-W20-7 = 1969-W20-7" + , "1969-W20-8 = 1969-W20-7" + , "1969-W20-9 = 1969-W20-7" + , "1969-W51--2 = 1969-W51-1" + , "1969-W51--1 = 1969-W51-1" + , "1969-W51-0 = 1969-W51-1" + , "1969-W51-1 = 1969-W51-1" + , "1969-W51-4 = 1969-W51-4" + , "1969-W51-6 = 1969-W51-6" + , "1969-W51-7 = 1969-W51-7" + , "1969-W51-8 = 1969-W51-7" + , "1969-W51-9 = 1969-W51-7" + , "1969-W52--2 = 1969-W52-1" + , "1969-W52--1 = 1969-W52-1" + , "1969-W52-0 = 1969-W52-1" + , "1969-W52-1 = 1969-W52-1" + , "1969-W52-4 = 1969-W52-4" + , "1969-W52-6 = 1969-W52-6" + , "1969-W52-7 = 1969-W52-7" + , "1969-W52-8 = 1969-W52-7" + , "1969-W52-9 = 1969-W52-7" + , "1969-W53--2 = 1969-W52-1" + , "1969-W53--1 = 1969-W52-1" + , "1969-W53-0 = 1969-W52-1" + , "1969-W53-1 = 1969-W52-1" + , "1969-W53-4 = 1969-W52-4" + , "1969-W53-6 = 1969-W52-6" + , "1969-W53-7 = 1969-W52-7" + , "1969-W53-8 = 1969-W52-7" + , "1969-W53-9 = 1969-W52-7" + , "1969-W54--2 = 1969-W52-1" + , "1969-W54--1 = 1969-W52-1" + , "1969-W54-0 = 1969-W52-1" + , "1969-W54-1 = 1969-W52-1" + , "1969-W54-4 = 1969-W52-4" + , "1969-W54-6 = 1969-W52-6" + , "1969-W54-7 = 1969-W52-7" + , "1969-W54-8 = 1969-W52-7" + , "1969-W54-9 = 1969-W52-7" + , "2004-W-20--2 = 2004-W01-1" + , "2004-W-20--1 = 2004-W01-1" + , "2004-W-20-0 = 2004-W01-1" + , "2004-W-20-1 = 2004-W01-1" + , "2004-W-20-4 = 2004-W01-4" + , "2004-W-20-6 = 2004-W01-6" + , "2004-W-20-7 = 2004-W01-7" + , "2004-W-20-8 = 2004-W01-7" + , "2004-W-20-9 = 2004-W01-7" + , "2004-W-1--2 = 2004-W01-1" + , "2004-W-1--1 = 2004-W01-1" + , "2004-W-1-0 = 2004-W01-1" + , "2004-W-1-1 = 2004-W01-1" + , "2004-W-1-4 = 2004-W01-4" + , "2004-W-1-6 = 2004-W01-6" + , "2004-W-1-7 = 2004-W01-7" + , "2004-W-1-8 = 2004-W01-7" + , "2004-W-1-9 = 2004-W01-7" + , "2004-W0--2 = 2004-W01-1" + , "2004-W0--1 = 2004-W01-1" + , "2004-W0-0 = 2004-W01-1" + , "2004-W0-1 = 2004-W01-1" + , "2004-W0-4 = 2004-W01-4" + , "2004-W0-6 = 2004-W01-6" + , "2004-W0-7 = 2004-W01-7" + , "2004-W0-8 = 2004-W01-7" + , "2004-W0-9 = 2004-W01-7" + , "2004-W1--2 = 2004-W01-1" + , "2004-W1--1 = 2004-W01-1" + , "2004-W1-0 = 2004-W01-1" + , "2004-W1-1 = 2004-W01-1" + , "2004-W1-4 = 2004-W01-4" + , "2004-W1-6 = 2004-W01-6" + , "2004-W1-7 = 2004-W01-7" + , "2004-W1-8 = 2004-W01-7" + , "2004-W1-9 = 2004-W01-7" + , "2004-W20--2 = 2004-W20-1" + , "2004-W20--1 = 2004-W20-1" + , "2004-W20-0 = 2004-W20-1" + , "2004-W20-1 = 2004-W20-1" + , "2004-W20-4 = 2004-W20-4" + , "2004-W20-6 = 2004-W20-6" + , "2004-W20-7 = 2004-W20-7" + , "2004-W20-8 = 2004-W20-7" + , "2004-W20-9 = 2004-W20-7" + , "2004-W51--2 = 2004-W51-1" + , "2004-W51--1 = 2004-W51-1" + , "2004-W51-0 = 2004-W51-1" + , "2004-W51-1 = 2004-W51-1" + , "2004-W51-4 = 2004-W51-4" + , "2004-W51-6 = 2004-W51-6" + , "2004-W51-7 = 2004-W51-7" + , "2004-W51-8 = 2004-W51-7" + , "2004-W51-9 = 2004-W51-7" + , "2004-W52--2 = 2004-W52-1" + , "2004-W52--1 = 2004-W52-1" + , "2004-W52-0 = 2004-W52-1" + , "2004-W52-1 = 2004-W52-1" + , "2004-W52-4 = 2004-W52-4" + , "2004-W52-6 = 2004-W52-6" + , "2004-W52-7 = 2004-W52-7" + , "2004-W52-8 = 2004-W52-7" + , "2004-W52-9 = 2004-W52-7" + , "2004-W53--2 = 2004-W53-1" + , "2004-W53--1 = 2004-W53-1" + , "2004-W53-0 = 2004-W53-1" + , "2004-W53-1 = 2004-W53-1" + , "2004-W53-4 = 2004-W53-4" + , "2004-W53-6 = 2004-W53-6" + , "2004-W53-7 = 2004-W53-7" + , "2004-W53-8 = 2004-W53-7" + , "2004-W53-9 = 2004-W53-7" + , "2004-W54--2 = 2004-W53-1" + , "2004-W54--1 = 2004-W53-1" + , "2004-W54-0 = 2004-W53-1" + , "2004-W54-1 = 2004-W53-1" + , "2004-W54-4 = 2004-W53-4" + , "2004-W54-6 = 2004-W53-6" + , "2004-W54-7 = 2004-W53-7" + , "2004-W54-8 = 2004-W53-7" + , "2004-W54-9 = 2004-W53-7" ] diff --git a/test/main/Test/Calendar/ConvertBack.hs b/test/main/Test/Calendar/ConvertBack.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/ConvertBack.hs @@ -0,0 +1,41 @@ +module Test.Calendar.ConvertBack(convertBack) where + +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.Julian +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar +import Test.Tasty +import Test.Tasty.HUnit + +checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String +checkDay encodeDay decodeDay decodeDayValid day = let + st = encodeDay day + day' = decodeDay st + mday' = decodeDayValid st + + a = if day /= day' + then unwords [ show day, "-> " + , show st, "-> " + , show day' + , "(diff", show (diffDays day' day) ++ ")" ] + else "" + + b = if Just day /= mday' + then unwords [show day, "->", show st, "->", show mday'] + else "" + in a ++ b + +checkers :: [Day -> String] +checkers + = [ checkDay toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d) + , checkDay toWeekDate (\(y,w,d) -> fromWeekDate y w d) (\(y,w,d) -> fromWeekDateValid y w d) + , checkDay toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d) + , checkDay toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d) ] + +days :: [Day] +days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++ + (fmap (\year -> (fromGregorian year 1 4)) [1980..2000]) + +convertBack :: TestTree +convertBack = testCase "convertBack" $ + assertEqual "" "" $ concatMap (\ch -> concatMap ch days) checkers diff --git a/test/main/Test/Calendar/Easter.hs b/test/main/Test/Calendar/Easter.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/Easter.hs @@ -0,0 +1,37 @@ +{-# OPTIONS -Wall -Werror #-} + +module Test.Calendar.Easter(testEaster) where + +import Data.Time.Calendar.Easter +import Data.Time.Calendar +import Data.Time.Format + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.EasterRef + +-- + +days :: [Day] +days = [ModifiedJulianDay 53000 .. ModifiedJulianDay 53014] + +showWithWDay :: Day -> String +showWithWDay = formatTime defaultTimeLocale "%F %A" + +testEaster :: TestTree +testEaster = testCase "testEaster" $ let + ds = unlines $ map (\day -> + unwords [ showWithWDay day, "->" + , showWithWDay (sundayAfter day)]) days + + f y = unwords [ show y ++ ", Gregorian: moon," + , show (gregorianPaschalMoon y) ++ ": Easter," + , showWithWDay (gregorianEaster y)] + ++ "\n" + + g y = unwords [ show y ++ ", Orthodox : moon," + , show (orthodoxPaschalMoon y) ++ ": Easter," + , showWithWDay (orthodoxEaster y)] + ++ "\n" + + in assertEqual "" testEasterRef $ ds ++ concatMap (\y -> f y ++ g y) [2000..2020] diff --git a/test/main/Test/Calendar/EasterRef.hs b/test/main/Test/Calendar/EasterRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/EasterRef.hs @@ -0,0 +1,62 @@ +module Test.Calendar.EasterRef where + +testEasterRef :: String +testEasterRef = + unlines + [ "2003-12-27 Saturday -> 2003-12-28 Sunday" + , "2003-12-28 Sunday -> 2004-01-04 Sunday" + , "2003-12-29 Monday -> 2004-01-04 Sunday" + , "2003-12-30 Tuesday -> 2004-01-04 Sunday" + , "2003-12-31 Wednesday -> 2004-01-04 Sunday" + , "2004-01-01 Thursday -> 2004-01-04 Sunday" + , "2004-01-02 Friday -> 2004-01-04 Sunday" + , "2004-01-03 Saturday -> 2004-01-04 Sunday" + , "2004-01-04 Sunday -> 2004-01-11 Sunday" + , "2004-01-05 Monday -> 2004-01-11 Sunday" + , "2004-01-06 Tuesday -> 2004-01-11 Sunday" + , "2004-01-07 Wednesday -> 2004-01-11 Sunday" + , "2004-01-08 Thursday -> 2004-01-11 Sunday" + , "2004-01-09 Friday -> 2004-01-11 Sunday" + , "2004-01-10 Saturday -> 2004-01-11 Sunday" + , "2000, Gregorian: moon, 2000-04-18: Easter, 2000-04-23 Sunday" + , "2000, Orthodox : moon, 2000-04-23: Easter, 2000-04-30 Sunday" + , "2001, Gregorian: moon, 2001-04-08: Easter, 2001-04-15 Sunday" + , "2001, Orthodox : moon, 2001-04-12: Easter, 2001-04-15 Sunday" + , "2002, Gregorian: moon, 2002-03-28: Easter, 2002-03-31 Sunday" + , "2002, Orthodox : moon, 2002-05-01: Easter, 2002-05-05 Sunday" + , "2003, Gregorian: moon, 2003-04-16: Easter, 2003-04-20 Sunday" + , "2003, Orthodox : moon, 2003-04-20: Easter, 2003-04-27 Sunday" + , "2004, Gregorian: moon, 2004-04-05: Easter, 2004-04-11 Sunday" + , "2004, Orthodox : moon, 2004-04-09: Easter, 2004-04-11 Sunday" + , "2005, Gregorian: moon, 2005-03-25: Easter, 2005-03-27 Sunday" + , "2005, Orthodox : moon, 2005-04-28: Easter, 2005-05-01 Sunday" + , "2006, Gregorian: moon, 2006-04-13: Easter, 2006-04-16 Sunday" + , "2006, Orthodox : moon, 2006-04-17: Easter, 2006-04-23 Sunday" + , "2007, Gregorian: moon, 2007-04-02: Easter, 2007-04-08 Sunday" + , "2007, Orthodox : moon, 2007-04-06: Easter, 2007-04-08 Sunday" + , "2008, Gregorian: moon, 2008-03-22: Easter, 2008-03-23 Sunday" + , "2008, Orthodox : moon, 2008-04-25: Easter, 2008-04-27 Sunday" + , "2009, Gregorian: moon, 2009-04-10: Easter, 2009-04-12 Sunday" + , "2009, Orthodox : moon, 2009-04-14: Easter, 2009-04-19 Sunday" + , "2010, Gregorian: moon, 2010-03-30: Easter, 2010-04-04 Sunday" + , "2010, Orthodox : moon, 2010-04-03: Easter, 2010-04-04 Sunday" + , "2011, Gregorian: moon, 2011-04-18: Easter, 2011-04-24 Sunday" + , "2011, Orthodox : moon, 2011-04-22: Easter, 2011-04-24 Sunday" + , "2012, Gregorian: moon, 2012-04-07: Easter, 2012-04-08 Sunday" + , "2012, Orthodox : moon, 2012-04-11: Easter, 2012-04-15 Sunday" + , "2013, Gregorian: moon, 2013-03-27: Easter, 2013-03-31 Sunday" + , "2013, Orthodox : moon, 2013-04-30: Easter, 2013-05-05 Sunday" + , "2014, Gregorian: moon, 2014-04-14: Easter, 2014-04-20 Sunday" + , "2014, Orthodox : moon, 2014-04-18: Easter, 2014-04-20 Sunday" + , "2015, Gregorian: moon, 2015-04-03: Easter, 2015-04-05 Sunday" + , "2015, Orthodox : moon, 2015-04-07: Easter, 2015-04-12 Sunday" + , "2016, Gregorian: moon, 2016-03-23: Easter, 2016-03-27 Sunday" + , "2016, Orthodox : moon, 2016-04-26: Easter, 2016-05-01 Sunday" + , "2017, Gregorian: moon, 2017-04-11: Easter, 2017-04-16 Sunday" + , "2017, Orthodox : moon, 2017-04-15: Easter, 2017-04-16 Sunday" + , "2018, Gregorian: moon, 2018-03-31: Easter, 2018-04-01 Sunday" + , "2018, Orthodox : moon, 2018-04-04: Easter, 2018-04-08 Sunday" + , "2019, Gregorian: moon, 2019-04-18: Easter, 2019-04-21 Sunday" + , "2019, Orthodox : moon, 2019-04-23: Easter, 2019-04-28 Sunday" + , "2020, Gregorian: moon, 2020-04-08: Easter, 2020-04-12 Sunday" + , "2020, Orthodox : moon, 2020-04-12: Easter, 2020-04-19 Sunday" ] diff --git a/test/main/Test/Calendar/LongWeekYears.hs b/test/main/Test/Calendar/LongWeekYears.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/LongWeekYears.hs @@ -0,0 +1,21 @@ +module Test.Calendar.LongWeekYears(longWeekYears) where + +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.LongWeekYearsRef + +longYear :: Integer -> Bool +longYear year = case toWeekDate (fromGregorian year 12 31) of + (_,53,_) -> True + _ -> False + +showLongYear :: Integer -> String +showLongYear year + = unwords [ show year ++ ":" + , (if isLeapYear year then "L" else " ") ++ (if longYear year then "*" else " ") ] + +longWeekYears :: TestTree +longWeekYears = testCase "longWeekYears" $ + assertEqual "" longWeekYearsRef $ unlines $ map showLongYear [1901 .. 2050] diff --git a/test/main/Test/Calendar/LongWeekYearsRef.hs b/test/main/Test/Calendar/LongWeekYearsRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/LongWeekYearsRef.hs @@ -0,0 +1,155 @@ +module Test.Calendar.LongWeekYearsRef where + +longWeekYearsRef :: String +longWeekYearsRef = + unlines + [ "1901: " + , "1902: " + , "1903: *" + , "1904: L " + , "1905: " + , "1906: " + , "1907: " + , "1908: L*" + , "1909: " + , "1910: " + , "1911: " + , "1912: L " + , "1913: " + , "1914: *" + , "1915: " + , "1916: L " + , "1917: " + , "1918: " + , "1919: " + , "1920: L*" + , "1921: " + , "1922: " + , "1923: " + , "1924: L " + , "1925: *" + , "1926: " + , "1927: " + , "1928: L " + , "1929: " + , "1930: " + , "1931: *" + , "1932: L " + , "1933: " + , "1934: " + , "1935: " + , "1936: L*" + , "1937: " + , "1938: " + , "1939: " + , "1940: L " + , "1941: " + , "1942: *" + , "1943: " + , "1944: L " + , "1945: " + , "1946: " + , "1947: " + , "1948: L*" + , "1949: " + , "1950: " + , "1951: " + , "1952: L " + , "1953: *" + , "1954: " + , "1955: " + , "1956: L " + , "1957: " + , "1958: " + , "1959: *" + , "1960: L " + , "1961: " + , "1962: " + , "1963: " + , "1964: L*" + , "1965: " + , "1966: " + , "1967: " + , "1968: L " + , "1969: " + , "1970: *" + , "1971: " + , "1972: L " + , "1973: " + , "1974: " + , "1975: " + , "1976: L*" + , "1977: " + , "1978: " + , "1979: " + , "1980: L " + , "1981: *" + , "1982: " + , "1983: " + , "1984: L " + , "1985: " + , "1986: " + , "1987: *" + , "1988: L " + , "1989: " + , "1990: " + , "1991: " + , "1992: L*" + , "1993: " + , "1994: " + , "1995: " + , "1996: L " + , "1997: " + , "1998: *" + , "1999: " + , "2000: L " + , "2001: " + , "2002: " + , "2003: " + , "2004: L*" + , "2005: " + , "2006: " + , "2007: " + , "2008: L " + , "2009: *" + , "2010: " + , "2011: " + , "2012: L " + , "2013: " + , "2014: " + , "2015: *" + , "2016: L " + , "2017: " + , "2018: " + , "2019: " + , "2020: L*" + , "2021: " + , "2022: " + , "2023: " + , "2024: L " + , "2025: " + , "2026: *" + , "2027: " + , "2028: L " + , "2029: " + , "2030: " + , "2031: " + , "2032: L*" + , "2033: " + , "2034: " + , "2035: " + , "2036: L " + , "2037: *" + , "2038: " + , "2039: " + , "2040: L " + , "2041: " + , "2042: " + , "2043: *" + , "2044: L " + , "2045: " + , "2046: " + , "2047: " + , "2048: L*" + , "2049: " + , "2050: " ] diff --git a/test/main/Test/Calendar/MonthDay.hs b/test/main/Test/Calendar/MonthDay.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/MonthDay.hs @@ -0,0 +1,23 @@ +module Test.Calendar.MonthDay(testMonthDay) where + +import Data.Time.Calendar.MonthDay +import Test.Tasty +import Test.Tasty.HUnit +import Test.Calendar.MonthDayRef + +showCompare :: (Eq a,Show a) => a -> String -> a -> String +showCompare a1 b a2 | a1 == a2 = (show a1) ++ " == " ++ b +showCompare a1 b a2 = "DIFF: " ++ (show a1) ++ " -> " ++ b ++ " -> " ++ (show a2) + +testMonthDay :: TestTree +testMonthDay = testCase "testMonthDay" $ + assertEqual "" testMonthDayRef $ concat $ map (\isL -> unlines (leap isL : yearDays isL)) [False,True] + where + leap isLeap = if isLeap then "Leap:" else "Regular:" + yearDays isLeap = + map (\yd -> let + (m,d) = dayOfYearToMonthAndDay isLeap yd + yd' = monthAndDayToDayOfYear isLeap m d + mdtext = show m ++ "-" ++ show d + in showCompare yd mdtext yd') + [-2..369] diff --git a/test/main/Test/Calendar/MonthDayRef.hs b/test/main/Test/Calendar/MonthDayRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/MonthDayRef.hs @@ -0,0 +1,751 @@ +module Test.Calendar.MonthDayRef where + +testMonthDayRef :: String +testMonthDayRef = + unlines + [ "Regular:" + , "DIFF: -2 -> 1-1 -> 1" + , "DIFF: -1 -> 1-1 -> 1" + , "DIFF: 0 -> 1-1 -> 1" + , "1 == 1-1" + , "2 == 1-2" + , "3 == 1-3" + , "4 == 1-4" + , "5 == 1-5" + , "6 == 1-6" + , "7 == 1-7" + , "8 == 1-8" + , "9 == 1-9" + , "10 == 1-10" + , "11 == 1-11" + , "12 == 1-12" + , "13 == 1-13" + , "14 == 1-14" + , "15 == 1-15" + , "16 == 1-16" + , "17 == 1-17" + , "18 == 1-18" + , "19 == 1-19" + , "20 == 1-20" + , "21 == 1-21" + , "22 == 1-22" + , "23 == 1-23" + , "24 == 1-24" + , "25 == 1-25" + , "26 == 1-26" + , "27 == 1-27" + , "28 == 1-28" + , "29 == 1-29" + , "30 == 1-30" + , "31 == 1-31" + , "32 == 2-1" + , "33 == 2-2" + , "34 == 2-3" + , "35 == 2-4" + , "36 == 2-5" + , "37 == 2-6" + , "38 == 2-7" + , "39 == 2-8" + , "40 == 2-9" + , "41 == 2-10" + , "42 == 2-11" + , "43 == 2-12" + , "44 == 2-13" + , "45 == 2-14" + , "46 == 2-15" + , "47 == 2-16" + , "48 == 2-17" + , "49 == 2-18" + , "50 == 2-19" + , "51 == 2-20" + , "52 == 2-21" + , "53 == 2-22" + , "54 == 2-23" + , "55 == 2-24" + , "56 == 2-25" + , "57 == 2-26" + , "58 == 2-27" + , "59 == 2-28" + , "60 == 3-1" + , "61 == 3-2" + , "62 == 3-3" + , "63 == 3-4" + , "64 == 3-5" + , "65 == 3-6" + , "66 == 3-7" + , "67 == 3-8" + , "68 == 3-9" + , "69 == 3-10" + , "70 == 3-11" + , "71 == 3-12" + , "72 == 3-13" + , "73 == 3-14" + , "74 == 3-15" + , "75 == 3-16" + , "76 == 3-17" + , "77 == 3-18" + , "78 == 3-19" + , "79 == 3-20" + , "80 == 3-21" + , "81 == 3-22" + , "82 == 3-23" + , "83 == 3-24" + , "84 == 3-25" + , "85 == 3-26" + , "86 == 3-27" + , "87 == 3-28" + , "88 == 3-29" + , "89 == 3-30" + , "90 == 3-31" + , "91 == 4-1" + , "92 == 4-2" + , "93 == 4-3" + , "94 == 4-4" + , "95 == 4-5" + , "96 == 4-6" + , "97 == 4-7" + , "98 == 4-8" + , "99 == 4-9" + , "100 == 4-10" + , "101 == 4-11" + , "102 == 4-12" + , "103 == 4-13" + , "104 == 4-14" + , "105 == 4-15" + , "106 == 4-16" + , "107 == 4-17" + , "108 == 4-18" + , "109 == 4-19" + , "110 == 4-20" + , "111 == 4-21" + , "112 == 4-22" + , "113 == 4-23" + , "114 == 4-24" + , "115 == 4-25" + , "116 == 4-26" + , "117 == 4-27" + , "118 == 4-28" + , "119 == 4-29" + , "120 == 4-30" + , "121 == 5-1" + , "122 == 5-2" + , "123 == 5-3" + , "124 == 5-4" + , "125 == 5-5" + , "126 == 5-6" + , "127 == 5-7" + , "128 == 5-8" + , "129 == 5-9" + , "130 == 5-10" + , "131 == 5-11" + , "132 == 5-12" + , "133 == 5-13" + , "134 == 5-14" + , "135 == 5-15" + , "136 == 5-16" + , "137 == 5-17" + , "138 == 5-18" + , "139 == 5-19" + , "140 == 5-20" + , "141 == 5-21" + , "142 == 5-22" + , "143 == 5-23" + , "144 == 5-24" + , "145 == 5-25" + , "146 == 5-26" + , "147 == 5-27" + , "148 == 5-28" + , "149 == 5-29" + , "150 == 5-30" + , "151 == 5-31" + , "152 == 6-1" + , "153 == 6-2" + , "154 == 6-3" + , "155 == 6-4" + , "156 == 6-5" + , "157 == 6-6" + , "158 == 6-7" + , "159 == 6-8" + , "160 == 6-9" + , "161 == 6-10" + , "162 == 6-11" + , "163 == 6-12" + , "164 == 6-13" + , "165 == 6-14" + , "166 == 6-15" + , "167 == 6-16" + , "168 == 6-17" + , "169 == 6-18" + , "170 == 6-19" + , "171 == 6-20" + , "172 == 6-21" + , "173 == 6-22" + , "174 == 6-23" + , "175 == 6-24" + , "176 == 6-25" + , "177 == 6-26" + , "178 == 6-27" + , "179 == 6-28" + , "180 == 6-29" + , "181 == 6-30" + , "182 == 7-1" + , "183 == 7-2" + , "184 == 7-3" + , "185 == 7-4" + , "186 == 7-5" + , "187 == 7-6" + , "188 == 7-7" + , "189 == 7-8" + , "190 == 7-9" + , "191 == 7-10" + , "192 == 7-11" + , "193 == 7-12" + , "194 == 7-13" + , "195 == 7-14" + , "196 == 7-15" + , "197 == 7-16" + , "198 == 7-17" + , "199 == 7-18" + , "200 == 7-19" + , "201 == 7-20" + , "202 == 7-21" + , "203 == 7-22" + , "204 == 7-23" + , "205 == 7-24" + , "206 == 7-25" + , "207 == 7-26" + , "208 == 7-27" + , "209 == 7-28" + , "210 == 7-29" + , "211 == 7-30" + , "212 == 7-31" + , "213 == 8-1" + , "214 == 8-2" + , "215 == 8-3" + , "216 == 8-4" + , "217 == 8-5" + , "218 == 8-6" + , "219 == 8-7" + , "220 == 8-8" + , "221 == 8-9" + , "222 == 8-10" + , "223 == 8-11" + , "224 == 8-12" + , "225 == 8-13" + , "226 == 8-14" + , "227 == 8-15" + , "228 == 8-16" + , "229 == 8-17" + , "230 == 8-18" + , "231 == 8-19" + , "232 == 8-20" + , "233 == 8-21" + , "234 == 8-22" + , "235 == 8-23" + , "236 == 8-24" + , "237 == 8-25" + , "238 == 8-26" + , "239 == 8-27" + , "240 == 8-28" + , "241 == 8-29" + , "242 == 8-30" + , "243 == 8-31" + , "244 == 9-1" + , "245 == 9-2" + , "246 == 9-3" + , "247 == 9-4" + , "248 == 9-5" + , "249 == 9-6" + , "250 == 9-7" + , "251 == 9-8" + , "252 == 9-9" + , "253 == 9-10" + , "254 == 9-11" + , "255 == 9-12" + , "256 == 9-13" + , "257 == 9-14" + , "258 == 9-15" + , "259 == 9-16" + , "260 == 9-17" + , "261 == 9-18" + , "262 == 9-19" + , "263 == 9-20" + , "264 == 9-21" + , "265 == 9-22" + , "266 == 9-23" + , "267 == 9-24" + , "268 == 9-25" + , "269 == 9-26" + , "270 == 9-27" + , "271 == 9-28" + , "272 == 9-29" + , "273 == 9-30" + , "274 == 10-1" + , "275 == 10-2" + , "276 == 10-3" + , "277 == 10-4" + , "278 == 10-5" + , "279 == 10-6" + , "280 == 10-7" + , "281 == 10-8" + , "282 == 10-9" + , "283 == 10-10" + , "284 == 10-11" + , "285 == 10-12" + , "286 == 10-13" + , "287 == 10-14" + , "288 == 10-15" + , "289 == 10-16" + , "290 == 10-17" + , "291 == 10-18" + , "292 == 10-19" + , "293 == 10-20" + , "294 == 10-21" + , "295 == 10-22" + , "296 == 10-23" + , "297 == 10-24" + , "298 == 10-25" + , "299 == 10-26" + , "300 == 10-27" + , "301 == 10-28" + , "302 == 10-29" + , "303 == 10-30" + , "304 == 10-31" + , "305 == 11-1" + , "306 == 11-2" + , "307 == 11-3" + , "308 == 11-4" + , "309 == 11-5" + , "310 == 11-6" + , "311 == 11-7" + , "312 == 11-8" + , "313 == 11-9" + , "314 == 11-10" + , "315 == 11-11" + , "316 == 11-12" + , "317 == 11-13" + , "318 == 11-14" + , "319 == 11-15" + , "320 == 11-16" + , "321 == 11-17" + , "322 == 11-18" + , "323 == 11-19" + , "324 == 11-20" + , "325 == 11-21" + , "326 == 11-22" + , "327 == 11-23" + , "328 == 11-24" + , "329 == 11-25" + , "330 == 11-26" + , "331 == 11-27" + , "332 == 11-28" + , "333 == 11-29" + , "334 == 11-30" + , "335 == 12-1" + , "336 == 12-2" + , "337 == 12-3" + , "338 == 12-4" + , "339 == 12-5" + , "340 == 12-6" + , "341 == 12-7" + , "342 == 12-8" + , "343 == 12-9" + , "344 == 12-10" + , "345 == 12-11" + , "346 == 12-12" + , "347 == 12-13" + , "348 == 12-14" + , "349 == 12-15" + , "350 == 12-16" + , "351 == 12-17" + , "352 == 12-18" + , "353 == 12-19" + , "354 == 12-20" + , "355 == 12-21" + , "356 == 12-22" + , "357 == 12-23" + , "358 == 12-24" + , "359 == 12-25" + , "360 == 12-26" + , "361 == 12-27" + , "362 == 12-28" + , "363 == 12-29" + , "364 == 12-30" + , "365 == 12-31" + , "DIFF: 366 -> 12-31 -> 365" + , "DIFF: 367 -> 12-31 -> 365" + , "DIFF: 368 -> 12-31 -> 365" + , "DIFF: 369 -> 12-31 -> 365" + , "Leap:" + , "DIFF: -2 -> 1-1 -> 1" + , "DIFF: -1 -> 1-1 -> 1" + , "DIFF: 0 -> 1-1 -> 1" + , "1 == 1-1" + , "2 == 1-2" + , "3 == 1-3" + , "4 == 1-4" + , "5 == 1-5" + , "6 == 1-6" + , "7 == 1-7" + , "8 == 1-8" + , "9 == 1-9" + , "10 == 1-10" + , "11 == 1-11" + , "12 == 1-12" + , "13 == 1-13" + , "14 == 1-14" + , "15 == 1-15" + , "16 == 1-16" + , "17 == 1-17" + , "18 == 1-18" + , "19 == 1-19" + , "20 == 1-20" + , "21 == 1-21" + , "22 == 1-22" + , "23 == 1-23" + , "24 == 1-24" + , "25 == 1-25" + , "26 == 1-26" + , "27 == 1-27" + , "28 == 1-28" + , "29 == 1-29" + , "30 == 1-30" + , "31 == 1-31" + , "32 == 2-1" + , "33 == 2-2" + , "34 == 2-3" + , "35 == 2-4" + , "36 == 2-5" + , "37 == 2-6" + , "38 == 2-7" + , "39 == 2-8" + , "40 == 2-9" + , "41 == 2-10" + , "42 == 2-11" + , "43 == 2-12" + , "44 == 2-13" + , "45 == 2-14" + , "46 == 2-15" + , "47 == 2-16" + , "48 == 2-17" + , "49 == 2-18" + , "50 == 2-19" + , "51 == 2-20" + , "52 == 2-21" + , "53 == 2-22" + , "54 == 2-23" + , "55 == 2-24" + , "56 == 2-25" + , "57 == 2-26" + , "58 == 2-27" + , "59 == 2-28" + , "60 == 2-29" + , "61 == 3-1" + , "62 == 3-2" + , "63 == 3-3" + , "64 == 3-4" + , "65 == 3-5" + , "66 == 3-6" + , "67 == 3-7" + , "68 == 3-8" + , "69 == 3-9" + , "70 == 3-10" + , "71 == 3-11" + , "72 == 3-12" + , "73 == 3-13" + , "74 == 3-14" + , "75 == 3-15" + , "76 == 3-16" + , "77 == 3-17" + , "78 == 3-18" + , "79 == 3-19" + , "80 == 3-20" + , "81 == 3-21" + , "82 == 3-22" + , "83 == 3-23" + , "84 == 3-24" + , "85 == 3-25" + , "86 == 3-26" + , "87 == 3-27" + , "88 == 3-28" + , "89 == 3-29" + , "90 == 3-30" + , "91 == 3-31" + , "92 == 4-1" + , "93 == 4-2" + , "94 == 4-3" + , "95 == 4-4" + , "96 == 4-5" + , "97 == 4-6" + , "98 == 4-7" + , "99 == 4-8" + , "100 == 4-9" + , "101 == 4-10" + , "102 == 4-11" + , "103 == 4-12" + , "104 == 4-13" + , "105 == 4-14" + , "106 == 4-15" + , "107 == 4-16" + , "108 == 4-17" + , "109 == 4-18" + , "110 == 4-19" + , "111 == 4-20" + , "112 == 4-21" + , "113 == 4-22" + , "114 == 4-23" + , "115 == 4-24" + , "116 == 4-25" + , "117 == 4-26" + , "118 == 4-27" + , "119 == 4-28" + , "120 == 4-29" + , "121 == 4-30" + , "122 == 5-1" + , "123 == 5-2" + , "124 == 5-3" + , "125 == 5-4" + , "126 == 5-5" + , "127 == 5-6" + , "128 == 5-7" + , "129 == 5-8" + , "130 == 5-9" + , "131 == 5-10" + , "132 == 5-11" + , "133 == 5-12" + , "134 == 5-13" + , "135 == 5-14" + , "136 == 5-15" + , "137 == 5-16" + , "138 == 5-17" + , "139 == 5-18" + , "140 == 5-19" + , "141 == 5-20" + , "142 == 5-21" + , "143 == 5-22" + , "144 == 5-23" + , "145 == 5-24" + , "146 == 5-25" + , "147 == 5-26" + , "148 == 5-27" + , "149 == 5-28" + , "150 == 5-29" + , "151 == 5-30" + , "152 == 5-31" + , "153 == 6-1" + , "154 == 6-2" + , "155 == 6-3" + , "156 == 6-4" + , "157 == 6-5" + , "158 == 6-6" + , "159 == 6-7" + , "160 == 6-8" + , "161 == 6-9" + , "162 == 6-10" + , "163 == 6-11" + , "164 == 6-12" + , "165 == 6-13" + , "166 == 6-14" + , "167 == 6-15" + , "168 == 6-16" + , "169 == 6-17" + , "170 == 6-18" + , "171 == 6-19" + , "172 == 6-20" + , "173 == 6-21" + , "174 == 6-22" + , "175 == 6-23" + , "176 == 6-24" + , "177 == 6-25" + , "178 == 6-26" + , "179 == 6-27" + , "180 == 6-28" + , "181 == 6-29" + , "182 == 6-30" + , "183 == 7-1" + , "184 == 7-2" + , "185 == 7-3" + , "186 == 7-4" + , "187 == 7-5" + , "188 == 7-6" + , "189 == 7-7" + , "190 == 7-8" + , "191 == 7-9" + , "192 == 7-10" + , "193 == 7-11" + , "194 == 7-12" + , "195 == 7-13" + , "196 == 7-14" + , "197 == 7-15" + , "198 == 7-16" + , "199 == 7-17" + , "200 == 7-18" + , "201 == 7-19" + , "202 == 7-20" + , "203 == 7-21" + , "204 == 7-22" + , "205 == 7-23" + , "206 == 7-24" + , "207 == 7-25" + , "208 == 7-26" + , "209 == 7-27" + , "210 == 7-28" + , "211 == 7-29" + , "212 == 7-30" + , "213 == 7-31" + , "214 == 8-1" + , "215 == 8-2" + , "216 == 8-3" + , "217 == 8-4" + , "218 == 8-5" + , "219 == 8-6" + , "220 == 8-7" + , "221 == 8-8" + , "222 == 8-9" + , "223 == 8-10" + , "224 == 8-11" + , "225 == 8-12" + , "226 == 8-13" + , "227 == 8-14" + , "228 == 8-15" + , "229 == 8-16" + , "230 == 8-17" + , "231 == 8-18" + , "232 == 8-19" + , "233 == 8-20" + , "234 == 8-21" + , "235 == 8-22" + , "236 == 8-23" + , "237 == 8-24" + , "238 == 8-25" + , "239 == 8-26" + , "240 == 8-27" + , "241 == 8-28" + , "242 == 8-29" + , "243 == 8-30" + , "244 == 8-31" + , "245 == 9-1" + , "246 == 9-2" + , "247 == 9-3" + , "248 == 9-4" + , "249 == 9-5" + , "250 == 9-6" + , "251 == 9-7" + , "252 == 9-8" + , "253 == 9-9" + , "254 == 9-10" + , "255 == 9-11" + , "256 == 9-12" + , "257 == 9-13" + , "258 == 9-14" + , "259 == 9-15" + , "260 == 9-16" + , "261 == 9-17" + , "262 == 9-18" + , "263 == 9-19" + , "264 == 9-20" + , "265 == 9-21" + , "266 == 9-22" + , "267 == 9-23" + , "268 == 9-24" + , "269 == 9-25" + , "270 == 9-26" + , "271 == 9-27" + , "272 == 9-28" + , "273 == 9-29" + , "274 == 9-30" + , "275 == 10-1" + , "276 == 10-2" + , "277 == 10-3" + , "278 == 10-4" + , "279 == 10-5" + , "280 == 10-6" + , "281 == 10-7" + , "282 == 10-8" + , "283 == 10-9" + , "284 == 10-10" + , "285 == 10-11" + , "286 == 10-12" + , "287 == 10-13" + , "288 == 10-14" + , "289 == 10-15" + , "290 == 10-16" + , "291 == 10-17" + , "292 == 10-18" + , "293 == 10-19" + , "294 == 10-20" + , "295 == 10-21" + , "296 == 10-22" + , "297 == 10-23" + , "298 == 10-24" + , "299 == 10-25" + , "300 == 10-26" + , "301 == 10-27" + , "302 == 10-28" + , "303 == 10-29" + , "304 == 10-30" + , "305 == 10-31" + , "306 == 11-1" + , "307 == 11-2" + , "308 == 11-3" + , "309 == 11-4" + , "310 == 11-5" + , "311 == 11-6" + , "312 == 11-7" + , "313 == 11-8" + , "314 == 11-9" + , "315 == 11-10" + , "316 == 11-11" + , "317 == 11-12" + , "318 == 11-13" + , "319 == 11-14" + , "320 == 11-15" + , "321 == 11-16" + , "322 == 11-17" + , "323 == 11-18" + , "324 == 11-19" + , "325 == 11-20" + , "326 == 11-21" + , "327 == 11-22" + , "328 == 11-23" + , "329 == 11-24" + , "330 == 11-25" + , "331 == 11-26" + , "332 == 11-27" + , "333 == 11-28" + , "334 == 11-29" + , "335 == 11-30" + , "336 == 12-1" + , "337 == 12-2" + , "338 == 12-3" + , "339 == 12-4" + , "340 == 12-5" + , "341 == 12-6" + , "342 == 12-7" + , "343 == 12-8" + , "344 == 12-9" + , "345 == 12-10" + , "346 == 12-11" + , "347 == 12-12" + , "348 == 12-13" + , "349 == 12-14" + , "350 == 12-15" + , "351 == 12-16" + , "352 == 12-17" + , "353 == 12-18" + , "354 == 12-19" + , "355 == 12-20" + , "356 == 12-21" + , "357 == 12-22" + , "358 == 12-23" + , "359 == 12-24" + , "360 == 12-25" + , "361 == 12-26" + , "362 == 12-27" + , "363 == 12-28" + , "364 == 12-29" + , "365 == 12-30" + , "366 == 12-31" + , "DIFF: 367 -> 12-31 -> 366" + , "DIFF: 368 -> 12-31 -> 366" + , "DIFF: 369 -> 12-31 -> 366" ] diff --git a/test/main/Test/Calendar/Valid.hs b/test/main/Test/Calendar/Valid.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Calendar/Valid.hs @@ -0,0 +1,95 @@ +module Test.Calendar.Valid(testValid) where + +import Data.Time +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.WeekDate +import Data.Time.Calendar.Julian +import Test.Tasty +import Test.Tasty.QuickCheck hiding (reason) +import Test.QuickCheck.Property + + +validResult :: (Eq c,Show c,Eq t,Show t) => + (s -> c) -> Bool -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> s -> Result +validResult sc valid toComponents fromComponents fromComponentsValid s = let + c = sc s + mt = fromComponentsValid c + t' = fromComponents c + c' = toComponents t' + in if valid then + case mt of + Nothing -> rejected + Just t -> if t' /= t + then failed {reason = "'fromValid' gives " ++ show t ++ ", but 'from' gives " ++ show t'} + else if c' /= c + then failed {reason = "found valid, but converts " ++ show c ++ " -> " ++ show t' ++ " -> " ++ show c'} + else succeeded + else case mt of + Nothing -> if c' /= c + then succeeded + else failed {reason = show c ++ " found invalid, but converts with " ++ show t'} + Just _ -> rejected + +validTest :: (Arbitrary s,Show s,Eq c,Show c,Eq t,Show t) => + String -> (s -> c) -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> TestTree +validTest name sc toComponents fromComponents fromComponentsValid = testGroup name + [ + testProperty "valid" $ property $ validResult sc True toComponents fromComponents fromComponentsValid, + testProperty "invalid" $ property $ validResult sc False toComponents fromComponents fromComponentsValid + ] + +toSundayStartWeek :: Day -> (Integer,Int,Int) +toSundayStartWeek day = let + (y,_) = toOrdinalDate day + (w,d) = sundayStartWeek day + in (y,w,d) + +toMondayStartWeek :: Day -> (Integer,Int,Int) +toMondayStartWeek day = let + (y,_) = toOrdinalDate day + (w,d) = mondayStartWeek day + in (y,w,d) + +newtype Year = MkYear Integer deriving (Eq,Show) +instance Arbitrary Year where + arbitrary = fmap MkYear $ choose (-1000,3000) + +newtype YearMonth = MkYearMonth Int deriving (Eq,Show) +instance Arbitrary YearMonth where + arbitrary = fmap MkYearMonth $ choose (-5,17) + +newtype MonthDay = MkMonthDay Int deriving (Eq,Show) +instance Arbitrary MonthDay where + arbitrary = fmap MkMonthDay $ choose (-5,35) + +newtype YearDay = MkYearDay Int deriving (Eq,Show) +instance Arbitrary YearDay where + arbitrary = fmap MkYearDay $ choose (-20,400) + +newtype YearWeek = MkYearWeek Int deriving (Eq,Show) +instance Arbitrary YearWeek where + arbitrary = fmap MkYearWeek $ choose (-5,60) + +newtype WeekDay = MkWeekDay Int deriving (Eq,Show) +instance Arbitrary WeekDay where + arbitrary = fmap MkWeekDay $ choose (-5,15) + +fromYMD :: (Year,YearMonth,MonthDay) -> (Integer,Int,Int) +fromYMD (MkYear y,MkYearMonth ym,MkMonthDay md) = (y,ym,md) + +fromYD :: (Year,YearDay) -> (Integer,Int) +fromYD (MkYear y,MkYearDay yd) = (y,yd) + +fromYWD :: (Year,YearWeek,WeekDay) -> (Integer,Int,Int) +fromYWD (MkYear y,MkYearWeek yw,MkWeekDay wd) = (y,yw,wd) + +testValid :: TestTree +testValid = testGroup "testValid" + [ + validTest "Gregorian" fromYMD toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d), + validTest "OrdinalDate" fromYD toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d), + validTest "WeekDate" fromYWD toWeekDate (\(y,w,d) -> fromWeekDate y w d) (\(y,w,d) -> fromWeekDateValid y w d), + validTest "SundayStartWeek" fromYWD toSundayStartWeek (\(y,w,d) -> fromSundayStartWeek y w d) (\(y,w,d) -> fromSundayStartWeekValid y w d), + validTest "MondayStartWeek" fromYWD toMondayStartWeek (\(y,w,d) -> fromMondayStartWeek y w d) (\(y,w,d) -> fromMondayStartWeekValid y w d), + validTest "Julian" fromYMD toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d) + ] diff --git a/test/main/Test/Clock/Conversion.hs b/test/main/Test/Clock/Conversion.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Clock/Conversion.hs @@ -0,0 +1,25 @@ +module Test.Clock.Conversion(testClockConversion) where + +import Data.Time.Clock +import Data.Time.Clock.System +import Test.Tasty +import Test.Tasty.HUnit + + +testClockConversion :: TestTree; +testClockConversion = testGroup "clock conversion" $ let + testPair :: (SystemTime,UTCTime) -> TestTree + testPair (st,ut) = testGroup (show ut) $ + [ + testCase "systemToUTCTime" $ assertEqual (show ut) ut $ systemToUTCTime st, + testCase "utcToSystemTime" $ assertEqual (show ut) st $ utcToSystemTime ut + ] + in + [ + testPair (MkSystemTime 0 0,UTCTime systemEpochDay 0), + testPair (MkSystemTime 86399 0,UTCTime systemEpochDay 86399), + testPair (MkSystemTime 86399 999999999,UTCTime systemEpochDay 86399.999999999), + testPair (MkSystemTime 86399 1000000000,UTCTime systemEpochDay 86400), + testPair (MkSystemTime 86399 1999999999,UTCTime systemEpochDay 86400.999999999), + testPair (MkSystemTime 86400 0,UTCTime (succ systemEpochDay) 0) + ] diff --git a/test/main/Test/Clock/Resolution.hs b/test/main/Test/Clock/Resolution.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Clock/Resolution.hs @@ -0,0 +1,52 @@ +module Test.Clock.Resolution(testResolutions) where + +import Control.Concurrent +import Data.Fixed +import Data.Time.Clock +import Data.Time.Clock.TAI +import Test.Tasty +import Test.Tasty.HUnit + +repeatN :: Monad m => Int -> m a -> m [a] +repeatN 0 _ = return [] +repeatN n ma = do + a <- ma + aa <- repeatN (n - 1) ma + return $ a:aa + +gcd' :: Real a => a -> a -> a +gcd' a 0 = a +gcd' a b = gcd' b (mod' a b) + +gcdAll :: Real a => [a] -> a +gcdAll = foldr gcd' 0 + +testResolution :: (Show dt,Real dt) => String -> (at -> at -> dt) -> (dt,IO at) -> TestTree +testResolution name timeDiff (res,getTime) = testCase name $ do + t0 <- getTime + times0 <- repeatN 100 $ do + threadDelay 0 + getTime + times1 <- repeatN 100 $ do -- 100us + threadDelay 1 -- 1us + getTime + times2 <- repeatN 100 $ do -- 1ms + threadDelay 10 -- 10us + getTime + times3 <- repeatN 100 $ do -- 10ms + threadDelay 100 -- 100us + getTime + times4 <- repeatN 100 $ do -- 100ms + threadDelay 1000 -- 1ms + getTime + let times = fmap (\t -> timeDiff t t0) $ times0 ++ times1 ++ times2 ++ times3 ++ times4 + assertEqual "resolution" res $ gcdAll times + +testResolutions :: TestTree +testResolutions = testGroup "resolution" $ + [ + testResolution "getCurrentTime" diffUTCTime (realToFrac getTime_resolution,getCurrentTime) + ] + ++ case taiClock of + Just clock -> [testResolution "taiClock" diffAbsoluteTime clock] + Nothing -> [] diff --git a/test/main/Test/Clock/TAI.hs b/test/main/Test/Clock/TAI.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Clock/TAI.hs @@ -0,0 +1,62 @@ +module Test.Clock.TAI(testTAI) where + +import Data.Time +import Data.Time.Clock.TAI +import Test.Tasty +import Test.Tasty.HUnit +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 + ] + ] diff --git a/test/main/Test/Format/Format.hs b/test/main/Test/Format/Format.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Format/Format.hs @@ -0,0 +1,73 @@ +module Test.Format.Format(testFormat) where + +import Data.Time +import Control.Exception; +import Test.Tasty +import Test.Tasty.HUnit +import Test.TestUtil + + +-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html +-- plus FgGklz +-- f not supported +-- P not always supported +-- s time-zone dependent +chars :: [Char] +chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%" + +-- as found in "man strftime" on a glibc system. '#' is different, though +modifiers :: [Char] +modifiers = "_-0^" + +widths :: [String] +widths = ["","1","2","9","12"] + +formats :: [String] +formats = ["%G-W%V-%u","%U-%w","%W-%u"] ++ (fmap (\char -> '%':[char]) chars) + ++ (concat $ fmap (\char -> concat $ fmap (\width -> fmap (\modifier -> "%" ++ [modifier] ++ width ++ [char]) modifiers) widths) chars) + +somestrings :: [String] +somestrings = ["", " ", "-", "\n"] + +getBottom :: a -> IO (Maybe Control.Exception.SomeException); +getBottom a = Control.Exception.catch (seq a (return Nothing)) (return . Just); + +compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> Maybe t -> TestTree +compareExpected testname fmt str expected = testCase testname $ do + let found = parseTimeM False defaultTimeLocale fmt str + mex <- getBottom found + case mex of + Just ex -> assertFailure $ unwords [ "Exception: expected" , show expected ++ ", caught", show ex] + Nothing -> assertEqual "" expected found + +class (ParseTime t) => TestParse t where + expectedParse :: String -> String -> Maybe t + expectedParse "%Z" "" = buildTime defaultTimeLocale [] + expectedParse "%_Z" "" = buildTime defaultTimeLocale [] + expectedParse "%-Z" "" = buildTime defaultTimeLocale [] + expectedParse "%0Z" "" = buildTime defaultTimeLocale [] + expectedParse _ _ = Nothing + +instance TestParse Day +instance TestParse TimeOfDay +instance TestParse LocalTime +instance TestParse TimeZone +instance TestParse ZonedTime +instance TestParse UTCTime + +checkParse :: String -> String -> [TestTree] +checkParse fmt str = [ + compareExpected "Day" fmt str (expectedParse fmt str :: Maybe Day), + compareExpected "TimeOfDay" fmt str (expectedParse fmt str :: Maybe TimeOfDay), + compareExpected "LocalTime" fmt str (expectedParse fmt str :: Maybe LocalTime), + compareExpected "TimeZone" fmt str (expectedParse fmt str :: Maybe TimeZone), + compareExpected "UTCTime" fmt str (expectedParse fmt str :: Maybe UTCTime) + ] + +testCheckParse :: TestTree +testCheckParse = testGroup "checkParse" $ tgroup formats $ \fmt -> tgroup somestrings $ \str -> checkParse fmt str + +testFormat :: TestTree +testFormat = testGroup "testFormat" $ [ + testCheckParse + ] diff --git a/test/main/Test/Format/ParseTime.hs b/test/main/Test/Format/ParseTime.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/Format/ParseTime.hs @@ -0,0 +1,561 @@ +{-# OPTIONS -fno-warn-type-defaults -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances, ExistentialQuantification #-} + +module Test.Format.ParseTime(testParseTime,test_parse_format) where + +import Control.Monad +import Data.Char +import Data.Ratio +import Data.Time +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.WeekDate +import Data.Time.Clock.POSIX +import Test.QuickCheck.Property +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck hiding (reason) +import Test.TestUtil + + +testParseTime :: TestTree +testParseTime = testGroup "testParseTime" + [ + readOtherTypesTest, + readTests, + simpleFormatTests, + extests, + particularParseTests, + badParseTests, + defaultTimeZoneTests, + militaryTimeZoneTests, + propertyTests + ] + +yearDays :: Integer -> [Day] +yearDays y = [(fromGregorian y 1 1) .. (fromGregorian y 12 31)] + +makeExhaustiveTest :: String -> [t] -> (t -> TestTree) -> TestTree +makeExhaustiveTest name cases f = testGroup name (fmap f cases) + +extests :: TestTree +extests = testGroup "exhaustive" ([ + makeExhaustiveTest "parse %y" [0..99] parseYY, + makeExhaustiveTest "parse %-C %y 1900s" [0,1,50,99] (parseCYY 19), + makeExhaustiveTest "parse %-C %y 2000s" [0,1,50,99] (parseCYY 20), + makeExhaustiveTest "parse %-C %y 1400s" [0,1,50,99] (parseCYY 14), + makeExhaustiveTest "parse %C %y 0700s" [0,1,50,99] (parseCYY2 7), + makeExhaustiveTest "parse %-C %y 700s" [0,1,50,99] (parseCYY 7), + makeExhaustiveTest "parse %-C %y 10000s" [0,1,50,99] (parseCYY 100), + makeExhaustiveTest "parse %-C centuries" [20..100] (parseCentury " "), + makeExhaustiveTest "parse %-C century X" [1,10,20,100] (parseCentury "X"), + makeExhaustiveTest "parse %-C century 2sp" [1,10,20,100] (parseCentury " "), + makeExhaustiveTest "parse %-C century 5sp" [1,10,20,100] (parseCentury " ") + ] ++ + (concat $ fmap + (\y -> [ + (makeExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD), + (makeExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD), + (makeExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE) + ]) [1,4,20,753,2000,2011,10001])) + +readTest :: (Eq a,Show a,Read a) => [(a,String)] -> String -> TestTree +readTest expected target = let + found = reads target + result = assertEqual "" expected found + name = show target + in testCase name result + +readTestsParensSpaces :: forall a. (Eq a,Show a,Read a) => a -> String -> TestTree +readTestsParensSpaces expected target = testGroup target + [ + readTest [(expected,"")] $ target, + readTest [(expected,"")] $ "("++target++")", + readTest [(expected,"")] $ " ("++target++")", + readTest [(expected," ")] $ " ( "++target++" ) ", + readTest [(expected," ")] $ " (( "++target++" )) ", + readTest ([] :: [(a,String)]) $ "("++target, + readTest [(expected,")")] $ ""++target++")", + readTest [(expected,"")] $ "(("++target++"))", + readTest [(expected," ")] $ " ( ( "++target++" ) ) " + ] where + +readOtherTypesTest :: TestTree +readOtherTypesTest = testGroup "read other types" + [ + readTestsParensSpaces 3 "3", + readTestsParensSpaces "a" "\"a\"" + ] + +readTests :: TestTree +readTests = testGroup "read times" + [ + readTestsParensSpaces testDay "1912-07-08", + --readTestsParensSpaces testDay "1912-7-8", + readTestsParensSpaces testTimeOfDay "08:04:02" + --,readTestsParensSpaces testTimeOfDay "8:4:2" + ] where + testDay = fromGregorian 1912 7 8 + testTimeOfDay = TimeOfDay 8 4 2 + +epoch :: LocalTime +epoch = LocalTime (fromGregorian 1970 0 0) midnight + +simpleFormatTests :: TestTree +simpleFormatTests = testGroup "simple" + [ + readsTest [(epoch,"")] "" "", + readsTest [(epoch," ")] "" " ", + readsTest [(epoch,"")] " " " ", + readsTest [(epoch,"")] " " " ", + readsTest [(epoch,"")] "%k" "0", + readsTest [(epoch,"")] "%k" " 0", + readsTest [(epoch,"")] "%m" "01", + readsTest [(epoch," ")] "%m" "01 ", + readsTest [(epoch," ")] " %m" " 01 ", + readsTest [(epoch,"")] " %m" " 01", + -- https://ghc.haskell.org/trac/ghc/ticket/9150 + readsTest [(epoch,"")] " %M" " 00", + readsTest [(epoch,"")] "%M " "00 ", + readsTest [(epoch,"")] "%Q" "", + readsTest [(epoch," ")] "%Q" " ", + readsTest [(epoch,"X")] "%Q" "X", + readsTest [(epoch," X")] "%Q" " X", + readsTest [(epoch,"")] "%Q " " ", + readsTest [(epoch,"")] "%Q X" " X", + readsTest [(epoch,"")] "%QX" "X" + ] where + readsTest :: (Show a, Eq a, ParseTime a) => [(a,String)] -> String -> String -> TestTree + readsTest expected formatStr target = let + found = readSTime False defaultTimeLocale formatStr target + result = assertEqual "" expected found + name = (show formatStr) ++ " of " ++ (show target) + in testCase name result + +spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree +spacingTests expected formatStr target = testGroup "particular" + [ + parseTest False (Just expected) formatStr target, + parseTest True (Just expected) formatStr target, + parseTest False (Just expected) (formatStr ++ " ") (target ++ " "), + parseTest True (Just expected) (formatStr ++ " ") (target ++ " "), + parseTest False (Just expected) (" " ++ formatStr) (" " ++ target), + parseTest True (Just expected) (" " ++ formatStr) (" " ++ target), + parseTest True (Just expected) ("" ++ formatStr) (" " ++ target), + parseTest True (Just expected) (" " ++ formatStr) (" " ++ target) + ] + +particularParseTests :: TestTree +particularParseTests = testGroup "particular" + [ + spacingTests epoch "%Q" "", + spacingTests epoch "%Q" ".0", + spacingTests epoch "%k" " 0", + spacingTests epoch "%M" "00", + spacingTests epoch "%m" "01", + spacingTests (TimeZone 120 False "") "%z" "+0200", + spacingTests (TimeZone 120 False "") "%Z" "+0200", + spacingTests (TimeZone (-480) False "PST") "%Z" "PST" + ] + +badParseTests :: TestTree +badParseTests = testGroup "bad" + [ + parseTest False (Nothing :: Maybe Day) "%Y" "" + ] + +parseYMD :: Day -> TestTree +parseYMD day = case toGregorian day of + (y,m,d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d)) + +parseYearDayD :: Day -> TestTree +parseYearDayD day = case toGregorian day of + (y,m,d) -> parseTest False (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d)) + +parseYearDayE :: Day -> TestTree +parseYearDayE day = case toGregorian day of + (y,m,d) -> parseTest False (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d)) + +-- | 1969 - 2068 +expectedYear :: Integer -> Integer +expectedYear i | i >= 69 = 1900 + i +expectedYear i = 2000 + i + +show2 :: (Show n,Integral n) => n -> String +show2 i = (show (div i 10)) ++ (show (mod i 10)) + +parseYY :: Integer -> TestTree +parseYY i = parseTest False (Just (fromGregorian (expectedYear i) 1 1)) "%y" (show2 i) + +parseCYY :: Integer -> Integer -> TestTree +parseCYY c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%-C %y" ((show c) ++ " " ++ (show2 i)) + +parseCYY2 :: Integer -> Integer -> TestTree +parseCYY2 c i = parseTest False (Just (fromGregorian ((c * 100) + i) 1 1)) "%C %y" ((show2 c) ++ " " ++ (show2 i)) + +parseCentury :: String -> Integer -> TestTree +parseCentury int c = parseTest False (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00") + +parseTest :: (Show t, Eq t, ParseTime t) => Bool -> Maybe t -> String -> String -> TestTree +parseTest sp expected formatStr target = let + found = parse sp formatStr target + result = assertEqual "" expected found + name = (show formatStr) ++ " of " ++ (show target) ++ (if sp then " allowing spaces" else "") + in testCase name result +{- +readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> TestTree +readsTest (Just e) = readsTest' [(e,"")] +readsTest Nothing = readsTest' ([] :: [(t,String)]) +-} + +enumAdd :: (Enum a) => Int -> a -> a +enumAdd i a = toEnum (i + fromEnum a) + +getMilZoneLetter :: Int -> Char +getMilZoneLetter 0 = 'Z' +getMilZoneLetter h | h < 0 = enumAdd (negate h) 'M' +getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A' +getMilZoneLetter h = enumAdd (h - 10) 'K' + +getMilZone :: Int -> TimeZone +getMilZone hour = TimeZone (hour * 60) False [getMilZoneLetter hour] + +testParseTimeZone :: TimeZone -> TestTree +testParseTimeZone tz = parseTest False (Just tz) "%Z" (timeZoneName tz) + +defaultTimeZoneTests :: TestTree +defaultTimeZoneTests = testGroup "default time zones" (fmap testParseTimeZone (knownTimeZones defaultTimeLocale)) + +militaryTimeZoneTests :: TestTree +militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12]) + + +parse :: ParseTime t => Bool -> String -> String -> Maybe t +parse sp f t = parseTimeM sp defaultTimeLocale f t + +format :: (FormatTime t) => String -> t -> String +format f t = formatTime defaultTimeLocale f t + +instance Arbitrary Day where + arbitrary = liftM ModifiedJulianDay $ choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31 + +instance CoArbitrary Day where + coarbitrary (ModifiedJulianDay d) = coarbitrary d + +instance Arbitrary DiffTime where + arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second + where intSecs = liftM secondsToDiffTime' $ choose (0, 86400) + fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86400 * 10^12) + secondsToDiffTime' :: Integer -> DiffTime + secondsToDiffTime' = fromInteger + picosecondsToDiffTime' :: Integer -> DiffTime + picosecondsToDiffTime' x = fromRational (x % 10^12) + +instance CoArbitrary DiffTime where + coarbitrary t = coarbitrary (fromEnum t) + +instance Arbitrary TimeOfDay where + arbitrary = liftM timeToTimeOfDay arbitrary + +instance CoArbitrary TimeOfDay where + coarbitrary t = coarbitrary (timeOfDayToTime t) + +instance Arbitrary LocalTime where + arbitrary = liftM2 LocalTime arbitrary arbitrary + +instance CoArbitrary LocalTime where + coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer) + +instance Arbitrary TimeZone where + arbitrary = liftM minutesToTimeZone $ choose (-720,720) + +instance CoArbitrary TimeZone where + coarbitrary tz = coarbitrary (timeZoneMinutes tz) + +instance Arbitrary ZonedTime where + arbitrary = liftM2 ZonedTime arbitrary arbitrary + +instance CoArbitrary ZonedTime where + coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) + +instance Arbitrary UTCTime where + arbitrary = liftM2 UTCTime arbitrary arbitrary + +instance CoArbitrary UTCTime where + coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds t) :: Integer) + +instance Arbitrary UniversalTime where + arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) where -- 1000-01-1 to 9999-12-31 + k = 86400 + +instance CoArbitrary UniversalTime where + coarbitrary (ModJulianDate d) = coarbitrary d + +-- missing from the time package +instance Eq ZonedTime where + ZonedTime t1 tz1 == ZonedTime t2 tz2 = t1 == t2 && tz1 == tz2 + +compareResult' :: (Eq a,Show a) => String -> a -> a -> Result +compareResult' extra expected found + | expected == found = succeeded + | otherwise = failed {reason = "expected " ++ (show expected) ++ ", found " ++ (show found) ++ extra} + +compareResult :: (Eq a,Show a) => a -> a -> Result +compareResult = compareResult' "" + +compareParse :: forall a. (Eq a,Show a,ParseTime a) => a -> String -> String -> Result +compareParse expected fmt text = compareResult' (", parsing " ++ (show text)) (Just expected) (parse False fmt text) + +-- +-- * tests for debugging failing cases +-- + +test_parse_format :: (FormatTime t,ParseTime t,Show t) => String -> t -> (String,String,Maybe t) +test_parse_format f t = let s = format f t in (show t, s, parse False f s `asTypeOf` Just t) + +-- +-- * show and read +-- + +prop_read_show :: (Read a, Show a, Eq a) => a -> Result +prop_read_show t = compareResult [(t,"")] (reads (show t)) + +-- +-- * special show functions +-- + +prop_parse_showWeekDate :: Day -> Result +prop_parse_showWeekDate d = compareParse d "%G-W%V-%u" (showWeekDate d) + +prop_parse_showGregorian :: Day -> Result +prop_parse_showGregorian d = compareParse d "%Y-%m-%d" (showGregorian d) + +prop_parse_showOrdinalDate :: Day -> Result +prop_parse_showOrdinalDate d = compareParse d "%Y-%j" (showOrdinalDate d) + +-- +-- * fromMondayStartWeek and fromSundayStartWeek +-- + +prop_fromMondayStartWeek :: Day -> Result +prop_fromMondayStartWeek d = + let (w,wd) = mondayStartWeek d + (y,_,_) = toGregorian d + in compareResult d (fromMondayStartWeek y w wd) + +prop_fromSundayStartWeek :: Day -> Result +prop_fromSundayStartWeek d = + let (w,wd) = sundayStartWeek d + (y,_,_) = toGregorian d + in compareResult d (fromSundayStartWeek y w wd) + +-- +-- * format and parse +-- + +prop_parse_format :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result +prop_parse_format (FormatString f) t = compareParse t f (format f t) + +-- Verify case-insensitivity with upper case. +prop_parse_format_upper :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result +prop_parse_format_upper (FormatString f) t = compareParse t f (map toUpper $ format f t) + +-- Verify case-insensitivity with lower case. +prop_parse_format_lower :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result +prop_parse_format_lower (FormatString f) t = compareParse t f (map toLower $ format f t) + +prop_format_parse_format :: (FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result +prop_format_parse_format (FormatString f) t = compareResult + (Just (format f t)) + (fmap (format f) (parse False f (format f t) `asTypeOf` Just t)) + +-- +-- * crashes in parse +-- + +newtype Input = Input String + +instance Show Input where + show (Input s) = s + +instance Arbitrary Input where + arbitrary = liftM Input $ list cs + where cs = elements (['0'..'9'] ++ ['-',' ','/'] ++ ['a'..'z'] ++ ['A' .. 'Z']) + list g = sized (\n -> choose (0,n) >>= \l -> replicateM l g) +instance CoArbitrary Input where + coarbitrary (Input s) = coarbitrary (sum (map ord s)) + +prop_no_crash_bad_input :: (Eq t, ParseTime t) => FormatString t -> Input -> Property +prop_no_crash_bad_input fs@(FormatString f) (Input s) = property $ + case parse False f s of + Nothing -> True + Just t -> t == t `asTypeOf` formatType fs + +-- +-- +-- + +newtype FormatString a = FormatString String + +formatType :: FormatString t -> t +formatType _ = undefined + +instance Show (FormatString a) where + show (FormatString f) = show f + + +typedTests :: (forall t. (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result) -> [TestTree] +typedTests prop = [ + nameTest "Day" $ tgroup dayFormats prop, + nameTest "TimeOfDay" $ tgroup timeOfDayFormats prop, + nameTest "LocalTime" $ tgroup localTimeFormats prop, + nameTest "TimeZone" $ tgroup timeZoneFormats prop, + nameTest "ZonedTime" $ tgroup zonedTimeFormats prop, + nameTest "UTCTime" $ tgroup utcTimeFormats prop, + nameTest "UniversalTime" $ tgroup universalTimeFormats prop + ] + +formatParseFormatTests :: TestTree +formatParseFormatTests = nameTest "format_parse_format" [ + nameTest "Day" $ tgroup partialDayFormats prop_format_parse_format, + nameTest "TimeOfDay" $ tgroup partialTimeOfDayFormats prop_format_parse_format, + nameTest "LocalTime" $ tgroup partialLocalTimeFormats prop_format_parse_format, + nameTest "ZonedTime" $ tgroup partialZonedTimeFormats prop_format_parse_format, + nameTest "UTCTime" $ tgroup partialUTCTimeFormats prop_format_parse_format, + nameTest "UniversalTime" $ tgroup partialUniversalTimeFormats prop_format_parse_format + ] + +badInputTests :: TestTree +badInputTests = nameTest "no_crash_bad_input" [ + nameTest "Day" $ tgroup (dayFormats ++ partialDayFormats ++ failingPartialDayFormats) prop_no_crash_bad_input, + nameTest "TimeOfDay" $ tgroup (timeOfDayFormats ++ partialTimeOfDayFormats) prop_no_crash_bad_input, + nameTest "LocalTime" $ tgroup (localTimeFormats ++ partialLocalTimeFormats) prop_no_crash_bad_input, + nameTest "TimeZone" $ tgroup (timeZoneFormats) prop_no_crash_bad_input, + nameTest "ZonedTime" $ tgroup (zonedTimeFormats ++ partialZonedTimeFormats) prop_no_crash_bad_input, + nameTest "UTCTime" $ tgroup (utcTimeFormats ++ partialUTCTimeFormats) prop_no_crash_bad_input, + nameTest "UniversalTime" $ tgroup (universalTimeFormats ++ partialUniversalTimeFormats) prop_no_crash_bad_input + ] + +readShowTests :: TestTree +readShowTests = nameTest "read_show" [ + nameTest "Day" (prop_read_show :: Day -> Result), + nameTest "TimeOfDay" (prop_read_show :: TimeOfDay -> Result), + nameTest "LocalTime" (prop_read_show :: LocalTime -> Result), + nameTest "TimeZone" (prop_read_show :: TimeZone -> Result), + nameTest "ZonedTime" (prop_read_show :: ZonedTime -> Result), + nameTest "UTCTime" (prop_read_show :: UTCTime -> Result), + nameTest "UniversalTime" (prop_read_show :: UniversalTime -> Result) + ] + +parseShowTests :: TestTree +parseShowTests = nameTest "parse_show" [ + nameTest "showWeekDate" prop_parse_showWeekDate, + nameTest "showGregorian" prop_parse_showGregorian, + nameTest "showOrdinalDate" prop_parse_showOrdinalDate + ] + +propertyTests :: TestTree +propertyTests = nameTest "properties" [ + readShowTests, + parseShowTests, + nameTest "fromMondayStartWeek" prop_fromMondayStartWeek, + nameTest "fromSundayStartWeek" prop_fromSundayStartWeek, + nameTest "parse_format" $ typedTests prop_parse_format, + nameTest "parse_format_lower" $ typedTests prop_parse_format_lower, + nameTest "parse_format_upper" $ typedTests prop_parse_format_upper, + formatParseFormatTests, + badInputTests + ] + +dayFormats :: [FormatString Day] +dayFormats = map FormatString + [ + -- numeric year, month, day + "%Y-%m-%d","%Y%m%d","%C%y%m%d","%Y %m %e","%m/%d/%Y","%d/%m/%Y","%Y/%d/%m","%D %C","%F", + -- month names + "%Y-%B-%d","%Y-%b-%d","%Y-%h-%d", + -- ordinal dates + "%Y-%j", + -- ISO week dates + "%G-%V-%u","%G-%V-%a","%G-%V-%A","%G-%V-%w", "%A week %V, %G", "day %V, week %A, %G", + "%G-W%V-%u", + "%f%g-%V-%u","%f%g-%V-%a","%f%g-%V-%A","%f%g-%V-%w", "%A week %V, %f%g", "day %V, week %A, %f%g", + "%f%g-W%V-%u", + -- monday and sunday week dates + "%Y-w%U-%A", "%Y-w%W-%A", "%Y-%A-w%U", "%Y-%A-w%W", "%A week %U, %Y", "%A week %W, %Y" + ] + +timeOfDayFormats :: [FormatString TimeOfDay] +timeOfDayFormats = map FormatString + [ + -- 24 h formats + "%H:%M:%S.%q","%k:%M:%S.%q","%H%M%S.%q","%T.%q","%X.%q","%R:%S.%q", + "%H:%M:%S%Q","%k:%M:%S%Q","%H%M%S%Q","%T%Q","%X%Q","%R:%S%Q", + -- 12 h formats + "%I:%M:%S.%q %p","%I:%M:%S.%q %P","%l:%M:%S.%q %p","%r %q", + "%I:%M:%S%Q %p","%I:%M:%S%Q %P","%l:%M:%S%Q %p","%r %Q" + ] + +localTimeFormats :: [FormatString LocalTime] +localTimeFormats = map FormatString [{-"%Q","%Q ","%QX"-}] + +timeZoneFormats :: [FormatString TimeZone] +timeZoneFormats = map FormatString ["%z","%z%Z","%Z%z","%Z"] + +zonedTimeFormats :: [FormatString ZonedTime] +zonedTimeFormats = map FormatString + ["%a, %d %b %Y %H:%M:%S.%q %z", "%a, %d %b %Y %H:%M:%S%Q %z", "%s.%q %z", "%s%Q %z", + "%a, %d %b %Y %H:%M:%S.%q %Z", "%a, %d %b %Y %H:%M:%S%Q %Z", "%s.%q %Z", "%s%Q %Z"] + +utcTimeFormats :: [FormatString UTCTime] +utcTimeFormats = map FormatString + ["%s.%q","%s%Q"] + +universalTimeFormats :: [FormatString UniversalTime] +universalTimeFormats = map FormatString [] + +-- +-- * Formats that do not include all the information +-- + +partialDayFormats :: [FormatString Day] +partialDayFormats = map FormatString + [ ] + +partialTimeOfDayFormats :: [FormatString TimeOfDay] +partialTimeOfDayFormats = map FormatString + [ ] + +partialLocalTimeFormats :: [FormatString LocalTime] +partialLocalTimeFormats = map FormatString + [ ] + +partialZonedTimeFormats :: [FormatString ZonedTime] +partialZonedTimeFormats = map FormatString + [ + -- %s does not include second decimals + "%s %z", + -- %S does not include second decimals + "%c", "%a, %d %b %Y %H:%M:%S %Z" + ] + +partialUTCTimeFormats :: [FormatString UTCTime] +partialUTCTimeFormats = map FormatString + [ + -- %s does not include second decimals + "%s", + -- %c does not include second decimals + "%c" + ] + +partialUniversalTimeFormats :: [FormatString UniversalTime] +partialUniversalTimeFormats = map FormatString + [ ] + +failingPartialDayFormats :: [FormatString Day] +failingPartialDayFormats = map FormatString + [ -- ISO week dates with two digit year. + -- This can fail in the beginning or the end of a year where + -- the ISO week date year does not match the gregorian year. + "%g-%V-%u","%g-%V-%a","%g-%V-%A","%g-%V-%w", "%A week %V, %g", "day %V, week %A, %g", + "%g-W%V-%u" + ] diff --git a/test/main/Test/LocalTime/Time.hs b/test/main/Test/LocalTime/Time.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/LocalTime/Time.hs @@ -0,0 +1,107 @@ +module Test.LocalTime.Time(testTime) where + +import Data.Time.Calendar.OrdinalDate +import Data.Time.Calendar.WeekDate +import Data.Time +import Test.Tasty +import Test.Tasty.HUnit +import Test.LocalTime.TimeRef + +showCal :: Integer -> String +showCal mjd + = let date = ModifiedJulianDay mjd + (y,m,d) = toGregorian date + date' = fromGregorian y m d + in concat [ show mjd ++ "=" + ++ showGregorian date ++ "=" + ++ showOrdinalDate date ++ "=" + ++ showWeekDate date + ++ "\n" + + , if date == date' + then "" + else "=" ++ (show $ toModifiedJulianDay date') ++ "!" ] + +testCal :: String +testCal + = concat + -- days around 1 BCE/1 CE + [ concatMap showCal [-678950 .. -678930] + + -- days around 1000 CE + , concatMap showCal [-313710 .. -313690] + + -- days around MJD zero + , concatMap showCal [-30..30] + , showCal 40000 + , showCal 50000 + + -- 1900 not a leap year + , showCal 15078 + , showCal 15079 + + -- 1980 is a leap year + , showCal 44297 + , showCal 44298 + , showCal 44299 + + -- 1990 not a leap year + , showCal 47950 + , showCal 47951 + + -- 2000 is a leap year + , showCal 51602 + , showCal 51603 + , showCal 51604 + + -- years 2000 and 2001, plus some slop + , concatMap showCal [51540..52280] ] + +showUTCTime :: UTCTime -> String +showUTCTime (UTCTime d t) = show (toModifiedJulianDay d) ++ "," ++ show t + +myzone :: TimeZone +myzone = hoursToTimeZone (- 8) + +leapSec1998Cal :: LocalTime +leapSec1998Cal = LocalTime (fromGregorian 1998 12 31) (TimeOfDay 23 59 60.5) + +leapSec1998 :: UTCTime +leapSec1998 = localTimeToUTC utc leapSec1998Cal + +testUTC :: String +testUTC + = let lsMineCal = utcToLocalTime myzone leapSec1998 + lsMine = localTimeToUTC myzone lsMineCal + in unlines [ showCal 51178 + , show leapSec1998Cal + , showUTCTime leapSec1998 + , show lsMineCal + , showUTCTime lsMine ] + +neglong :: Rational +neglong = -120 + +poslong :: Rational +poslong = 120 + +testUT1 :: String +testUT1 + = unlines [ show $ ut1ToLocalTime 0 $ ModJulianDate 51604.0 + , show $ ut1ToLocalTime 0 $ ModJulianDate 51604.5 + , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.0 + , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.5 + , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.0 + , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.5 ] + +testTimeOfDayToDayFraction :: String +testTimeOfDayToDayFraction + = let f = dayFractionToTimeOfDay . timeOfDayToDayFraction + in unlines [ show $ f $ TimeOfDay 12 34 56.789 + , show $ f $ TimeOfDay 12 34 56.789123 + , show $ f $ TimeOfDay 12 34 56.789123456 + , show $ f $ TimeOfDay 12 34 56.789123456789 ] + +testTime :: TestTree +testTime = testCase "testTime" $ + assertEqual "times" testTimeRef $ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction] diff --git a/test/main/Test/LocalTime/TimeRef.hs b/test/main/Test/LocalTime/TimeRef.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/LocalTime/TimeRef.hs @@ -0,0 +1,881 @@ +module Test.LocalTime.TimeRef where + +testTimeRef :: String +testTimeRef = + unlines [ + "-678950=-0001-12-23=-0001-357=-0001-W51-4" + ,"-678949=-0001-12-24=-0001-358=-0001-W51-5" + ,"-678948=-0001-12-25=-0001-359=-0001-W51-6" + ,"-678947=-0001-12-26=-0001-360=-0001-W51-7" + ,"-678946=-0001-12-27=-0001-361=-0001-W52-1" + ,"-678945=-0001-12-28=-0001-362=-0001-W52-2" + ,"-678944=-0001-12-29=-0001-363=-0001-W52-3" + ,"-678943=-0001-12-30=-0001-364=-0001-W52-4" + ,"-678942=-0001-12-31=-0001-365=-0001-W52-5" + ,"-678941=0000-01-01=0000-001=-0001-W52-6" + ,"-678940=0000-01-02=0000-002=-0001-W52-7" + ,"-678939=0000-01-03=0000-003=0000-W01-1" + ,"-678938=0000-01-04=0000-004=0000-W01-2" + ,"-678937=0000-01-05=0000-005=0000-W01-3" + ,"-678936=0000-01-06=0000-006=0000-W01-4" + ,"-678935=0000-01-07=0000-007=0000-W01-5" + ,"-678934=0000-01-08=0000-008=0000-W01-6" + ,"-678933=0000-01-09=0000-009=0000-W01-7" + ,"-678932=0000-01-10=0000-010=0000-W02-1" + ,"-678931=0000-01-11=0000-011=0000-W02-2" + ,"-678930=0000-01-12=0000-012=0000-W02-3" + ,"-313710=0999-12-20=0999-354=0999-W51-5" + ,"-313709=0999-12-21=0999-355=0999-W51-6" + ,"-313708=0999-12-22=0999-356=0999-W51-7" + ,"-313707=0999-12-23=0999-357=0999-W52-1" + ,"-313706=0999-12-24=0999-358=0999-W52-2" + ,"-313705=0999-12-25=0999-359=0999-W52-3" + ,"-313704=0999-12-26=0999-360=0999-W52-4" + ,"-313703=0999-12-27=0999-361=0999-W52-5" + ,"-313702=0999-12-28=0999-362=0999-W52-6" + ,"-313701=0999-12-29=0999-363=0999-W52-7" + ,"-313700=0999-12-30=0999-364=1000-W01-1" + ,"-313699=0999-12-31=0999-365=1000-W01-2" + ,"-313698=1000-01-01=1000-001=1000-W01-3" + ,"-313697=1000-01-02=1000-002=1000-W01-4" + ,"-313696=1000-01-03=1000-003=1000-W01-5" + ,"-313695=1000-01-04=1000-004=1000-W01-6" + ,"-313694=1000-01-05=1000-005=1000-W01-7" + ,"-313693=1000-01-06=1000-006=1000-W02-1" + ,"-313692=1000-01-07=1000-007=1000-W02-2" + ,"-313691=1000-01-08=1000-008=1000-W02-3" + ,"-313690=1000-01-09=1000-009=1000-W02-4" + ,"-30=1858-10-18=1858-291=1858-W42-1" + ,"-29=1858-10-19=1858-292=1858-W42-2" + ,"-28=1858-10-20=1858-293=1858-W42-3" + ,"-27=1858-10-21=1858-294=1858-W42-4" + ,"-26=1858-10-22=1858-295=1858-W42-5" + ,"-25=1858-10-23=1858-296=1858-W42-6" + ,"-24=1858-10-24=1858-297=1858-W42-7" + ,"-23=1858-10-25=1858-298=1858-W43-1" + ,"-22=1858-10-26=1858-299=1858-W43-2" + ,"-21=1858-10-27=1858-300=1858-W43-3" + ,"-20=1858-10-28=1858-301=1858-W43-4" + ,"-19=1858-10-29=1858-302=1858-W43-5" + ,"-18=1858-10-30=1858-303=1858-W43-6" + ,"-17=1858-10-31=1858-304=1858-W43-7" + ,"-16=1858-11-01=1858-305=1858-W44-1" + ,"-15=1858-11-02=1858-306=1858-W44-2" + ,"-14=1858-11-03=1858-307=1858-W44-3" + ,"-13=1858-11-04=1858-308=1858-W44-4" + ,"-12=1858-11-05=1858-309=1858-W44-5" + ,"-11=1858-11-06=1858-310=1858-W44-6" + ,"-10=1858-11-07=1858-311=1858-W44-7" + ,"-9=1858-11-08=1858-312=1858-W45-1" + ,"-8=1858-11-09=1858-313=1858-W45-2" + ,"-7=1858-11-10=1858-314=1858-W45-3" + ,"-6=1858-11-11=1858-315=1858-W45-4" + ,"-5=1858-11-12=1858-316=1858-W45-5" + ,"-4=1858-11-13=1858-317=1858-W45-6" + ,"-3=1858-11-14=1858-318=1858-W45-7" + ,"-2=1858-11-15=1858-319=1858-W46-1" + ,"-1=1858-11-16=1858-320=1858-W46-2" + ,"0=1858-11-17=1858-321=1858-W46-3" + ,"1=1858-11-18=1858-322=1858-W46-4" + ,"2=1858-11-19=1858-323=1858-W46-5" + ,"3=1858-11-20=1858-324=1858-W46-6" + ,"4=1858-11-21=1858-325=1858-W46-7" + ,"5=1858-11-22=1858-326=1858-W47-1" + ,"6=1858-11-23=1858-327=1858-W47-2" + ,"7=1858-11-24=1858-328=1858-W47-3" + ,"8=1858-11-25=1858-329=1858-W47-4" + ,"9=1858-11-26=1858-330=1858-W47-5" + ,"10=1858-11-27=1858-331=1858-W47-6" + ,"11=1858-11-28=1858-332=1858-W47-7" + ,"12=1858-11-29=1858-333=1858-W48-1" + ,"13=1858-11-30=1858-334=1858-W48-2" + ,"14=1858-12-01=1858-335=1858-W48-3" + ,"15=1858-12-02=1858-336=1858-W48-4" + ,"16=1858-12-03=1858-337=1858-W48-5" + ,"17=1858-12-04=1858-338=1858-W48-6" + ,"18=1858-12-05=1858-339=1858-W48-7" + ,"19=1858-12-06=1858-340=1858-W49-1" + ,"20=1858-12-07=1858-341=1858-W49-2" + ,"21=1858-12-08=1858-342=1858-W49-3" + ,"22=1858-12-09=1858-343=1858-W49-4" + ,"23=1858-12-10=1858-344=1858-W49-5" + ,"24=1858-12-11=1858-345=1858-W49-6" + ,"25=1858-12-12=1858-346=1858-W49-7" + ,"26=1858-12-13=1858-347=1858-W50-1" + ,"27=1858-12-14=1858-348=1858-W50-2" + ,"28=1858-12-15=1858-349=1858-W50-3" + ,"29=1858-12-16=1858-350=1858-W50-4" + ,"30=1858-12-17=1858-351=1858-W50-5" + ,"40000=1968-05-24=1968-145=1968-W21-5" + ,"50000=1995-10-10=1995-283=1995-W41-2" + ,"15078=1900-02-28=1900-059=1900-W09-3" + ,"15079=1900-03-01=1900-060=1900-W09-4" + ,"44297=1980-02-28=1980-059=1980-W09-4" + ,"44298=1980-02-29=1980-060=1980-W09-5" + ,"44299=1980-03-01=1980-061=1980-W09-6" + ,"47950=1990-02-28=1990-059=1990-W09-3" + ,"47951=1990-03-01=1990-060=1990-W09-4" + ,"51602=2000-02-28=2000-059=2000-W09-1" + ,"51603=2000-02-29=2000-060=2000-W09-2" + ,"51604=2000-03-01=2000-061=2000-W09-3" + ,"51540=1999-12-28=1999-362=1999-W52-2" + ,"51541=1999-12-29=1999-363=1999-W52-3" + ,"51542=1999-12-30=1999-364=1999-W52-4" + ,"51543=1999-12-31=1999-365=1999-W52-5" + ,"51544=2000-01-01=2000-001=1999-W52-6" + ,"51545=2000-01-02=2000-002=1999-W52-7" + ,"51546=2000-01-03=2000-003=2000-W01-1" + ,"51547=2000-01-04=2000-004=2000-W01-2" + ,"51548=2000-01-05=2000-005=2000-W01-3" + ,"51549=2000-01-06=2000-006=2000-W01-4" + ,"51550=2000-01-07=2000-007=2000-W01-5" + ,"51551=2000-01-08=2000-008=2000-W01-6" + ,"51552=2000-01-09=2000-009=2000-W01-7" + ,"51553=2000-01-10=2000-010=2000-W02-1" + ,"51554=2000-01-11=2000-011=2000-W02-2" + ,"51555=2000-01-12=2000-012=2000-W02-3" + ,"51556=2000-01-13=2000-013=2000-W02-4" + ,"51557=2000-01-14=2000-014=2000-W02-5" + ,"51558=2000-01-15=2000-015=2000-W02-6" + ,"51559=2000-01-16=2000-016=2000-W02-7" + ,"51560=2000-01-17=2000-017=2000-W03-1" + ,"51561=2000-01-18=2000-018=2000-W03-2" + ,"51562=2000-01-19=2000-019=2000-W03-3" + ,"51563=2000-01-20=2000-020=2000-W03-4" + ,"51564=2000-01-21=2000-021=2000-W03-5" + ,"51565=2000-01-22=2000-022=2000-W03-6" + ,"51566=2000-01-23=2000-023=2000-W03-7" + ,"51567=2000-01-24=2000-024=2000-W04-1" + ,"51568=2000-01-25=2000-025=2000-W04-2" + ,"51569=2000-01-26=2000-026=2000-W04-3" + ,"51570=2000-01-27=2000-027=2000-W04-4" + ,"51571=2000-01-28=2000-028=2000-W04-5" + ,"51572=2000-01-29=2000-029=2000-W04-6" + ,"51573=2000-01-30=2000-030=2000-W04-7" + ,"51574=2000-01-31=2000-031=2000-W05-1" + ,"51575=2000-02-01=2000-032=2000-W05-2" + ,"51576=2000-02-02=2000-033=2000-W05-3" + ,"51577=2000-02-03=2000-034=2000-W05-4" + ,"51578=2000-02-04=2000-035=2000-W05-5" + ,"51579=2000-02-05=2000-036=2000-W05-6" + ,"51580=2000-02-06=2000-037=2000-W05-7" + ,"51581=2000-02-07=2000-038=2000-W06-1" + ,"51582=2000-02-08=2000-039=2000-W06-2" + ,"51583=2000-02-09=2000-040=2000-W06-3" + ,"51584=2000-02-10=2000-041=2000-W06-4" + ,"51585=2000-02-11=2000-042=2000-W06-5" + ,"51586=2000-02-12=2000-043=2000-W06-6" + ,"51587=2000-02-13=2000-044=2000-W06-7" + ,"51588=2000-02-14=2000-045=2000-W07-1" + ,"51589=2000-02-15=2000-046=2000-W07-2" + ,"51590=2000-02-16=2000-047=2000-W07-3" + ,"51591=2000-02-17=2000-048=2000-W07-4" + ,"51592=2000-02-18=2000-049=2000-W07-5" + ,"51593=2000-02-19=2000-050=2000-W07-6" + ,"51594=2000-02-20=2000-051=2000-W07-7" + ,"51595=2000-02-21=2000-052=2000-W08-1" + ,"51596=2000-02-22=2000-053=2000-W08-2" + ,"51597=2000-02-23=2000-054=2000-W08-3" + ,"51598=2000-02-24=2000-055=2000-W08-4" + ,"51599=2000-02-25=2000-056=2000-W08-5" + ,"51600=2000-02-26=2000-057=2000-W08-6" + ,"51601=2000-02-27=2000-058=2000-W08-7" + ,"51602=2000-02-28=2000-059=2000-W09-1" + ,"51603=2000-02-29=2000-060=2000-W09-2" + ,"51604=2000-03-01=2000-061=2000-W09-3" + ,"51605=2000-03-02=2000-062=2000-W09-4" + ,"51606=2000-03-03=2000-063=2000-W09-5" + ,"51607=2000-03-04=2000-064=2000-W09-6" + ,"51608=2000-03-05=2000-065=2000-W09-7" + ,"51609=2000-03-06=2000-066=2000-W10-1" + ,"51610=2000-03-07=2000-067=2000-W10-2" + ,"51611=2000-03-08=2000-068=2000-W10-3" + ,"51612=2000-03-09=2000-069=2000-W10-4" + ,"51613=2000-03-10=2000-070=2000-W10-5" + ,"51614=2000-03-11=2000-071=2000-W10-6" + ,"51615=2000-03-12=2000-072=2000-W10-7" + ,"51616=2000-03-13=2000-073=2000-W11-1" + ,"51617=2000-03-14=2000-074=2000-W11-2" + ,"51618=2000-03-15=2000-075=2000-W11-3" + ,"51619=2000-03-16=2000-076=2000-W11-4" + ,"51620=2000-03-17=2000-077=2000-W11-5" + ,"51621=2000-03-18=2000-078=2000-W11-6" + ,"51622=2000-03-19=2000-079=2000-W11-7" + ,"51623=2000-03-20=2000-080=2000-W12-1" + ,"51624=2000-03-21=2000-081=2000-W12-2" + ,"51625=2000-03-22=2000-082=2000-W12-3" + ,"51626=2000-03-23=2000-083=2000-W12-4" + ,"51627=2000-03-24=2000-084=2000-W12-5" + ,"51628=2000-03-25=2000-085=2000-W12-6" + ,"51629=2000-03-26=2000-086=2000-W12-7" + ,"51630=2000-03-27=2000-087=2000-W13-1" + ,"51631=2000-03-28=2000-088=2000-W13-2" + ,"51632=2000-03-29=2000-089=2000-W13-3" + ,"51633=2000-03-30=2000-090=2000-W13-4" + ,"51634=2000-03-31=2000-091=2000-W13-5" + ,"51635=2000-04-01=2000-092=2000-W13-6" + ,"51636=2000-04-02=2000-093=2000-W13-7" + ,"51637=2000-04-03=2000-094=2000-W14-1" + ,"51638=2000-04-04=2000-095=2000-W14-2" + ,"51639=2000-04-05=2000-096=2000-W14-3" + ,"51640=2000-04-06=2000-097=2000-W14-4" + ,"51641=2000-04-07=2000-098=2000-W14-5" + ,"51642=2000-04-08=2000-099=2000-W14-6" + ,"51643=2000-04-09=2000-100=2000-W14-7" + ,"51644=2000-04-10=2000-101=2000-W15-1" + ,"51645=2000-04-11=2000-102=2000-W15-2" + ,"51646=2000-04-12=2000-103=2000-W15-3" + ,"51647=2000-04-13=2000-104=2000-W15-4" + ,"51648=2000-04-14=2000-105=2000-W15-5" + ,"51649=2000-04-15=2000-106=2000-W15-6" + ,"51650=2000-04-16=2000-107=2000-W15-7" + ,"51651=2000-04-17=2000-108=2000-W16-1" + ,"51652=2000-04-18=2000-109=2000-W16-2" + ,"51653=2000-04-19=2000-110=2000-W16-3" + ,"51654=2000-04-20=2000-111=2000-W16-4" + ,"51655=2000-04-21=2000-112=2000-W16-5" + ,"51656=2000-04-22=2000-113=2000-W16-6" + ,"51657=2000-04-23=2000-114=2000-W16-7" + ,"51658=2000-04-24=2000-115=2000-W17-1" + ,"51659=2000-04-25=2000-116=2000-W17-2" + ,"51660=2000-04-26=2000-117=2000-W17-3" + ,"51661=2000-04-27=2000-118=2000-W17-4" + ,"51662=2000-04-28=2000-119=2000-W17-5" + ,"51663=2000-04-29=2000-120=2000-W17-6" + ,"51664=2000-04-30=2000-121=2000-W17-7" + ,"51665=2000-05-01=2000-122=2000-W18-1" + ,"51666=2000-05-02=2000-123=2000-W18-2" + ,"51667=2000-05-03=2000-124=2000-W18-3" + ,"51668=2000-05-04=2000-125=2000-W18-4" + ,"51669=2000-05-05=2000-126=2000-W18-5" + ,"51670=2000-05-06=2000-127=2000-W18-6" + ,"51671=2000-05-07=2000-128=2000-W18-7" + ,"51672=2000-05-08=2000-129=2000-W19-1" + ,"51673=2000-05-09=2000-130=2000-W19-2" + ,"51674=2000-05-10=2000-131=2000-W19-3" + ,"51675=2000-05-11=2000-132=2000-W19-4" + ,"51676=2000-05-12=2000-133=2000-W19-5" + ,"51677=2000-05-13=2000-134=2000-W19-6" + ,"51678=2000-05-14=2000-135=2000-W19-7" + ,"51679=2000-05-15=2000-136=2000-W20-1" + ,"51680=2000-05-16=2000-137=2000-W20-2" + ,"51681=2000-05-17=2000-138=2000-W20-3" + ,"51682=2000-05-18=2000-139=2000-W20-4" + ,"51683=2000-05-19=2000-140=2000-W20-5" + ,"51684=2000-05-20=2000-141=2000-W20-6" + ,"51685=2000-05-21=2000-142=2000-W20-7" + ,"51686=2000-05-22=2000-143=2000-W21-1" + ,"51687=2000-05-23=2000-144=2000-W21-2" + ,"51688=2000-05-24=2000-145=2000-W21-3" + ,"51689=2000-05-25=2000-146=2000-W21-4" + ,"51690=2000-05-26=2000-147=2000-W21-5" + ,"51691=2000-05-27=2000-148=2000-W21-6" + ,"51692=2000-05-28=2000-149=2000-W21-7" + ,"51693=2000-05-29=2000-150=2000-W22-1" + ,"51694=2000-05-30=2000-151=2000-W22-2" + ,"51695=2000-05-31=2000-152=2000-W22-3" + ,"51696=2000-06-01=2000-153=2000-W22-4" + ,"51697=2000-06-02=2000-154=2000-W22-5" + ,"51698=2000-06-03=2000-155=2000-W22-6" + ,"51699=2000-06-04=2000-156=2000-W22-7" + ,"51700=2000-06-05=2000-157=2000-W23-1" + ,"51701=2000-06-06=2000-158=2000-W23-2" + ,"51702=2000-06-07=2000-159=2000-W23-3" + ,"51703=2000-06-08=2000-160=2000-W23-4" + ,"51704=2000-06-09=2000-161=2000-W23-5" + ,"51705=2000-06-10=2000-162=2000-W23-6" + ,"51706=2000-06-11=2000-163=2000-W23-7" + ,"51707=2000-06-12=2000-164=2000-W24-1" + ,"51708=2000-06-13=2000-165=2000-W24-2" + ,"51709=2000-06-14=2000-166=2000-W24-3" + ,"51710=2000-06-15=2000-167=2000-W24-4" + ,"51711=2000-06-16=2000-168=2000-W24-5" + ,"51712=2000-06-17=2000-169=2000-W24-6" + ,"51713=2000-06-18=2000-170=2000-W24-7" + ,"51714=2000-06-19=2000-171=2000-W25-1" + ,"51715=2000-06-20=2000-172=2000-W25-2" + ,"51716=2000-06-21=2000-173=2000-W25-3" + ,"51717=2000-06-22=2000-174=2000-W25-4" + ,"51718=2000-06-23=2000-175=2000-W25-5" + ,"51719=2000-06-24=2000-176=2000-W25-6" + ,"51720=2000-06-25=2000-177=2000-W25-7" + ,"51721=2000-06-26=2000-178=2000-W26-1" + ,"51722=2000-06-27=2000-179=2000-W26-2" + ,"51723=2000-06-28=2000-180=2000-W26-3" + ,"51724=2000-06-29=2000-181=2000-W26-4" + ,"51725=2000-06-30=2000-182=2000-W26-5" + ,"51726=2000-07-01=2000-183=2000-W26-6" + ,"51727=2000-07-02=2000-184=2000-W26-7" + ,"51728=2000-07-03=2000-185=2000-W27-1" + ,"51729=2000-07-04=2000-186=2000-W27-2" + ,"51730=2000-07-05=2000-187=2000-W27-3" + ,"51731=2000-07-06=2000-188=2000-W27-4" + ,"51732=2000-07-07=2000-189=2000-W27-5" + ,"51733=2000-07-08=2000-190=2000-W27-6" + ,"51734=2000-07-09=2000-191=2000-W27-7" + ,"51735=2000-07-10=2000-192=2000-W28-1" + ,"51736=2000-07-11=2000-193=2000-W28-2" + ,"51737=2000-07-12=2000-194=2000-W28-3" + ,"51738=2000-07-13=2000-195=2000-W28-4" + ,"51739=2000-07-14=2000-196=2000-W28-5" + ,"51740=2000-07-15=2000-197=2000-W28-6" + ,"51741=2000-07-16=2000-198=2000-W28-7" + ,"51742=2000-07-17=2000-199=2000-W29-1" + ,"51743=2000-07-18=2000-200=2000-W29-2" + ,"51744=2000-07-19=2000-201=2000-W29-3" + ,"51745=2000-07-20=2000-202=2000-W29-4" + ,"51746=2000-07-21=2000-203=2000-W29-5" + ,"51747=2000-07-22=2000-204=2000-W29-6" + ,"51748=2000-07-23=2000-205=2000-W29-7" + ,"51749=2000-07-24=2000-206=2000-W30-1" + ,"51750=2000-07-25=2000-207=2000-W30-2" + ,"51751=2000-07-26=2000-208=2000-W30-3" + ,"51752=2000-07-27=2000-209=2000-W30-4" + ,"51753=2000-07-28=2000-210=2000-W30-5" + ,"51754=2000-07-29=2000-211=2000-W30-6" + ,"51755=2000-07-30=2000-212=2000-W30-7" + ,"51756=2000-07-31=2000-213=2000-W31-1" + ,"51757=2000-08-01=2000-214=2000-W31-2" + ,"51758=2000-08-02=2000-215=2000-W31-3" + ,"51759=2000-08-03=2000-216=2000-W31-4" + ,"51760=2000-08-04=2000-217=2000-W31-5" + ,"51761=2000-08-05=2000-218=2000-W31-6" + ,"51762=2000-08-06=2000-219=2000-W31-7" + ,"51763=2000-08-07=2000-220=2000-W32-1" + ,"51764=2000-08-08=2000-221=2000-W32-2" + ,"51765=2000-08-09=2000-222=2000-W32-3" + ,"51766=2000-08-10=2000-223=2000-W32-4" + ,"51767=2000-08-11=2000-224=2000-W32-5" + ,"51768=2000-08-12=2000-225=2000-W32-6" + ,"51769=2000-08-13=2000-226=2000-W32-7" + ,"51770=2000-08-14=2000-227=2000-W33-1" + ,"51771=2000-08-15=2000-228=2000-W33-2" + ,"51772=2000-08-16=2000-229=2000-W33-3" + ,"51773=2000-08-17=2000-230=2000-W33-4" + ,"51774=2000-08-18=2000-231=2000-W33-5" + ,"51775=2000-08-19=2000-232=2000-W33-6" + ,"51776=2000-08-20=2000-233=2000-W33-7" + ,"51777=2000-08-21=2000-234=2000-W34-1" + ,"51778=2000-08-22=2000-235=2000-W34-2" + ,"51779=2000-08-23=2000-236=2000-W34-3" + ,"51780=2000-08-24=2000-237=2000-W34-4" + ,"51781=2000-08-25=2000-238=2000-W34-5" + ,"51782=2000-08-26=2000-239=2000-W34-6" + ,"51783=2000-08-27=2000-240=2000-W34-7" + ,"51784=2000-08-28=2000-241=2000-W35-1" + ,"51785=2000-08-29=2000-242=2000-W35-2" + ,"51786=2000-08-30=2000-243=2000-W35-3" + ,"51787=2000-08-31=2000-244=2000-W35-4" + ,"51788=2000-09-01=2000-245=2000-W35-5" + ,"51789=2000-09-02=2000-246=2000-W35-6" + ,"51790=2000-09-03=2000-247=2000-W35-7" + ,"51791=2000-09-04=2000-248=2000-W36-1" + ,"51792=2000-09-05=2000-249=2000-W36-2" + ,"51793=2000-09-06=2000-250=2000-W36-3" + ,"51794=2000-09-07=2000-251=2000-W36-4" + ,"51795=2000-09-08=2000-252=2000-W36-5" + ,"51796=2000-09-09=2000-253=2000-W36-6" + ,"51797=2000-09-10=2000-254=2000-W36-7" + ,"51798=2000-09-11=2000-255=2000-W37-1" + ,"51799=2000-09-12=2000-256=2000-W37-2" + ,"51800=2000-09-13=2000-257=2000-W37-3" + ,"51801=2000-09-14=2000-258=2000-W37-4" + ,"51802=2000-09-15=2000-259=2000-W37-5" + ,"51803=2000-09-16=2000-260=2000-W37-6" + ,"51804=2000-09-17=2000-261=2000-W37-7" + ,"51805=2000-09-18=2000-262=2000-W38-1" + ,"51806=2000-09-19=2000-263=2000-W38-2" + ,"51807=2000-09-20=2000-264=2000-W38-3" + ,"51808=2000-09-21=2000-265=2000-W38-4" + ,"51809=2000-09-22=2000-266=2000-W38-5" + ,"51810=2000-09-23=2000-267=2000-W38-6" + ,"51811=2000-09-24=2000-268=2000-W38-7" + ,"51812=2000-09-25=2000-269=2000-W39-1" + ,"51813=2000-09-26=2000-270=2000-W39-2" + ,"51814=2000-09-27=2000-271=2000-W39-3" + ,"51815=2000-09-28=2000-272=2000-W39-4" + ,"51816=2000-09-29=2000-273=2000-W39-5" + ,"51817=2000-09-30=2000-274=2000-W39-6" + ,"51818=2000-10-01=2000-275=2000-W39-7" + ,"51819=2000-10-02=2000-276=2000-W40-1" + ,"51820=2000-10-03=2000-277=2000-W40-2" + ,"51821=2000-10-04=2000-278=2000-W40-3" + ,"51822=2000-10-05=2000-279=2000-W40-4" + ,"51823=2000-10-06=2000-280=2000-W40-5" + ,"51824=2000-10-07=2000-281=2000-W40-6" + ,"51825=2000-10-08=2000-282=2000-W40-7" + ,"51826=2000-10-09=2000-283=2000-W41-1" + ,"51827=2000-10-10=2000-284=2000-W41-2" + ,"51828=2000-10-11=2000-285=2000-W41-3" + ,"51829=2000-10-12=2000-286=2000-W41-4" + ,"51830=2000-10-13=2000-287=2000-W41-5" + ,"51831=2000-10-14=2000-288=2000-W41-6" + ,"51832=2000-10-15=2000-289=2000-W41-7" + ,"51833=2000-10-16=2000-290=2000-W42-1" + ,"51834=2000-10-17=2000-291=2000-W42-2" + ,"51835=2000-10-18=2000-292=2000-W42-3" + ,"51836=2000-10-19=2000-293=2000-W42-4" + ,"51837=2000-10-20=2000-294=2000-W42-5" + ,"51838=2000-10-21=2000-295=2000-W42-6" + ,"51839=2000-10-22=2000-296=2000-W42-7" + ,"51840=2000-10-23=2000-297=2000-W43-1" + ,"51841=2000-10-24=2000-298=2000-W43-2" + ,"51842=2000-10-25=2000-299=2000-W43-3" + ,"51843=2000-10-26=2000-300=2000-W43-4" + ,"51844=2000-10-27=2000-301=2000-W43-5" + ,"51845=2000-10-28=2000-302=2000-W43-6" + ,"51846=2000-10-29=2000-303=2000-W43-7" + ,"51847=2000-10-30=2000-304=2000-W44-1" + ,"51848=2000-10-31=2000-305=2000-W44-2" + ,"51849=2000-11-01=2000-306=2000-W44-3" + ,"51850=2000-11-02=2000-307=2000-W44-4" + ,"51851=2000-11-03=2000-308=2000-W44-5" + ,"51852=2000-11-04=2000-309=2000-W44-6" + ,"51853=2000-11-05=2000-310=2000-W44-7" + ,"51854=2000-11-06=2000-311=2000-W45-1" + ,"51855=2000-11-07=2000-312=2000-W45-2" + ,"51856=2000-11-08=2000-313=2000-W45-3" + ,"51857=2000-11-09=2000-314=2000-W45-4" + ,"51858=2000-11-10=2000-315=2000-W45-5" + ,"51859=2000-11-11=2000-316=2000-W45-6" + ,"51860=2000-11-12=2000-317=2000-W45-7" + ,"51861=2000-11-13=2000-318=2000-W46-1" + ,"51862=2000-11-14=2000-319=2000-W46-2" + ,"51863=2000-11-15=2000-320=2000-W46-3" + ,"51864=2000-11-16=2000-321=2000-W46-4" + ,"51865=2000-11-17=2000-322=2000-W46-5" + ,"51866=2000-11-18=2000-323=2000-W46-6" + ,"51867=2000-11-19=2000-324=2000-W46-7" + ,"51868=2000-11-20=2000-325=2000-W47-1" + ,"51869=2000-11-21=2000-326=2000-W47-2" + ,"51870=2000-11-22=2000-327=2000-W47-3" + ,"51871=2000-11-23=2000-328=2000-W47-4" + ,"51872=2000-11-24=2000-329=2000-W47-5" + ,"51873=2000-11-25=2000-330=2000-W47-6" + ,"51874=2000-11-26=2000-331=2000-W47-7" + ,"51875=2000-11-27=2000-332=2000-W48-1" + ,"51876=2000-11-28=2000-333=2000-W48-2" + ,"51877=2000-11-29=2000-334=2000-W48-3" + ,"51878=2000-11-30=2000-335=2000-W48-4" + ,"51879=2000-12-01=2000-336=2000-W48-5" + ,"51880=2000-12-02=2000-337=2000-W48-6" + ,"51881=2000-12-03=2000-338=2000-W48-7" + ,"51882=2000-12-04=2000-339=2000-W49-1" + ,"51883=2000-12-05=2000-340=2000-W49-2" + ,"51884=2000-12-06=2000-341=2000-W49-3" + ,"51885=2000-12-07=2000-342=2000-W49-4" + ,"51886=2000-12-08=2000-343=2000-W49-5" + ,"51887=2000-12-09=2000-344=2000-W49-6" + ,"51888=2000-12-10=2000-345=2000-W49-7" + ,"51889=2000-12-11=2000-346=2000-W50-1" + ,"51890=2000-12-12=2000-347=2000-W50-2" + ,"51891=2000-12-13=2000-348=2000-W50-3" + ,"51892=2000-12-14=2000-349=2000-W50-4" + ,"51893=2000-12-15=2000-350=2000-W50-5" + ,"51894=2000-12-16=2000-351=2000-W50-6" + ,"51895=2000-12-17=2000-352=2000-W50-7" + ,"51896=2000-12-18=2000-353=2000-W51-1" + ,"51897=2000-12-19=2000-354=2000-W51-2" + ,"51898=2000-12-20=2000-355=2000-W51-3" + ,"51899=2000-12-21=2000-356=2000-W51-4" + ,"51900=2000-12-22=2000-357=2000-W51-5" + ,"51901=2000-12-23=2000-358=2000-W51-6" + ,"51902=2000-12-24=2000-359=2000-W51-7" + ,"51903=2000-12-25=2000-360=2000-W52-1" + ,"51904=2000-12-26=2000-361=2000-W52-2" + ,"51905=2000-12-27=2000-362=2000-W52-3" + ,"51906=2000-12-28=2000-363=2000-W52-4" + ,"51907=2000-12-29=2000-364=2000-W52-5" + ,"51908=2000-12-30=2000-365=2000-W52-6" + ,"51909=2000-12-31=2000-366=2000-W52-7" + ,"51910=2001-01-01=2001-001=2001-W01-1" + ,"51911=2001-01-02=2001-002=2001-W01-2" + ,"51912=2001-01-03=2001-003=2001-W01-3" + ,"51913=2001-01-04=2001-004=2001-W01-4" + ,"51914=2001-01-05=2001-005=2001-W01-5" + ,"51915=2001-01-06=2001-006=2001-W01-6" + ,"51916=2001-01-07=2001-007=2001-W01-7" + ,"51917=2001-01-08=2001-008=2001-W02-1" + ,"51918=2001-01-09=2001-009=2001-W02-2" + ,"51919=2001-01-10=2001-010=2001-W02-3" + ,"51920=2001-01-11=2001-011=2001-W02-4" + ,"51921=2001-01-12=2001-012=2001-W02-5" + ,"51922=2001-01-13=2001-013=2001-W02-6" + ,"51923=2001-01-14=2001-014=2001-W02-7" + ,"51924=2001-01-15=2001-015=2001-W03-1" + ,"51925=2001-01-16=2001-016=2001-W03-2" + ,"51926=2001-01-17=2001-017=2001-W03-3" + ,"51927=2001-01-18=2001-018=2001-W03-4" + ,"51928=2001-01-19=2001-019=2001-W03-5" + ,"51929=2001-01-20=2001-020=2001-W03-6" + ,"51930=2001-01-21=2001-021=2001-W03-7" + ,"51931=2001-01-22=2001-022=2001-W04-1" + ,"51932=2001-01-23=2001-023=2001-W04-2" + ,"51933=2001-01-24=2001-024=2001-W04-3" + ,"51934=2001-01-25=2001-025=2001-W04-4" + ,"51935=2001-01-26=2001-026=2001-W04-5" + ,"51936=2001-01-27=2001-027=2001-W04-6" + ,"51937=2001-01-28=2001-028=2001-W04-7" + ,"51938=2001-01-29=2001-029=2001-W05-1" + ,"51939=2001-01-30=2001-030=2001-W05-2" + ,"51940=2001-01-31=2001-031=2001-W05-3" + ,"51941=2001-02-01=2001-032=2001-W05-4" + ,"51942=2001-02-02=2001-033=2001-W05-5" + ,"51943=2001-02-03=2001-034=2001-W05-6" + ,"51944=2001-02-04=2001-035=2001-W05-7" + ,"51945=2001-02-05=2001-036=2001-W06-1" + ,"51946=2001-02-06=2001-037=2001-W06-2" + ,"51947=2001-02-07=2001-038=2001-W06-3" + ,"51948=2001-02-08=2001-039=2001-W06-4" + ,"51949=2001-02-09=2001-040=2001-W06-5" + ,"51950=2001-02-10=2001-041=2001-W06-6" + ,"51951=2001-02-11=2001-042=2001-W06-7" + ,"51952=2001-02-12=2001-043=2001-W07-1" + ,"51953=2001-02-13=2001-044=2001-W07-2" + ,"51954=2001-02-14=2001-045=2001-W07-3" + ,"51955=2001-02-15=2001-046=2001-W07-4" + ,"51956=2001-02-16=2001-047=2001-W07-5" + ,"51957=2001-02-17=2001-048=2001-W07-6" + ,"51958=2001-02-18=2001-049=2001-W07-7" + ,"51959=2001-02-19=2001-050=2001-W08-1" + ,"51960=2001-02-20=2001-051=2001-W08-2" + ,"51961=2001-02-21=2001-052=2001-W08-3" + ,"51962=2001-02-22=2001-053=2001-W08-4" + ,"51963=2001-02-23=2001-054=2001-W08-5" + ,"51964=2001-02-24=2001-055=2001-W08-6" + ,"51965=2001-02-25=2001-056=2001-W08-7" + ,"51966=2001-02-26=2001-057=2001-W09-1" + ,"51967=2001-02-27=2001-058=2001-W09-2" + ,"51968=2001-02-28=2001-059=2001-W09-3" + ,"51969=2001-03-01=2001-060=2001-W09-4" + ,"51970=2001-03-02=2001-061=2001-W09-5" + ,"51971=2001-03-03=2001-062=2001-W09-6" + ,"51972=2001-03-04=2001-063=2001-W09-7" + ,"51973=2001-03-05=2001-064=2001-W10-1" + ,"51974=2001-03-06=2001-065=2001-W10-2" + ,"51975=2001-03-07=2001-066=2001-W10-3" + ,"51976=2001-03-08=2001-067=2001-W10-4" + ,"51977=2001-03-09=2001-068=2001-W10-5" + ,"51978=2001-03-10=2001-069=2001-W10-6" + ,"51979=2001-03-11=2001-070=2001-W10-7" + ,"51980=2001-03-12=2001-071=2001-W11-1" + ,"51981=2001-03-13=2001-072=2001-W11-2" + ,"51982=2001-03-14=2001-073=2001-W11-3" + ,"51983=2001-03-15=2001-074=2001-W11-4" + ,"51984=2001-03-16=2001-075=2001-W11-5" + ,"51985=2001-03-17=2001-076=2001-W11-6" + ,"51986=2001-03-18=2001-077=2001-W11-7" + ,"51987=2001-03-19=2001-078=2001-W12-1" + ,"51988=2001-03-20=2001-079=2001-W12-2" + ,"51989=2001-03-21=2001-080=2001-W12-3" + ,"51990=2001-03-22=2001-081=2001-W12-4" + ,"51991=2001-03-23=2001-082=2001-W12-5" + ,"51992=2001-03-24=2001-083=2001-W12-6" + ,"51993=2001-03-25=2001-084=2001-W12-7" + ,"51994=2001-03-26=2001-085=2001-W13-1" + ,"51995=2001-03-27=2001-086=2001-W13-2" + ,"51996=2001-03-28=2001-087=2001-W13-3" + ,"51997=2001-03-29=2001-088=2001-W13-4" + ,"51998=2001-03-30=2001-089=2001-W13-5" + ,"51999=2001-03-31=2001-090=2001-W13-6" + ,"52000=2001-04-01=2001-091=2001-W13-7" + ,"52001=2001-04-02=2001-092=2001-W14-1" + ,"52002=2001-04-03=2001-093=2001-W14-2" + ,"52003=2001-04-04=2001-094=2001-W14-3" + ,"52004=2001-04-05=2001-095=2001-W14-4" + ,"52005=2001-04-06=2001-096=2001-W14-5" + ,"52006=2001-04-07=2001-097=2001-W14-6" + ,"52007=2001-04-08=2001-098=2001-W14-7" + ,"52008=2001-04-09=2001-099=2001-W15-1" + ,"52009=2001-04-10=2001-100=2001-W15-2" + ,"52010=2001-04-11=2001-101=2001-W15-3" + ,"52011=2001-04-12=2001-102=2001-W15-4" + ,"52012=2001-04-13=2001-103=2001-W15-5" + ,"52013=2001-04-14=2001-104=2001-W15-6" + ,"52014=2001-04-15=2001-105=2001-W15-7" + ,"52015=2001-04-16=2001-106=2001-W16-1" + ,"52016=2001-04-17=2001-107=2001-W16-2" + ,"52017=2001-04-18=2001-108=2001-W16-3" + ,"52018=2001-04-19=2001-109=2001-W16-4" + ,"52019=2001-04-20=2001-110=2001-W16-5" + ,"52020=2001-04-21=2001-111=2001-W16-6" + ,"52021=2001-04-22=2001-112=2001-W16-7" + ,"52022=2001-04-23=2001-113=2001-W17-1" + ,"52023=2001-04-24=2001-114=2001-W17-2" + ,"52024=2001-04-25=2001-115=2001-W17-3" + ,"52025=2001-04-26=2001-116=2001-W17-4" + ,"52026=2001-04-27=2001-117=2001-W17-5" + ,"52027=2001-04-28=2001-118=2001-W17-6" + ,"52028=2001-04-29=2001-119=2001-W17-7" + ,"52029=2001-04-30=2001-120=2001-W18-1" + ,"52030=2001-05-01=2001-121=2001-W18-2" + ,"52031=2001-05-02=2001-122=2001-W18-3" + ,"52032=2001-05-03=2001-123=2001-W18-4" + ,"52033=2001-05-04=2001-124=2001-W18-5" + ,"52034=2001-05-05=2001-125=2001-W18-6" + ,"52035=2001-05-06=2001-126=2001-W18-7" + ,"52036=2001-05-07=2001-127=2001-W19-1" + ,"52037=2001-05-08=2001-128=2001-W19-2" + ,"52038=2001-05-09=2001-129=2001-W19-3" + ,"52039=2001-05-10=2001-130=2001-W19-4" + ,"52040=2001-05-11=2001-131=2001-W19-5" + ,"52041=2001-05-12=2001-132=2001-W19-6" + ,"52042=2001-05-13=2001-133=2001-W19-7" + ,"52043=2001-05-14=2001-134=2001-W20-1" + ,"52044=2001-05-15=2001-135=2001-W20-2" + ,"52045=2001-05-16=2001-136=2001-W20-3" + ,"52046=2001-05-17=2001-137=2001-W20-4" + ,"52047=2001-05-18=2001-138=2001-W20-5" + ,"52048=2001-05-19=2001-139=2001-W20-6" + ,"52049=2001-05-20=2001-140=2001-W20-7" + ,"52050=2001-05-21=2001-141=2001-W21-1" + ,"52051=2001-05-22=2001-142=2001-W21-2" + ,"52052=2001-05-23=2001-143=2001-W21-3" + ,"52053=2001-05-24=2001-144=2001-W21-4" + ,"52054=2001-05-25=2001-145=2001-W21-5" + ,"52055=2001-05-26=2001-146=2001-W21-6" + ,"52056=2001-05-27=2001-147=2001-W21-7" + ,"52057=2001-05-28=2001-148=2001-W22-1" + ,"52058=2001-05-29=2001-149=2001-W22-2" + ,"52059=2001-05-30=2001-150=2001-W22-3" + ,"52060=2001-05-31=2001-151=2001-W22-4" + ,"52061=2001-06-01=2001-152=2001-W22-5" + ,"52062=2001-06-02=2001-153=2001-W22-6" + ,"52063=2001-06-03=2001-154=2001-W22-7" + ,"52064=2001-06-04=2001-155=2001-W23-1" + ,"52065=2001-06-05=2001-156=2001-W23-2" + ,"52066=2001-06-06=2001-157=2001-W23-3" + ,"52067=2001-06-07=2001-158=2001-W23-4" + ,"52068=2001-06-08=2001-159=2001-W23-5" + ,"52069=2001-06-09=2001-160=2001-W23-6" + ,"52070=2001-06-10=2001-161=2001-W23-7" + ,"52071=2001-06-11=2001-162=2001-W24-1" + ,"52072=2001-06-12=2001-163=2001-W24-2" + ,"52073=2001-06-13=2001-164=2001-W24-3" + ,"52074=2001-06-14=2001-165=2001-W24-4" + ,"52075=2001-06-15=2001-166=2001-W24-5" + ,"52076=2001-06-16=2001-167=2001-W24-6" + ,"52077=2001-06-17=2001-168=2001-W24-7" + ,"52078=2001-06-18=2001-169=2001-W25-1" + ,"52079=2001-06-19=2001-170=2001-W25-2" + ,"52080=2001-06-20=2001-171=2001-W25-3" + ,"52081=2001-06-21=2001-172=2001-W25-4" + ,"52082=2001-06-22=2001-173=2001-W25-5" + ,"52083=2001-06-23=2001-174=2001-W25-6" + ,"52084=2001-06-24=2001-175=2001-W25-7" + ,"52085=2001-06-25=2001-176=2001-W26-1" + ,"52086=2001-06-26=2001-177=2001-W26-2" + ,"52087=2001-06-27=2001-178=2001-W26-3" + ,"52088=2001-06-28=2001-179=2001-W26-4" + ,"52089=2001-06-29=2001-180=2001-W26-5" + ,"52090=2001-06-30=2001-181=2001-W26-6" + ,"52091=2001-07-01=2001-182=2001-W26-7" + ,"52092=2001-07-02=2001-183=2001-W27-1" + ,"52093=2001-07-03=2001-184=2001-W27-2" + ,"52094=2001-07-04=2001-185=2001-W27-3" + ,"52095=2001-07-05=2001-186=2001-W27-4" + ,"52096=2001-07-06=2001-187=2001-W27-5" + ,"52097=2001-07-07=2001-188=2001-W27-6" + ,"52098=2001-07-08=2001-189=2001-W27-7" + ,"52099=2001-07-09=2001-190=2001-W28-1" + ,"52100=2001-07-10=2001-191=2001-W28-2" + ,"52101=2001-07-11=2001-192=2001-W28-3" + ,"52102=2001-07-12=2001-193=2001-W28-4" + ,"52103=2001-07-13=2001-194=2001-W28-5" + ,"52104=2001-07-14=2001-195=2001-W28-6" + ,"52105=2001-07-15=2001-196=2001-W28-7" + ,"52106=2001-07-16=2001-197=2001-W29-1" + ,"52107=2001-07-17=2001-198=2001-W29-2" + ,"52108=2001-07-18=2001-199=2001-W29-3" + ,"52109=2001-07-19=2001-200=2001-W29-4" + ,"52110=2001-07-20=2001-201=2001-W29-5" + ,"52111=2001-07-21=2001-202=2001-W29-6" + ,"52112=2001-07-22=2001-203=2001-W29-7" + ,"52113=2001-07-23=2001-204=2001-W30-1" + ,"52114=2001-07-24=2001-205=2001-W30-2" + ,"52115=2001-07-25=2001-206=2001-W30-3" + ,"52116=2001-07-26=2001-207=2001-W30-4" + ,"52117=2001-07-27=2001-208=2001-W30-5" + ,"52118=2001-07-28=2001-209=2001-W30-6" + ,"52119=2001-07-29=2001-210=2001-W30-7" + ,"52120=2001-07-30=2001-211=2001-W31-1" + ,"52121=2001-07-31=2001-212=2001-W31-2" + ,"52122=2001-08-01=2001-213=2001-W31-3" + ,"52123=2001-08-02=2001-214=2001-W31-4" + ,"52124=2001-08-03=2001-215=2001-W31-5" + ,"52125=2001-08-04=2001-216=2001-W31-6" + ,"52126=2001-08-05=2001-217=2001-W31-7" + ,"52127=2001-08-06=2001-218=2001-W32-1" + ,"52128=2001-08-07=2001-219=2001-W32-2" + ,"52129=2001-08-08=2001-220=2001-W32-3" + ,"52130=2001-08-09=2001-221=2001-W32-4" + ,"52131=2001-08-10=2001-222=2001-W32-5" + ,"52132=2001-08-11=2001-223=2001-W32-6" + ,"52133=2001-08-12=2001-224=2001-W32-7" + ,"52134=2001-08-13=2001-225=2001-W33-1" + ,"52135=2001-08-14=2001-226=2001-W33-2" + ,"52136=2001-08-15=2001-227=2001-W33-3" + ,"52137=2001-08-16=2001-228=2001-W33-4" + ,"52138=2001-08-17=2001-229=2001-W33-5" + ,"52139=2001-08-18=2001-230=2001-W33-6" + ,"52140=2001-08-19=2001-231=2001-W33-7" + ,"52141=2001-08-20=2001-232=2001-W34-1" + ,"52142=2001-08-21=2001-233=2001-W34-2" + ,"52143=2001-08-22=2001-234=2001-W34-3" + ,"52144=2001-08-23=2001-235=2001-W34-4" + ,"52145=2001-08-24=2001-236=2001-W34-5" + ,"52146=2001-08-25=2001-237=2001-W34-6" + ,"52147=2001-08-26=2001-238=2001-W34-7" + ,"52148=2001-08-27=2001-239=2001-W35-1" + ,"52149=2001-08-28=2001-240=2001-W35-2" + ,"52150=2001-08-29=2001-241=2001-W35-3" + ,"52151=2001-08-30=2001-242=2001-W35-4" + ,"52152=2001-08-31=2001-243=2001-W35-5" + ,"52153=2001-09-01=2001-244=2001-W35-6" + ,"52154=2001-09-02=2001-245=2001-W35-7" + ,"52155=2001-09-03=2001-246=2001-W36-1" + ,"52156=2001-09-04=2001-247=2001-W36-2" + ,"52157=2001-09-05=2001-248=2001-W36-3" + ,"52158=2001-09-06=2001-249=2001-W36-4" + ,"52159=2001-09-07=2001-250=2001-W36-5" + ,"52160=2001-09-08=2001-251=2001-W36-6" + ,"52161=2001-09-09=2001-252=2001-W36-7" + ,"52162=2001-09-10=2001-253=2001-W37-1" + ,"52163=2001-09-11=2001-254=2001-W37-2" + ,"52164=2001-09-12=2001-255=2001-W37-3" + ,"52165=2001-09-13=2001-256=2001-W37-4" + ,"52166=2001-09-14=2001-257=2001-W37-5" + ,"52167=2001-09-15=2001-258=2001-W37-6" + ,"52168=2001-09-16=2001-259=2001-W37-7" + ,"52169=2001-09-17=2001-260=2001-W38-1" + ,"52170=2001-09-18=2001-261=2001-W38-2" + ,"52171=2001-09-19=2001-262=2001-W38-3" + ,"52172=2001-09-20=2001-263=2001-W38-4" + ,"52173=2001-09-21=2001-264=2001-W38-5" + ,"52174=2001-09-22=2001-265=2001-W38-6" + ,"52175=2001-09-23=2001-266=2001-W38-7" + ,"52176=2001-09-24=2001-267=2001-W39-1" + ,"52177=2001-09-25=2001-268=2001-W39-2" + ,"52178=2001-09-26=2001-269=2001-W39-3" + ,"52179=2001-09-27=2001-270=2001-W39-4" + ,"52180=2001-09-28=2001-271=2001-W39-5" + ,"52181=2001-09-29=2001-272=2001-W39-6" + ,"52182=2001-09-30=2001-273=2001-W39-7" + ,"52183=2001-10-01=2001-274=2001-W40-1" + ,"52184=2001-10-02=2001-275=2001-W40-2" + ,"52185=2001-10-03=2001-276=2001-W40-3" + ,"52186=2001-10-04=2001-277=2001-W40-4" + ,"52187=2001-10-05=2001-278=2001-W40-5" + ,"52188=2001-10-06=2001-279=2001-W40-6" + ,"52189=2001-10-07=2001-280=2001-W40-7" + ,"52190=2001-10-08=2001-281=2001-W41-1" + ,"52191=2001-10-09=2001-282=2001-W41-2" + ,"52192=2001-10-10=2001-283=2001-W41-3" + ,"52193=2001-10-11=2001-284=2001-W41-4" + ,"52194=2001-10-12=2001-285=2001-W41-5" + ,"52195=2001-10-13=2001-286=2001-W41-6" + ,"52196=2001-10-14=2001-287=2001-W41-7" + ,"52197=2001-10-15=2001-288=2001-W42-1" + ,"52198=2001-10-16=2001-289=2001-W42-2" + ,"52199=2001-10-17=2001-290=2001-W42-3" + ,"52200=2001-10-18=2001-291=2001-W42-4" + ,"52201=2001-10-19=2001-292=2001-W42-5" + ,"52202=2001-10-20=2001-293=2001-W42-6" + ,"52203=2001-10-21=2001-294=2001-W42-7" + ,"52204=2001-10-22=2001-295=2001-W43-1" + ,"52205=2001-10-23=2001-296=2001-W43-2" + ,"52206=2001-10-24=2001-297=2001-W43-3" + ,"52207=2001-10-25=2001-298=2001-W43-4" + ,"52208=2001-10-26=2001-299=2001-W43-5" + ,"52209=2001-10-27=2001-300=2001-W43-6" + ,"52210=2001-10-28=2001-301=2001-W43-7" + ,"52211=2001-10-29=2001-302=2001-W44-1" + ,"52212=2001-10-30=2001-303=2001-W44-2" + ,"52213=2001-10-31=2001-304=2001-W44-3" + ,"52214=2001-11-01=2001-305=2001-W44-4" + ,"52215=2001-11-02=2001-306=2001-W44-5" + ,"52216=2001-11-03=2001-307=2001-W44-6" + ,"52217=2001-11-04=2001-308=2001-W44-7" + ,"52218=2001-11-05=2001-309=2001-W45-1" + ,"52219=2001-11-06=2001-310=2001-W45-2" + ,"52220=2001-11-07=2001-311=2001-W45-3" + ,"52221=2001-11-08=2001-312=2001-W45-4" + ,"52222=2001-11-09=2001-313=2001-W45-5" + ,"52223=2001-11-10=2001-314=2001-W45-6" + ,"52224=2001-11-11=2001-315=2001-W45-7" + ,"52225=2001-11-12=2001-316=2001-W46-1" + ,"52226=2001-11-13=2001-317=2001-W46-2" + ,"52227=2001-11-14=2001-318=2001-W46-3" + ,"52228=2001-11-15=2001-319=2001-W46-4" + ,"52229=2001-11-16=2001-320=2001-W46-5" + ,"52230=2001-11-17=2001-321=2001-W46-6" + ,"52231=2001-11-18=2001-322=2001-W46-7" + ,"52232=2001-11-19=2001-323=2001-W47-1" + ,"52233=2001-11-20=2001-324=2001-W47-2" + ,"52234=2001-11-21=2001-325=2001-W47-3" + ,"52235=2001-11-22=2001-326=2001-W47-4" + ,"52236=2001-11-23=2001-327=2001-W47-5" + ,"52237=2001-11-24=2001-328=2001-W47-6" + ,"52238=2001-11-25=2001-329=2001-W47-7" + ,"52239=2001-11-26=2001-330=2001-W48-1" + ,"52240=2001-11-27=2001-331=2001-W48-2" + ,"52241=2001-11-28=2001-332=2001-W48-3" + ,"52242=2001-11-29=2001-333=2001-W48-4" + ,"52243=2001-11-30=2001-334=2001-W48-5" + ,"52244=2001-12-01=2001-335=2001-W48-6" + ,"52245=2001-12-02=2001-336=2001-W48-7" + ,"52246=2001-12-03=2001-337=2001-W49-1" + ,"52247=2001-12-04=2001-338=2001-W49-2" + ,"52248=2001-12-05=2001-339=2001-W49-3" + ,"52249=2001-12-06=2001-340=2001-W49-4" + ,"52250=2001-12-07=2001-341=2001-W49-5" + ,"52251=2001-12-08=2001-342=2001-W49-6" + ,"52252=2001-12-09=2001-343=2001-W49-7" + ,"52253=2001-12-10=2001-344=2001-W50-1" + ,"52254=2001-12-11=2001-345=2001-W50-2" + ,"52255=2001-12-12=2001-346=2001-W50-3" + ,"52256=2001-12-13=2001-347=2001-W50-4" + ,"52257=2001-12-14=2001-348=2001-W50-5" + ,"52258=2001-12-15=2001-349=2001-W50-6" + ,"52259=2001-12-16=2001-350=2001-W50-7" + ,"52260=2001-12-17=2001-351=2001-W51-1" + ,"52261=2001-12-18=2001-352=2001-W51-2" + ,"52262=2001-12-19=2001-353=2001-W51-3" + ,"52263=2001-12-20=2001-354=2001-W51-4" + ,"52264=2001-12-21=2001-355=2001-W51-5" + ,"52265=2001-12-22=2001-356=2001-W51-6" + ,"52266=2001-12-23=2001-357=2001-W51-7" + ,"52267=2001-12-24=2001-358=2001-W52-1" + ,"52268=2001-12-25=2001-359=2001-W52-2" + ,"52269=2001-12-26=2001-360=2001-W52-3" + ,"52270=2001-12-27=2001-361=2001-W52-4" + ,"52271=2001-12-28=2001-362=2001-W52-5" + ,"52272=2001-12-29=2001-363=2001-W52-6" + ,"52273=2001-12-30=2001-364=2001-W52-7" + ,"52274=2001-12-31=2001-365=2002-W01-1" + ,"52275=2002-01-01=2002-001=2002-W01-2" + ,"52276=2002-01-02=2002-002=2002-W01-3" + ,"52277=2002-01-03=2002-003=2002-W01-4" + ,"52278=2002-01-04=2002-004=2002-W01-5" + ,"52279=2002-01-05=2002-005=2002-W01-6" + ,"52280=2002-01-06=2002-006=2002-W01-7" + ,"" + ,"51178=1998-12-31=1998-365=1998-W53-4" + ,"" + ,"1998-12-31 23:59:60.5" + ,"51178,86400.5s" + ,"1998-12-31 15:59:60.5" + ,"51178,86400.5s" + ,"" + ,"2000-03-01 00:00:00" + ,"2000-03-01 12:00:00" + ,"2000-02-29 16:00:00" + ,"2000-03-01 04:00:00" + ,"2000-03-01 08:00:00" + ,"2000-03-01 20:00:00" + ,"" + ,"12:34:56.789" + ,"12:34:56.789123" + ,"12:34:56.789123456" + ,"12:34:56.789123456789" + ,"" ] diff --git a/test/main/Test/TestUtil.hs b/test/main/Test/TestUtil.hs new file mode 100644 --- /dev/null +++ b/test/main/Test/TestUtil.hs @@ -0,0 +1,37 @@ +{-# OPTIONS -fno-warn-overlapping-patterns #-} +module Test.TestUtil where + +import Test.QuickCheck.Property +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +assertFailure' :: String -> IO a +assertFailure' s = do + assertFailure s + return undefined + +assertJust :: Maybe a -> IO a +assertJust (Just a) = return a +assertJust Nothing = assertFailure' "Nothing" + +class NameTest a where + nameTest :: String -> a -> TestTree + +instance NameTest [TestTree] where + nameTest = testGroup + +instance NameTest Assertion where + nameTest = testCase + +instance NameTest Property where + nameTest = testProperty + +instance NameTest Result where + nameTest name = nameTest name . property + +instance (Arbitrary a,Show a,Testable b) => NameTest (a -> b) where + nameTest name = nameTest name . property + +tgroup :: (Show a,NameTest t) => [a] -> (a -> t) -> [TestTree] +tgroup aa f = fmap (\a -> nameTest (show a) $ f a) aa diff --git a/test/unix/Main.hs b/test/unix/Main.hs new file mode 100644 --- /dev/null +++ b/test/unix/Main.hs @@ -0,0 +1,24 @@ +module Main where + +import Foreign.C.Types +import Test.Tasty +import Test.Format.Format +import Test.LocalTime.TimeZone + + +tests :: TestTree +tests = testGroup "Time" [ + testGroup "Format" [ + testFormat + ], + testGroup "LocalTime" [ + testTimeZone + ] + ] + +main :: IO () +main = do + if (toRational (1000000000000 :: CTime)) /= (1000000000000 :: Rational) + then putStrLn "WARNING: Some tests will incorrectly fail due to a 32-bit time_t C type." + else return () + defaultMain tests diff --git a/test/unix/Test/Format/Format.hs b/test/unix/Test/Format/Format.hs new file mode 100644 --- /dev/null +++ b/test/unix/Test/Format/Format.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Test.Format.Format(testFormat) where + +import Data.Time +import Data.Time.Clock.POSIX +import Data.Char +import Data.Fixed +import Foreign +import Foreign.C +import Test.QuickCheck hiding (Result) +import Test.QuickCheck.Property +import Test.Tasty +import Test.Tasty.HUnit +import Test.TestUtil +import System.IO.Unsafe + +{- + size_t format_time ( + char *s, size_t maxsize, + const char *format, + int isdst,int gmtoff,time_t t); +-} + +foreign import ccall unsafe "FormatStuff.h format_time" format_time :: CString -> CSize -> CString -> CInt -> CInt -> CString -> CTime -> IO CSize + +withBuffer :: Int -> (CString -> IO CSize) -> IO String +withBuffer n f = withArray (replicate n 0) (\buffer -> do + len <- f buffer + peekCStringLen (buffer,fromIntegral len) + ) + +unixFormatTime :: String -> TimeZone -> UTCTime -> String +unixFormatTime fmt zone time = unsafePerformIO $ withCString fmt (\pfmt -> withCString (timeZoneName zone) (\pzonename -> + withBuffer 100 (\buffer -> format_time buffer 100 pfmt + (if timeZoneSummerOnly zone then 1 else 0) + (fromIntegral (timeZoneMinutes zone * 60)) + pzonename + (fromInteger (truncate (utcTimeToPOSIXSeconds time))) + ) + )) + +locale :: TimeLocale +locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"} + +zones :: Gen TimeZone +zones = do + mins <- choose (-2000,2000) + dst <- arbitrary + hasName <- arbitrary + let + name = if hasName then "ZONE" else "" + return $ TimeZone mins dst name + +times :: Gen UTCTime +times = do + day <- choose (-25000,75000) + time <- return midnight + return $ localTimeToUTC utc $ LocalTime (ModifiedJulianDay day) time + +padN :: Int -> Char -> String -> String +padN n _ s | n <= (length s) = s +padN n c s = (replicate (n - length s) c) ++ s + +unixWorkarounds :: String -> String -> String +unixWorkarounds "%_Y" s = padN 4 ' ' s +unixWorkarounds "%0Y" s = padN 4 '0' s +unixWorkarounds "%_C" s = padN 2 ' ' s +unixWorkarounds "%0C" s = padN 2 '0' s +unixWorkarounds "%_G" s = padN 4 ' ' s +unixWorkarounds "%0G" s = padN 4 '0' s +unixWorkarounds "%_f" s = padN 2 ' ' s +unixWorkarounds "%0f" s = padN 2 '0' s +unixWorkarounds fmt s | elem 'z' fmt = dropWhile isPadChar s where + isPadChar ' ' = True + isPadChar '0' = True + isPadChar _ = False +unixWorkarounds _ s = s + +compareFormat :: (String -> String) -> String -> TimeZone -> UTCTime -> Result +compareFormat _modUnix fmt zone _time | last fmt == 'Z' && timeZoneName zone == "" = rejected +compareFormat modUnix fmt zone time = let + ctime = utcToZonedTime zone time + haskellText = formatTime locale fmt ctime + unixText = unixFormatTime fmt zone time + expectedText = unixWorkarounds fmt (modUnix unixText) + in assertEqualQC "" expectedText haskellText + +-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html +-- plus FgGklz +-- f not supported +-- P not always supported +-- s time-zone dependent +chars :: [Char] +chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%" + +-- as found in "man strftime" on a glibc system. '#' is different, though +modifiers :: [String] +modifiers = ["","_","-","0","^"] + +widths :: [String] +widths = ["","1","2","9","12"] + +formats :: [String] +formats = ["%G-W%V-%u","%U-%w","%W-%u"] + ++ (do + char <- chars + width <- widths + modifier <- modifiers + return $ "%" ++ modifier ++ width ++ [char] + ) + +hashformats :: [String] +hashformats = do + char <- chars + return $ "%#"++[char] + +testCompareFormat :: [TestTree] +testCompareFormat = tgroup formats $ \fmt -> do + time <- times + zone <- zones + return $ compareFormat id fmt zone time + +testCompareHashFormat :: [TestTree] +testCompareHashFormat = tgroup hashformats $ \fmt -> do + time <- times + zone <- zones + return $ compareFormat (fmap toLower) fmt zone time + +formatUnitTest :: String -> Pico -> String -> TestTree +formatUnitTest fmt sec expected = nameTest (show fmt) $ let + tod = TimeOfDay 0 0 (1 + sec) + found = formatTime locale fmt tod + in assertEqual "" expected found + +testQs :: [TestTree] +testQs = [ + formatUnitTest "%q" 0 "000000000000", + formatUnitTest "%q" 0.37 "370000000000", + formatUnitTest "%0q" 0 "000000000000", + formatUnitTest "%0q" 0.37 "370000000000", + formatUnitTest "%_q" 0 " ", + formatUnitTest "%_q" 0.37 "37 ", + formatUnitTest "%-q" 0 "", + formatUnitTest "%-q" 0.37 "37", + formatUnitTest "%1q" 0 "0", + formatUnitTest "%1q" 0.37 "3", + formatUnitTest "%01q" 0 "0", + formatUnitTest "%01q" 0.37 "3", + formatUnitTest "%_1q" 0 " ", + formatUnitTest "%_1q" 0.37 "3", + formatUnitTest "%-1q" 0 " ", + formatUnitTest "%-1q" 0.37 "3", + formatUnitTest "%5q" 0 "00000", + formatUnitTest "%5q" 0.37 "37000", + formatUnitTest "%05q" 0 "00000", + formatUnitTest "%05q" 0.37 "37000", + formatUnitTest "%_5q" 0 " ", + formatUnitTest "%_5q" 0.37 "37 ", + formatUnitTest "%-5q" 0 " ", + formatUnitTest "%-5q" 0.37 "37 ", + + formatUnitTest "%Q" 0 ".", + formatUnitTest "%Q" 0.37 ".37", + formatUnitTest "%0Q" 0 ".000000000000", + formatUnitTest "%0Q" 0.37 ".370000000000", + formatUnitTest "%_Q" 0 ". ", + formatUnitTest "%_Q" 0.37 ".37 ", + formatUnitTest "%-Q" 0 ".", + formatUnitTest "%-Q" 0.37 ".37", + formatUnitTest "%1Q" 0 ".0", + formatUnitTest "%1Q" 0.37 ".3", + formatUnitTest "%01Q" 0 ".0", + formatUnitTest "%01Q" 0.37 ".3", + formatUnitTest "%_1Q" 0 ". ", + formatUnitTest "%_1Q" 0.37 ".3", + formatUnitTest "%-1Q" 0 ". ", + formatUnitTest "%-1Q" 0.37 ".3", + formatUnitTest "%5Q" 0 ".00000", + formatUnitTest "%5Q" 0.37 ".37000", + formatUnitTest "%05Q" 0 ".00000", + formatUnitTest "%05Q" 0.37 ".37000", + formatUnitTest "%_5Q" 0 ". ", + formatUnitTest "%_5Q" 0.37 ".37 ", + formatUnitTest "%-5Q" 0 ". ", + formatUnitTest "%-5Q" 0.37 ".37 " + ] + +testFormat :: TestTree +testFormat = testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs diff --git a/test/unix/Test/Format/FormatStuff.c b/test/unix/Test/Format/FormatStuff.c new file mode 100644 --- /dev/null +++ b/test/unix/Test/Format/FormatStuff.c @@ -0,0 +1,15 @@ +#include "FormatStuff.h" + +size_t format_time ( + char* buffer, size_t maxsize, + const char* format, + int isdst,int gmtoff,char* zonename,time_t t) +{ + t += gmtoff; + struct tm tmd; + gmtime_r(&t,&tmd); + tmd.tm_isdst = isdst; + tmd.tm_gmtoff = gmtoff; + tmd.tm_zone = zonename; + return strftime(buffer,maxsize,format,&tmd); +} diff --git a/test/unix/Test/Format/FormatStuff.h b/test/unix/Test/Format/FormatStuff.h new file mode 100644 --- /dev/null +++ b/test/unix/Test/Format/FormatStuff.h @@ -0,0 +1,6 @@ +#include + +size_t format_time ( + char *s, size_t maxsize, + const char *format, + int isdst,int gmtoff,char* zonename,time_t t); diff --git a/test/unix/Test/LocalTime/TimeZone.hs b/test/unix/Test/LocalTime/TimeZone.hs new file mode 100644 --- /dev/null +++ b/test/unix/Test/LocalTime/TimeZone.hs @@ -0,0 +1,17 @@ +{-# OPTIONS -Wall -Werror #-} + +module Test.LocalTime.TimeZone(testTimeZone) where + +import Data.Time +import System.Posix.Env (putEnv) +import Test.Tasty +import Test.Tasty.HUnit + +testTimeZone :: TestTree +testTimeZone = testCase "getTimeZone respects TZ env var" $ do + let epoch = UTCTime (ModifiedJulianDay 0) 0 + putEnv "TZ=UTC+0" + zone1 <- getTimeZone epoch + putEnv "TZ=EST+5" + zone2 <- getTimeZone epoch + assertBool "zone not changed" $ zone1 /= zone2 diff --git a/test/unix/Test/TestUtil.hs b/test/unix/Test/TestUtil.hs new file mode 100644 --- /dev/null +++ b/test/unix/Test/TestUtil.hs @@ -0,0 +1,45 @@ +{-# OPTIONS -fno-warn-overlapping-patterns #-} +module Test.TestUtil where + +import Test.QuickCheck.Property +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck hiding (reason) + +assertFailure' :: String -> IO a +assertFailure' s = do + assertFailure s + return undefined + +assertJust :: Maybe a -> IO a +assertJust (Just a) = return a +assertJust Nothing = assertFailure' "Nothing" + +class NameTest a where + nameTest :: String -> a -> TestTree + +instance NameTest [TestTree] where + nameTest = testGroup + +instance NameTest Assertion where + nameTest = testCase + +instance NameTest Property where + nameTest = testProperty + +instance NameTest Result where + nameTest name = nameTest name . property + +instance (Arbitrary a,Show a,Testable b) => NameTest (a -> b) where + nameTest name = nameTest name . property + +instance (Testable a) => NameTest (Gen a) where + nameTest name = nameTest name . property + +tgroup :: (Show a,NameTest t) => [a] -> (a -> t) -> [TestTree] +tgroup aa f = fmap (\a -> nameTest (show a) $ f a) aa + +assertEqualQC :: (Show a,Eq a) => String -> a -> a -> Result +assertEqualQC _name expected found | expected == found = succeeded +assertEqualQC "" expected found = failed{reason="expected "++show expected++", found "++show found} +assertEqualQC name expected found = failed{reason=name++": expected "++show expected++", found "++show found} diff --git a/time.cabal b/time.cabal --- a/time.cabal +++ b/time.cabal @@ -1,5 +1,5 @@ name: time -version: 1.7.0.1 +version: 1.8 stability: stable license: BSD3 license-file: LICENSE @@ -9,7 +9,7 @@ bug-reports: https://github.com/haskell/time/issues synopsis: A time library description: A time library -category: System +category: Time build-type: Configure cabal-version: >=1.10 tested-with: GHC == 8.0.1, GHC == 7.10.3, GHC == 7.8.4 @@ -23,8 +23,8 @@ lib/include/HsConfigure.h lib/include/HsTime.h lib/include/HsTimeConfig.h.in - test/Test/*.c - test/Test/*.h + test/unix/Test/Format/*.c + test/unix/Test/Format/*.h extra-tmp-files: config.log config.status @@ -62,6 +62,7 @@ Data.Time.Calendar.Julian, Data.Time.Calendar.Easter, Data.Time.Clock, + Data.Time.Clock.System, Data.Time.Clock.POSIX, Data.Time.Clock.TAI, Data.Time.LocalTime, @@ -74,14 +75,20 @@ Data.Time.Calendar.Days, Data.Time.Calendar.Gregorian, Data.Time.Calendar.JulianYearDay, - Data.Time.Clock.Scale, - Data.Time.Clock.UTC, - Data.Time.Clock.CTimeval, - Data.Time.Clock.CTimespec, - Data.Time.Clock.UTCDiff, - Data.Time.LocalTime.TimeZone, - Data.Time.LocalTime.TimeOfDay, - Data.Time.LocalTime.LocalTime, + Data.Time.Clock.Internal.DiffTime, + Data.Time.Clock.Internal.AbsoluteTime, + Data.Time.Clock.Internal.NominalDiffTime, + Data.Time.Clock.Internal.POSIXTime, + Data.Time.Clock.Internal.UniversalTime, + Data.Time.Clock.Internal.SystemTime, + Data.Time.Clock.Internal.UTCTime, + Data.Time.Clock.Internal.CTimeval, + Data.Time.Clock.Internal.CTimespec, + Data.Time.Clock.Internal.UTCDiff, + Data.Time.LocalTime.Internal.TimeZone, + Data.Time.LocalTime.Internal.TimeOfDay, + Data.Time.LocalTime.Internal.LocalTime, + Data.Time.LocalTime.Internal.ZonedTime, Data.Time.Format.Parse Data.Time.Format.Locale include-dirs: lib/include @@ -103,9 +110,9 @@ time main-is: ShowDefaultTZAbbreviations.hs -test-suite tests +test-suite test-main type: exitcode-stdio-1.0 - hs-source-dirs: test + hs-source-dirs: test/main default-language: Haskell2010 default-extensions: Rank2Types @@ -118,36 +125,69 @@ UndecidableInstances ScopedTypeVariables ghc-options: -Wall -fwarn-tabs - c-sources: test/Test/TestFormatStuff.c build-depends: base, deepseq, time, - QuickCheck >= 2.5.1, - test-framework >= 0.8, - test-framework-quickcheck2 >= 0.3, - unix - main-is: Test.hs + QuickCheck, + tasty, + tasty-hunit, + tasty-quickcheck + main-is: Main.hs other-modules: - Test.Tests - Test.TestTime - Test.TestTimeRef - Test.TestParseTime - Test.TestMonthDay - Test.TestMonthDayRef - Test.TestFormat - Test.TestEaster - Test.TestEasterRef - Test.TestCalendars - Test.TestCalendarsRef - Test.TestTAI - Test.TestTimeZone - Test.TestValid - Test.LongWeekYears - Test.LongWeekYearsRef - Test.ConvertBack - Test.ClipDates - Test.ClipDatesRef - Test.AddDays - Test.AddDaysRef Test.TestUtil + Test.Calendar.AddDays + Test.Calendar.AddDaysRef + Test.Calendar.Calendars + Test.Calendar.CalendarsRef + Test.Calendar.ClipDates + Test.Calendar.ClipDatesRef + Test.Calendar.ConvertBack + Test.Calendar.Easter + Test.Calendar.EasterRef + Test.Calendar.LongWeekYears + Test.Calendar.LongWeekYearsRef + Test.Calendar.MonthDay + Test.Calendar.MonthDayRef + Test.Calendar.Valid + Test.Clock.Conversion + Test.Clock.Resolution + Test.Clock.TAI + Test.Format.Format + Test.Format.ParseTime + Test.LocalTime.Time + Test.LocalTime.TimeRef + +test-suite test-unix + if os(windows) + buildable: False + type: exitcode-stdio-1.0 + hs-source-dirs: test/unix + default-language: Haskell2010 + default-extensions: + Rank2Types + CPP + DeriveDataTypeable + StandaloneDeriving + ExistentialQuantification + MultiParamTypeClasses + FlexibleInstances + UndecidableInstances + ScopedTypeVariables + ghc-options: -Wall -fwarn-tabs + c-sources: test/unix/Test/Format/FormatStuff.c + build-depends: + base, + deepseq, + time, + QuickCheck, + tasty, + tasty-hunit, + tasty-quickcheck + if !os(windows) + build-depends: unix + main-is: Main.hs + other-modules: + Test.TestUtil + Test.Format.Format + Test.LocalTime.TimeZone