time-compat-1.9.3/0000755000000000000000000000000007346545000012134 5ustar0000000000000000time-compat-1.9.3/CHANGELOG.md0000755000000000000000000000016207346545000013747 0ustar0000000000000000# 1.9.3 - Include `pastMidnight` and `sinceMidnight` aliases (backported from `time-1.10`) - Support `time-1.10` time-compat-1.9.3/LICENSE0000644000000000000000000000300307346545000013135 0ustar0000000000000000Copyright (c) 2019 time contibutors, Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. time-compat-1.9.3/src/Data/0000755000000000000000000000000007346545000013574 5ustar0000000000000000time-compat-1.9.3/src/Data/Format.hs0000644000000000000000000001621007346545000015360 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Format ( Productish(..) , Summish(..) , parseReader , Format(..) , formatShow , formatParseM , isoMap , mapMFormat , filterFormat , clipFormat , enumMap , literalFormat , specialCaseShowFormat , specialCaseFormat , optionalFormat , casesFormat , optionalSignFormat , mandatorySignFormat , SignOption(..) , integerFormat , decimalFormat ) where #if MIN_VERSION_base(4,9,0) import Control.Monad.Fail import Prelude hiding (fail) #endif #if MIN_VERSION_base(4,8,0) import Data.Void #endif import Data.Char import Text.ParserCombinators.ReadP #if MIN_VERSION_base(4,8,0) #else data Void absurd :: Void -> a absurd v = seq v $ error "absurd" #endif class IsoVariant f where isoMap :: (a -> b) -> (b -> a) -> f a -> f b enumMap :: (IsoVariant f,Enum a) => f Int -> f a enumMap = isoMap toEnum fromEnum infixr 3 <**>, **>, <** class IsoVariant f => Productish f where pUnit :: f () (<**>) :: f a -> f b -> f (a,b) (**>) :: f () -> f a -> f a fu **> fa = isoMap (\((),a) -> a) (\a -> ((),a)) $ fu <**> fa (<**) :: f a -> f () -> f a fa <** fu = isoMap (\(a,()) -> a) (\a -> (a,())) $ fa <**> fu infixr 2 <++> class IsoVariant f => Summish f where pVoid :: f Void (<++>) :: f a -> f b -> f (Either a b) parseReader :: ( #if MIN_VERSION_base(4,9,0) MonadFail m #else Monad m #endif ) => ReadP t -> String -> m t parseReader readp s = case [ t | (t,"") <- readP_to_S readp s] of [t] -> return t [] -> fail $ "no parse of " ++ show s _ -> fail $ "multiple parses of " ++ show s -- | A text format for a type data Format t = MkFormat { formatShowM :: t -> Maybe String -- ^ Show a value in the format, if representable , formatReadP :: ReadP t -- ^ Read a value in the format } -- | Show a value in the format, or error if unrepresentable formatShow :: Format t -> t -> String formatShow fmt t = case formatShowM fmt t of Just str -> str Nothing -> error "formatShow: bad value" -- | Parse a value in the format formatParseM :: ( #if MIN_VERSION_base(4,9,0) MonadFail m #else Monad m #endif ) => Format t -> String -> m t formatParseM format = parseReader $ formatReadP format instance IsoVariant Format where isoMap ab ba (MkFormat sa ra) = MkFormat (\b -> sa $ ba b) (fmap ab ra) mapMFormat :: (a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b mapMFormat amb bma (MkFormat sa ra) = MkFormat (\b -> bma b >>= sa) $ do a <- ra case amb a of Just b -> return b Nothing -> pfail filterFormat :: (a -> Bool) -> Format a -> Format a filterFormat test = mapMFormat (\a -> if test a then Just a else Nothing) (\a -> if test a then Just a else Nothing) -- | Limits are inclusive clipFormat :: Ord a => (a,a) -> Format a -> Format a clipFormat (lo,hi) = filterFormat (\a -> a >= lo && a <= hi) instance Productish Format where pUnit = MkFormat {formatShowM = \_ -> Just "", formatReadP = return ()} (<**>) (MkFormat sa ra) (MkFormat sb rb) = let sab (a, b) = do astr <- sa a bstr <- sb b return $ astr ++ bstr rab = do a <- ra b <- rb return (a, b) in MkFormat sab rab (MkFormat sa ra) **> (MkFormat sb rb) = let s b = do astr <- sa () bstr <- sb b return $ astr ++ bstr r = do ra rb in MkFormat s r (MkFormat sa ra) <** (MkFormat sb rb) = let s a = do astr <- sa a bstr <- sb () return $ astr ++ bstr r = do a <- ra rb return a in MkFormat s r instance Summish Format where pVoid = MkFormat absurd pfail (MkFormat sa ra) <++> (MkFormat sb rb) = let sab (Left a) = sa a sab (Right b) = sb b rab = (fmap Left ra) +++ (fmap Right rb) in MkFormat sab rab literalFormat :: String -> Format () literalFormat s = MkFormat {formatShowM = \_ -> Just s, formatReadP = string s >> return ()} specialCaseShowFormat :: Eq a => (a,String) -> Format a -> Format a specialCaseShowFormat (val,str) (MkFormat s r) = let s' t | t == val = Just str s' t = s t in MkFormat s' r specialCaseFormat :: Eq a => (a,String) -> Format a -> Format a specialCaseFormat (val,str) (MkFormat s r) = let s' t | t == val = Just str s' t = s t r' = (string str >> return val) +++ r in MkFormat s' r' optionalFormat :: Eq a => a -> Format a -> Format a optionalFormat val = specialCaseFormat (val,"") casesFormat :: Eq a => [(a,String)] -> Format a casesFormat pairs = let s t = lookup t pairs r [] = pfail r ((v,str):pp) = (string str >> return v) <++ r pp in MkFormat s $ r pairs optionalSignFormat :: (Eq t,Num t) => Format t optionalSignFormat = casesFormat [ (1,""), (1,"+"), (0,""), (-1,"-") ] mandatorySignFormat :: (Eq t,Num t) => Format t mandatorySignFormat = casesFormat [ (1,"+"), (0,"+"), (-1,"-") ] data SignOption = NoSign | NegSign | PosNegSign readSign :: Num t => SignOption -> ReadP (t -> t) readSign NoSign = return id readSign NegSign = option id $ char '-' >> return negate readSign PosNegSign = (char '+' >> return id) +++ (char '-' >> return negate) readNumber :: (Num t, Read t) => SignOption -> Maybe Int -> Bool -> ReadP t readNumber signOpt mdigitcount allowDecimal = do sign <- readSign signOpt digits <- case mdigitcount of Just digitcount -> count digitcount $ satisfy isDigit Nothing -> many1 $ satisfy isDigit moredigits <- case allowDecimal of False -> return "" True -> option "" $ do _ <- char '.' +++ char ',' dd <- many1 (satisfy isDigit) return $ '.' : dd return $ sign $ read $ digits ++ moredigits zeroPad :: Maybe Int -> String -> String zeroPad Nothing s = s zeroPad (Just i) s = replicate (i - length s) '0' ++ s trimTrailing :: String -> String trimTrailing "" = "" trimTrailing "." = "" trimTrailing s | last s == '0' = trimTrailing $ init s trimTrailing s = s showNumber :: Show t => SignOption -> Maybe Int -> t -> Maybe String showNumber signOpt mdigitcount t = let showIt str = let (intPart, decPart) = break ((==) '.') str in (zeroPad mdigitcount intPart) ++ trimTrailing decPart in case show t of ('-':str) -> case signOpt of NoSign -> Nothing _ -> Just $ '-' : showIt str str -> Just $ case signOpt of PosNegSign -> '+' : showIt str _ -> showIt str integerFormat :: (Show t,Read t,Num t) => SignOption -> Maybe Int -> Format t integerFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readNumber signOpt mdigitcount False) decimalFormat :: (Show t,Read t,Num t) => SignOption -> Maybe Int -> Format t decimalFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readNumber signOpt mdigitcount True) time-compat-1.9.3/src/Data/Time/Calendar/0000755000000000000000000000000007346545000016203 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/Compat.hs0000644000000000000000000001466207346545000017773 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Data.Time.Calendar.Compat ( -- * Days Day(..),addDays,diffDays, -- * CalendarDiffTime CalendarDiffDays (..), calendarDay,calendarWeek,calendarMonth,calendarYear,scaleCalendarDiffDays, -- * Gregorian calendar toGregorian,fromGregorian,fromGregorianValid,showGregorian,gregorianMonthLength, -- calendrical arithmetic -- e.g. "one month after March 31st" addGregorianMonthsClip,addGregorianMonthsRollOver, addGregorianYearsClip,addGregorianYearsRollOver, addGregorianDurationClip,addGregorianDurationRollOver, diffGregorianDurationClip,diffGregorianDurationRollOver, -- re-exported from OrdinalDate isLeapYear , -- * Week DayOfWeek(..), dayOfWeek, ) where import Data.Time.Calendar import Data.Time.Format import Data.Time.Orphans () #if !MIN_VERSION_time(1,5,0) import System.Locale (TimeLocale (..)) #endif import Data.Data (Data, Typeable) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) ------------------------------------------------------------------------------- -- CalendarDiffTime ------------------------------------------------------------------------------- #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_base(1,9,2) deriving instance Typeable CalendarDiffDays deriving instance Data CalendarDiffDays #endif #if !MIN_VERSION_time(1,9,0) data CalendarDiffDays = CalendarDiffDays { cdMonths :: Integer , cdDays :: Integer } deriving (Eq, Data #if __GLASGOW_HASKELL__ >= 802 #endif ,Typeable #if __GLASGOW_HASKELL__ >= 802 #endif ) -- | Additive instance Semigroup CalendarDiffDays where CalendarDiffDays m1 d1 <> CalendarDiffDays m2 d2 = CalendarDiffDays (m1 + m2) (d1 + d2) -- | Additive instance Monoid CalendarDiffDays where mempty = CalendarDiffDays 0 0 mappend = (<>) instance Show CalendarDiffDays where show (CalendarDiffDays m d) = "P" ++ show m ++ "M" ++ show d ++ "D" calendarDay :: CalendarDiffDays calendarDay = CalendarDiffDays 0 1 calendarWeek :: CalendarDiffDays calendarWeek = CalendarDiffDays 0 7 calendarMonth :: CalendarDiffDays calendarMonth = CalendarDiffDays 1 0 calendarYear :: CalendarDiffDays calendarYear = CalendarDiffDays 12 0 -- | Scale by a factor. Note that @scaleCalendarDiffDays (-1)@ will not perfectly invert a duration, due to variable month lengths. scaleCalendarDiffDays :: Integer -> CalendarDiffDays -> CalendarDiffDays scaleCalendarDiffDays k (CalendarDiffDays m d) = CalendarDiffDays (k * m) (k * d) #endif ------------------------------------------------------------------------------- -- Gregorian ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,9,0) -- | Add months (clipped to last day), then add days addGregorianDurationClip :: CalendarDiffDays -> Day -> Day addGregorianDurationClip (CalendarDiffDays m d) day = addDays d $ addGregorianMonthsClip m day -- | Add months (rolling over to next month), then add days addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day addGregorianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addGregorianMonthsRollOver m day -- | Calendrical difference, with as many whole months as possible diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays diffGregorianDurationClip day2 day1 = let (y1,m1,d1) = toGregorian day1 (y2,m2,d2) = toGregorian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 ymAllowed = if day2 >= day1 then if d2 >= d1 then ymdiff else ymdiff - 1 else if d2 <= d1 then ymdiff else ymdiff + 1 dayAllowed = addGregorianDurationClip (CalendarDiffDays ymAllowed 0) day1 in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed -- | Calendrical difference, with as many whole months as possible. -- Same as 'diffGregorianDurationClip' for positive durations. diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays diffGregorianDurationRollOver day2 day1 = let (y1,m1,d1) = toGregorian day1 (y2,m2,d2) = toGregorian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 ymAllowed = if day2 >= day1 then if d2 >= d1 then ymdiff else ymdiff - 1 else if d2 <= d1 then ymdiff else ymdiff + 1 dayAllowed = addGregorianDurationRollOver (CalendarDiffDays ymAllowed 0) day1 in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed #endif ------------------------------------------------------------------------------- -- DayOfWeek ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,9,0) data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday deriving (Eq, Show, Read, Typeable) -- | \"Circular\", so for example @[Tuesday ..]@ gives an endless sequence. -- Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday], and 'toEnum' performs mod 7 to give a cycle of days. instance Enum DayOfWeek where toEnum i = case mod i 7 of 0 -> Sunday 1 -> Monday 2 -> Tuesday 3 -> Wednesday 4 -> Thursday 5 -> Friday _ -> Saturday fromEnum Monday = 1 fromEnum Tuesday = 2 fromEnum Wednesday = 3 fromEnum Thursday = 4 fromEnum Friday = 5 fromEnum Saturday = 6 fromEnum Sunday = 7 enumFromTo wd1 wd2 | wd1 == wd2 = [wd1] enumFromTo wd1 wd2 = wd1 : enumFromTo (succ wd1) wd2 enumFromThenTo wd1 wd2 wd3 | wd2 == wd3 = [wd1, wd2] enumFromThenTo wd1 wd2 wd3 = wd1 : enumFromThenTo wd2 (toEnum $ (2 * fromEnum wd2) - (fromEnum wd1)) wd3 dayOfWeek :: Day -> DayOfWeek dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3 toSomeDay :: DayOfWeek -> Day toSomeDay d = ModifiedJulianDay (fromIntegral $ fromEnum d + 4) #if MIN_VERSION_time(1,8,0) #define FORMAT_OPTS tl mpo i #else #define FORMAT_OPTS tl mpo #endif instance FormatTime DayOfWeek where formatCharacter 'u' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'u') formatCharacter 'w' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'w') formatCharacter 'a' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'a') formatCharacter 'A' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'A') formatCharacter _ = Nothing #endif time-compat-1.9.3/src/Data/Time/Calendar/Easter/0000755000000000000000000000000007346545000017426 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/Easter/Compat.hs0000644000000000000000000000032607346545000021206 0ustar0000000000000000module Data.Time.Calendar.Easter.Compat ( sundayAfter, orthodoxPaschalMoon,orthodoxEaster, gregorianPaschalMoon,gregorianEaster )where import Data.Time.Orphans () import Data.Time.Calendar.Easter time-compat-1.9.3/src/Data/Time/Calendar/Julian/0000755000000000000000000000000007346545000017425 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/Julian/Compat.hs0000644000000000000000000000450307346545000021206 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.Julian.Compat ( toJulianYearAndDay, fromJulianYearAndDay, fromJulianYearAndDayValid, showJulianYearAndDay, isJulianLeapYear, toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength, -- calendrical arithmetic -- e.g. "one month after March 31st" addJulianMonthsClip,addJulianMonthsRollOver, addJulianYearsClip,addJulianYearsRollOver, addJulianDurationClip,addJulianDurationRollOver, diffJulianDurationClip,diffJulianDurationRollOver, ) where import Data.Time.Orphans () import Data.Time.Calendar.Julian import Data.Time.Calendar.Compat #if !MIN_VERSION_time(1,9,0) -- | Add months (clipped to last day), then add days addJulianDurationClip :: CalendarDiffDays -> Day -> Day addJulianDurationClip (CalendarDiffDays m d) day = addDays d $ addJulianMonthsClip m day -- | Add months (rolling over to next month), then add days addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day addJulianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addJulianMonthsRollOver m day -- | Calendrical difference, with as many whole months as possible diffJulianDurationClip :: Day -> Day -> CalendarDiffDays diffJulianDurationClip day2 day1 = let (y1,m1,d1) = toJulian day1 (y2,m2,d2) = toJulian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 ymAllowed = if day2 >= day1 then if d2 >= d1 then ymdiff else ymdiff - 1 else if d2 <= d1 then ymdiff else ymdiff + 1 dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1 in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed -- | Calendrical difference, with as many whole months as possible. -- Same as 'diffJulianDurationClip' for positive durations. diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays diffJulianDurationRollOver day2 day1 = let (y1,m1,d1) = toJulian day1 (y2,m2,d2) = toJulian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 ymAllowed = if day2 >= day1 then if d2 >= d1 then ymdiff else ymdiff - 1 else if d2 <= d1 then ymdiff else ymdiff + 1 dayAllowed = addJulianDurationRollOver (CalendarDiffDays ymAllowed 0) day1 in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed #endif time-compat-1.9.3/src/Data/Time/Calendar/MonthDay/0000755000000000000000000000000007346545000017726 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/MonthDay/Compat.hs0000644000000000000000000000032407346545000021504 0ustar0000000000000000module Data.Time.Calendar.MonthDay.Compat ( monthAndDayToDayOfYear,monthAndDayToDayOfYearValid,dayOfYearToMonthAndDay,monthLength, ) where import Data.Time.Orphans () import Data.Time.Calendar.MonthDay time-compat-1.9.3/src/Data/Time/Calendar/OrdinalDate/0000755000000000000000000000000007346545000020371 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/OrdinalDate/Compat.hs0000644000000000000000000000057707346545000022161 0ustar0000000000000000module Data.Time.Calendar.OrdinalDate.Compat ( toOrdinalDate, fromOrdinalDate, fromOrdinalDateValid, showOrdinalDate, isLeapYear, mondayStartWeek, sundayStartWeek, fromMondayStartWeek, fromMondayStartWeekValid, fromSundayStartWeek, fromSundayStartWeekValid, ) where import Data.Time.Orphans () import Data.Time.Calendar.OrdinalDate time-compat-1.9.3/src/Data/Time/Calendar/Private.hs0000644000000000000000000000335607346545000020160 0ustar0000000000000000module Data.Time.Calendar.Private where import Data.Time.Orphans () import Data.Fixed data PadOption = Pad Int Char | NoPad showPadded :: PadOption -> String -> String showPadded NoPad s = s showPadded (Pad i c) s = replicate (i - length s) c ++ s class (Num t,Ord t,Show t) => ShowPadded t where showPaddedNum :: PadOption -> t -> String instance ShowPadded Integer where showPaddedNum NoPad i = show i showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) showPaddedNum pad i = showPadded pad $ show i instance ShowPadded Int where showPaddedNum NoPad i = show i showPaddedNum _pad i | i == minBound = show i showPaddedNum pad i | i < 0 = '-':(showPaddedNum pad (negate i)) showPaddedNum pad i = showPadded pad $ show i show2Fixed :: Pico -> String show2Fixed x | x < 10 = '0':(showFixed True x) show2Fixed x = showFixed True x show2 :: (ShowPadded t) => t -> String show2 = showPaddedNum $ Pad 2 '0' show3 :: (ShowPadded t) => t -> String show3 = showPaddedNum $ Pad 3 '0' show4 :: (ShowPadded t) => t -> String show4 = showPaddedNum $ Pad 4 '0' mod100 :: (Integral i) => i -> i mod100 x = mod x 100 div100 :: (Integral i) => i -> i div100 x = div x 100 clip :: (Ord t) => t -> t -> t -> t clip a _ x | x < a = a clip _ b x | x > b = b clip _ _ x = x clipValid :: (Ord t) => t -> t -> t -> Maybe t clipValid a _ x | x < a = Nothing clipValid _ b x | x > b = Nothing clipValid _ _ x = Just x quotBy :: (Real a,Integral b) => a -> a -> b quotBy d n = truncate ((toRational n) / (toRational d)) remBy :: Real a => a -> a -> a remBy d n = n - (fromInteger f) * d where f = quotBy d n quotRemBy :: (Real a,Integral b) => a -> a -> (b,a) quotRemBy d n = let f = quotBy d n in (f,n - (fromIntegral f) * d) time-compat-1.9.3/src/Data/Time/Calendar/WeekDate/0000755000000000000000000000000007346545000017674 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Calendar/WeekDate/Compat.hs0000644000000000000000000000030407346545000021450 0ustar0000000000000000module Data.Time.Calendar.WeekDate.Compat ( toWeekDate, fromWeekDate, fromWeekDateValid, showWeekDate, ) where import Data.Time.Orphans () import Data.Time.Calendar.WeekDate time-compat-1.9.3/src/Data/Time/Clock/0000755000000000000000000000000007346545000015525 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Clock/Compat.hs0000644000000000000000000000303607346545000017306 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Clock.Compat ( -- * Universal Time -- | Time as measured by the Earth. UniversalTime(..), -- * Absolute intervals, DiffTime DiffTime, secondsToDiffTime, picosecondsToDiffTime, diffTimeToPicoseconds, -- * UTCTime UTCTime (..), -- * NominalDiffTime NominalDiffTime, secondsToNominalDiffTime, nominalDiffTimeToSeconds, nominalDay, -- * UTC differences addUTCTime, diffUTCTime, -- * Current time getCurrentTime, getTime_resolution ) where import Data.Time.Orphans () import Data.Time.Clock import Data.Fixed (Pico) #if !MIN_VERSION_time(1,9,1) -- | Create a 'NominalDiffTime' from a number of seconds. secondsToNominalDiffTime :: Pico -> NominalDiffTime secondsToNominalDiffTime = realToFrac -- | Get the seconds in a 'NominalDiffTime'. nominalDiffTimeToSeconds :: NominalDiffTime -> Pico nominalDiffTimeToSeconds = realToFrac #endif #if !MIN_VERSION_time(1,8,0) -- | One day in 'NominalDiffTime'. nominalDay :: NominalDiffTime nominalDay = 86400 #endif #if !MIN_VERSION_time(1,8,0) -- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime' getTime_resolution :: DiffTime getTime_resolution = 1E-6 -- microsecond #endif #if !MIN_VERSION_time(1,6,0) -- | Get the number of picoseconds in a 'DiffTime'. diffTimeToPicoseconds :: DiffTime -> Integer #if MIN_VERSION_time(1,4,0) diffTimeToPicoseconds = truncate . (1000000000000 *) #else diffTimeToPicoseconds = truncate . toRational . (1000000000000 *) #endif #endif time-compat-1.9.3/src/Data/Time/Clock/POSIX/0000755000000000000000000000000007346545000016427 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Clock/POSIX/Compat.hs0000644000000000000000000000073307346545000020211 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Clock.POSIX.Compat ( posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime, systemToPOSIXTime, ) where import Data.Time.Orphans () import Data.Time import Data.Time.Clock.POSIX import Data.Time.Clock.System.Compat #if !MIN_VERSION_time(1,8,0) systemToPOSIXTime :: SystemTime -> POSIXTime systemToPOSIXTime (MkSystemTime s ns) = (fromIntegral s) + (fromIntegral ns) * 1E-9 #endif time-compat-1.9.3/src/Data/Time/Clock/System/0000755000000000000000000000000007346545000017011 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Clock/System/Compat.hs0000644000000000000000000000720407346545000020573 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Data.Time.Clock.System.Compat ( systemEpochDay, SystemTime(..), truncateSystemTimeLeapSecond, getSystemTime, systemToUTCTime, utcToSystemTime, systemToTAITime, ) where import Data.Time.Orphans () #if MIN_VERSION_time(1,8,0) import Data.Time.Clock.System #else import Control.DeepSeq (NFData (..)) import Data.Int (Int64) import Data.Word (Word32) import Data.Typeable (Typeable) import Data.Time.Clock.TAI.Compat import Data.Time.Clock.POSIX import Data.Time.Compat -- | '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,Typeable) 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 -- Use gettimeofday getSystemTime = do t <- getPOSIXTime let secs = truncate t let nsecs = truncate $ 1000000000 * (t - fromIntegral secs) return (MkSystemTime secs nsecs) -- | 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 #endif time-compat-1.9.3/src/Data/Time/Clock/TAI/0000755000000000000000000000000007346545000016142 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Clock/TAI/Compat.hs0000644000000000000000000000424607346545000017727 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} module Data.Time.Clock.TAI.Compat ( -- * TAI arithmetic AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime, taiNominalDayStart, -- * leap-second map type LeapSecondMap, -- * conversion between UTC and TAI with map #if MIN_VERSION_time(1,7,0) T.utcDayLength,T.utcToTAITime,T.taiToUTCTime, #else utcDayLength,utcToTAITime,taiToUTCTime, #endif taiClock, ) where import Data.Time.Orphans () import Data.Time.Compat import Data.Time.Clock.TAI hiding (utcDayLength,utcToTAITime,taiToUTCTime) import qualified Data.Time.Clock.TAI as T import Data.Fixed (div') -- | This type is either 'LeapSecondMap' or 'LeapSecondTable', depending -- on the version of @time@ (changed in @time-1.7.0@). #if !(MIN_VERSION_time(1,7,0)) type LeapSecondMap = Day -> Maybe Int utcDayLength :: LeapSecondMap -> Day -> Maybe DiffTime utcDayLength lsmap day = do i0 <- lsmap day i1 <- lsmap $ addDays 1 day return $ realToFrac (86400 + i1 - i0) dayStart :: LeapSecondMap -> Day -> Maybe AbsoluteTime dayStart lsmap day = do i <- lsmap day return $ addAbsoluteTime (realToFrac $ (toModifiedJulianDay day) * 86400 + toInteger i) taiEpoch utcToTAITime :: LeapSecondMap -> UTCTime -> Maybe AbsoluteTime utcToTAITime lsmap (UTCTime day dtime) = do t <- dayStart lsmap day return $ addAbsoluteTime dtime t taiToUTCTime :: LeapSecondMap -> AbsoluteTime -> Maybe UTCTime taiToUTCTime lsmap abstime = let stable day = do dayt <- dayStart lsmap day len <- utcDayLength lsmap day let dtime = diffAbsoluteTime abstime dayt day' = addDays (div' dtime len) day if day == day' then return (UTCTime day dtime) else stable day' in stable $ ModifiedJulianDay $ div' (diffAbsoluteTime abstime taiEpoch) 86400 #endif #if !(MIN_VERSION_time(1,8,0)) taiNominalDayStart :: Day -> AbsoluteTime taiNominalDayStart (ModifiedJulianDay ds) = addAbsoluteTime (secondsToDiffTime (ds * 86400)) taiEpoch -- | 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 = Nothing #endif time-compat-1.9.3/src/Data/Time/0000755000000000000000000000000007346545000014472 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Compat.hs0000644000000000000000000000053007346545000016247 0ustar0000000000000000module Data.Time.Compat ( module Data.Time.Calendar.Compat, module Data.Time.Clock.Compat, module Data.Time.LocalTime.Compat, module Data.Time.Format.Compat, ) where import Data.Time.Orphans () import Data.Time.Calendar.Compat import Data.Time.Clock.Compat import Data.Time.LocalTime.Compat import Data.Time.Format.Compat time-compat-1.9.3/src/Data/Time/Format/0000755000000000000000000000000007346545000015722 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Format/Compat.hs0000644000000000000000000000763707346545000017516 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Format.Compat ( -- * UNIX-style formatting FormatTime(),formatTime, -- * UNIX-style parsing -- ** __Note__ in compat mode acceptWS argument is ignored, it's always 'True'. parseTimeM, parseTimeOrError, readSTime, readPTime, parseTime, readTime, readsTime, ParseTime(), -- * Locale TimeLocale(..), defaultTimeLocale, iso8601DateFormat, rfc822DateFormat, ) where import Data.Time.Orphans () #if !MIN_VERSION_time(1,5,0) import Data.Time.Format import System.Locale (TimeLocale, defaultTimeLocale, iso8601DateFormat, rfc822DateFormat) import Text.ParserCombinators.ReadP (readP_to_S, readS_to_P, ReadP) #else #if !(MIN_VERSION_time(1,9,0)) || !(MIN_VERSION_base(4,9,0)) import Data.Time.Format hiding (parseTimeM) #else import Data.Time.Format #endif #endif import qualified Control.Monad.Fail as Fail import qualified Data.Time.Format #if !MIN_VERSION_time(1,5,0) parseTimeM :: (Fail.MonadFail m, ParseTime t) => Bool -- ^ Accept leading and trailing whitespace? -> TimeLocale -- ^ Time locale. -> String -- ^ Format string. -> String -- ^ Input string. -> m t -- ^ Return the time value, or fail if the in parseTimeM _acceptWS l fmt s = case parseTime l fmt s of Just x -> return x Nothing -> Fail.fail "parseTimeM: no parse" parseTimeOrError :: ParseTime t => Bool -- ^ Accept leading and trailing whitespace? -> TimeLocale -- ^ Time locale. -> String -- ^ Format string. -> String -- ^ Input string. -> t -- ^ The time value. parseTimeOrError _acceptWS l fmt s = case parseTime l fmt s of Just x -> x Nothing -> error "parseTimeOrError: no parse" -- | Parse a time value given a format string. See 'parseTimeM' for details. readSTime :: ParseTime t => Bool -- ^ Accept leading whitespace? -> TimeLocale -- ^ Time locale. -> String -- ^ Format string -> ReadS t readSTime _acceptWS l f = readsTime l f -- | Parse a time value given a format string. See 'parseTimeM' for details. readPTime :: ParseTime t => Bool -- ^ Accept leading whitespace? -> TimeLocale -- ^ Time locale. -> String -- ^ Format string -> ReadP t readPTime acceptWS l f = readS_to_P (readSTime acceptWS l f) #else -- parseTimeM has always Fail.MonadFail constraint #if !MIN_VERSION_time(1,9,0) || !MIN_VERSION_base(4,9,0) -- | Parses a time value given a format string. -- -- This variant from @time-compat@ has always 'Fail.MonadFail' constraint. -- -- Look at 'Data.Time.Format.parseTimeM' for documentation. parseTimeM :: (Fail.MonadFail m, ParseTime t) => Bool -- ^ Accept leading and trailing whitespace? -> TimeLocale -- ^ Time locale. -> String -- ^ Format string. -> String -- ^ Input string. -> m t -- ^ Return the time value, or fail if the in parseTimeM = Data.Time.Format.parseTimeM #endif #endif #if MIN_VERSION_time(1,10,0) {-# DEPRECATED parseTime "use \"parseTimeM True\" instead" #-} parseTime :: ParseTime t => TimeLocale -- ^ Time locale. -> String -- ^ Format string. -> String -- ^ Input string. -> Maybe t -- ^ The time value, or 'Nothing' if the input could -- not be parsed using the given format. parseTime = parseTimeM True {-# DEPRECATED readTime "use \"parseTimeOrError True\" instead" #-} readTime :: ParseTime t => TimeLocale -- ^ Time locale. -> String -- ^ Format string. -> String -- ^ Input string. -> t -- ^ The time value. readTime = parseTimeOrError True {-# DEPRECATED readsTime "use \"readSTime True\" instead" #-} readsTime :: ParseTime t => TimeLocale -- ^ Time locale. -> String -- ^ Format string -> ReadS t readsTime = readSTime True #endif time-compat-1.9.3/src/Data/Time/Format/ISO8601/0000755000000000000000000000000007346545000016673 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/Format/ISO8601/Compat.hs0000644000000000000000000003566107346545000020465 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Format.ISO8601.Compat ( -- * Format Format, formatShowM, formatShow, formatReadP, formatParseM, -- * Common formats ISO8601(..), iso8601Show, iso8601ParseM, -- * All formats FormatExtension(..), formatReadPExtension, parseFormatExtension, calendarFormat, yearMonthFormat, yearFormat, centuryFormat, expandedCalendarFormat, expandedYearMonthFormat, expandedYearFormat, expandedCenturyFormat, ordinalDateFormat, expandedOrdinalDateFormat, weekDateFormat, yearWeekFormat, expandedWeekDateFormat, expandedYearWeekFormat, timeOfDayFormat, hourMinuteFormat, hourFormat, withTimeDesignator, withUTCDesignator, timeOffsetFormat, timeOfDayAndOffsetFormat, localTimeFormat, zonedTimeFormat, utcTimeFormat, dayAndTimeFormat, timeAndOffsetFormat, durationDaysFormat, durationTimeFormat, alternativeDurationDaysFormat, alternativeDurationTimeFormat, intervalFormat, recurringIntervalFormat, ) where import Data.Time.Orphans () #if MIN_VERSION_time(1,9,0) import Data.Time.Format.ISO8601 #else import Control.Monad.Fail import Prelude hiding (fail) import Data.Monoid import Data.Ratio import Data.Fixed import Text.ParserCombinators.ReadP import Data.Format import Data.Time import Data.Time.Calendar.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.LocalTime.Compat import Data.Time.Calendar.Private data FormatExtension = -- | ISO 8601:2004(E) sec. 2.3.4. Use hyphens and colons. ExtendedFormat | -- | ISO 8601:2004(E) sec. 2.3.3. Omit hyphens and colons. "The basic format should be avoided in plain text." BasicFormat -- | Read a value in either extended or basic format formatReadPExtension :: (FormatExtension -> Format t) -> ReadP t formatReadPExtension ff = formatReadP (ff ExtendedFormat) +++ formatReadP (ff BasicFormat) -- | Parse a value in either extended or basic format parseFormatExtension :: ( #if MIN_VERSION_base(4,9,0) MonadFail m #else Monad m #endif ) => (FormatExtension -> Format t) -> String -> m t parseFormatExtension ff = parseReader $ formatReadPExtension ff sepFormat :: String -> Format a -> Format b -> Format (a,b) sepFormat sep fa fb = (fa <** literalFormat sep) <**> fb dashFormat :: Format a -> Format b -> Format (a,b) dashFormat = sepFormat "-" colnFormat :: Format a -> Format b -> Format (a,b) colnFormat = sepFormat ":" extDashFormat :: FormatExtension -> Format a -> Format b -> Format (a,b) extDashFormat ExtendedFormat = dashFormat extDashFormat BasicFormat = (<**>) extColonFormat :: FormatExtension -> Format a -> Format b -> Format (a,b) extColonFormat ExtendedFormat = colnFormat extColonFormat BasicFormat = (<**>) expandedYearFormat' :: Int -> Format Integer expandedYearFormat' n = integerFormat PosNegSign (Just n) yearFormat' :: Format Integer yearFormat' = integerFormat NegSign (Just 4) monthFormat :: Format Int monthFormat = integerFormat NoSign (Just 2) dayOfMonthFormat :: Format Int dayOfMonthFormat = integerFormat NoSign (Just 2) dayOfYearFormat :: Format Int dayOfYearFormat = integerFormat NoSign (Just 3) weekOfYearFormat :: Format Int weekOfYearFormat = literalFormat "W" **> integerFormat NoSign (Just 2) dayOfWeekFormat :: Format Int dayOfWeekFormat = integerFormat NoSign (Just 1) hourFormat' :: Format Int hourFormat' = integerFormat NoSign (Just 2) data E14 instance HasResolution E14 where resolution _ = 100000000000000 data E16 instance HasResolution E16 where resolution _ = 10000000000000000 hourDecimalFormat :: Format (Fixed E16) -- need four extra decimal places for hours hourDecimalFormat = decimalFormat NoSign (Just 2) minuteFormat :: Format Int minuteFormat = integerFormat NoSign (Just 2) minuteDecimalFormat :: Format (Fixed E14) -- need two extra decimal places for minutes minuteDecimalFormat = decimalFormat NoSign (Just 2) secondFormat :: Format Pico secondFormat = decimalFormat NoSign (Just 2) mapGregorian :: Format (Integer,(Int,Int)) -> Format Day mapGregorian = mapMFormat (\(y,(m,d)) -> fromGregorianValid y m d) (\day -> (\(y,m,d) -> Just (y,(m,d))) $ toGregorian day) mapOrdinalDate :: Format (Integer,Int) -> Format Day mapOrdinalDate = mapMFormat (\(y,d) -> fromOrdinalDateValid y d) (Just . toOrdinalDate) mapWeekDate :: Format (Integer,(Int,Int)) -> Format Day mapWeekDate = mapMFormat (\(y,(w,d)) -> fromWeekDateValid y w d) (\day -> (\(y,w,d) -> Just (y,(w,d))) $ toWeekDate day) mapTimeOfDay :: Format (Int,(Int,Pico)) -> Format TimeOfDay mapTimeOfDay = mapMFormat (\(h,(m,s)) -> makeTimeOfDayValid h m s) (\(TimeOfDay h m s) -> Just (h,(m,s))) -- | ISO 8601:2004(E) sec. 4.1.2.2 calendarFormat :: FormatExtension -> Format Day calendarFormat fe = mapGregorian $ extDashFormat fe yearFormat $ extDashFormat fe monthFormat dayOfMonthFormat -- | ISO 8601:2004(E) sec. 4.1.2.3(a) yearMonthFormat :: Format (Integer,Int) yearMonthFormat = yearFormat <**> literalFormat "-" **> monthFormat -- | ISO 8601:2004(E) sec. 4.1.2.3(b) yearFormat :: Format Integer yearFormat = yearFormat' -- | ISO 8601:2004(E) sec. 4.1.2.3(c) centuryFormat :: Format Integer centuryFormat = integerFormat NegSign (Just 2) -- | ISO 8601:2004(E) sec. 4.1.2.4(a) expandedCalendarFormat :: Int -> FormatExtension -> Format Day expandedCalendarFormat n fe = mapGregorian $ extDashFormat fe (expandedYearFormat n) $ extDashFormat fe monthFormat dayOfMonthFormat -- | ISO 8601:2004(E) sec. 4.1.2.4(b) expandedYearMonthFormat :: Int -> Format (Integer,Int) expandedYearMonthFormat n = dashFormat (expandedYearFormat n) monthFormat -- | ISO 8601:2004(E) sec. 4.1.2.4(c) expandedYearFormat :: Int -> Format Integer expandedYearFormat = expandedYearFormat' -- | ISO 8601:2004(E) sec. 4.1.2.4(d) expandedCenturyFormat :: Int -> Format Integer expandedCenturyFormat n = integerFormat PosNegSign (Just n) -- | ISO 8601:2004(E) sec. 4.1.3.2 ordinalDateFormat :: FormatExtension -> Format Day ordinalDateFormat fe = mapOrdinalDate $ extDashFormat fe yearFormat dayOfYearFormat -- | ISO 8601:2004(E) sec. 4.1.3.3 expandedOrdinalDateFormat :: Int -> FormatExtension -> Format Day expandedOrdinalDateFormat n fe = mapOrdinalDate $ extDashFormat fe (expandedYearFormat n) dayOfYearFormat -- | ISO 8601:2004(E) sec. 4.1.4.2 weekDateFormat :: FormatExtension -> Format Day weekDateFormat fe = mapWeekDate $ extDashFormat fe yearFormat $ extDashFormat fe weekOfYearFormat dayOfWeekFormat -- | ISO 8601:2004(E) sec. 4.1.4.3 yearWeekFormat :: FormatExtension -> Format (Integer,Int) yearWeekFormat fe = extDashFormat fe yearFormat weekOfYearFormat -- | ISO 8601:2004(E) sec. 4.1.4.2 expandedWeekDateFormat :: Int -> FormatExtension -> Format Day expandedWeekDateFormat n fe = mapWeekDate $ extDashFormat fe (expandedYearFormat n) $ extDashFormat fe weekOfYearFormat dayOfWeekFormat -- | ISO 8601:2004(E) sec. 4.1.4.3 expandedYearWeekFormat :: Int -> FormatExtension -> Format (Integer,Int) expandedYearWeekFormat n fe = extDashFormat fe (expandedYearFormat n) weekOfYearFormat -- | ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a) timeOfDayFormat :: FormatExtension -> Format TimeOfDay timeOfDayFormat fe = mapTimeOfDay $ extColonFormat fe hourFormat' $ extColonFormat fe minuteFormat secondFormat -- workaround for the 'fromRational' in 'Fixed', which uses 'floor' instead of 'round' fromRationalRound :: Rational -> NominalDiffTime fromRationalRound r = fromRational $ round (r * 1000000000000) % 1000000000000 -- | ISO 8601:2004(E) sec. 4.2.2.3(a), 4.2.2.4(b) hourMinuteFormat :: FormatExtension -> Format TimeOfDay hourMinuteFormat fe = let toTOD (h,m) = case timeToDaysAndTimeOfDay $ fromRationalRound $ toRational $ (fromIntegral h) * 3600 + m * 60 of (0,tod) -> Just tod _ -> Nothing fromTOD tod = let mm = (realToFrac $ daysAndTimeOfDayToTime 0 tod) / 60 in Just $ quotRemBy 60 mm in mapMFormat toTOD fromTOD $ extColonFormat fe hourFormat' $ minuteDecimalFormat -- | ISO 8601:2004(E) sec. 4.2.2.3(b), 4.2.2.4(c) hourFormat :: Format TimeOfDay hourFormat = let toTOD h = case timeToDaysAndTimeOfDay $ fromRationalRound $ toRational $ h * 3600 of (0,tod) -> Just tod _ -> Nothing fromTOD tod = Just $ (realToFrac $ daysAndTimeOfDayToTime 0 tod) / 3600 in mapMFormat toTOD fromTOD $ hourDecimalFormat -- | ISO 8601:2004(E) sec. 4.2.2.5 withTimeDesignator :: Format t -> Format t withTimeDesignator f = literalFormat "T" **> f -- | ISO 8601:2004(E) sec. 4.2.4 withUTCDesignator :: Format t -> Format t withUTCDesignator f = f <** literalFormat "Z" -- | ISO 8601:2004(E) sec. 4.2.5.1 timeOffsetFormat :: FormatExtension -> Format TimeZone timeOffsetFormat fe = let toTimeZone (sign,(h,m)) = minutesToTimeZone $ sign * (h * 60 + m) fromTimeZone tz = let mm = timeZoneMinutes tz hm = quotRem (abs mm) 60 in (signum mm,hm) in isoMap toTimeZone fromTimeZone $ mandatorySignFormat <**> extColonFormat fe (integerFormat NoSign (Just 2)) (integerFormat NoSign (Just 2)) -- | ISO 8601:2004(E) sec. 4.2.5.2 timeOfDayAndOffsetFormat :: FormatExtension -> Format (TimeOfDay,TimeZone) timeOfDayAndOffsetFormat fe = timeOfDayFormat fe <**> timeOffsetFormat fe -- | ISO 8601:2004(E) sec. 4.3.2 localTimeFormat :: Format Day -> Format TimeOfDay -> Format LocalTime localTimeFormat fday ftod = isoMap (\(day,tod) -> LocalTime day tod) (\(LocalTime day tod) -> (day,tod)) $ fday <**> withTimeDesignator ftod -- | ISO 8601:2004(E) sec. 4.3.2 zonedTimeFormat :: Format Day -> Format TimeOfDay -> FormatExtension -> Format ZonedTime zonedTimeFormat fday ftod fe = isoMap (\(lt,tz) -> ZonedTime lt tz) (\(ZonedTime lt tz) -> (lt,tz)) $ timeAndOffsetFormat (localTimeFormat fday ftod) fe -- | ISO 8601:2004(E) sec. 4.3.2 utcTimeFormat :: Format Day -> Format TimeOfDay -> Format UTCTime utcTimeFormat fday ftod = isoMap (localTimeToUTC utc) (utcToLocalTime utc) $ withUTCDesignator $ localTimeFormat fday ftod -- | ISO 8601:2004(E) sec. 4.3.3 dayAndTimeFormat :: Format Day -> Format time -> Format (Day,time) dayAndTimeFormat fday ft = fday <**> withTimeDesignator ft -- | ISO 8601:2004(E) sec. 4.3.3 timeAndOffsetFormat :: Format t -> FormatExtension -> Format (t,TimeZone) timeAndOffsetFormat ft fe = ft <**> timeOffsetFormat fe intDesignator :: (Eq t,Show t,Read t,Num t) => Char -> Format t intDesignator c = optionalFormat 0 $ integerFormat NoSign Nothing <** literalFormat [c] decDesignator :: (Eq t,Show t,Read t,Num t) => Char -> Format t decDesignator c = optionalFormat 0 $ decimalFormat NoSign Nothing <** literalFormat [c] daysDesigs :: Format CalendarDiffDays daysDesigs = let toCD (y,(m,(w,d))) = CalendarDiffDays (y * 12 + m) (w * 7 + d) fromCD (CalendarDiffDays mm d) = (quot mm 12,(rem mm 12,(0,d))) in isoMap toCD fromCD $ intDesignator 'Y' <**> intDesignator 'M' <**> intDesignator 'W' <**> intDesignator 'D' -- | ISO 8601:2004(E) sec. 4.4.3.2 durationDaysFormat :: Format CalendarDiffDays durationDaysFormat = (**>) (literalFormat "P") $ specialCaseShowFormat (mempty,"0D") $ daysDesigs -- | ISO 8601:2004(E) sec. 4.4.3.2 durationTimeFormat :: Format CalendarDiffTime durationTimeFormat = let toCT (cd,(h,(m,s))) = mappend (calendarTimeDays cd) (calendarTimeTime $ daysAndTimeOfDayToTime 0 $ TimeOfDay h m s) fromCT (CalendarDiffTime mm t) = let (d,TimeOfDay h m s) = timeToDaysAndTimeOfDay t in (CalendarDiffDays mm d,(h,(m,s))) in (**>) (literalFormat "P") $ specialCaseShowFormat (mempty,"0D") $ isoMap toCT fromCT $ (<**>) daysDesigs $ optionalFormat (0,(0,0)) $ literalFormat "T" **> intDesignator 'H' <**> intDesignator 'M' <**> decDesignator 'S' -- | ISO 8601:2004(E) sec. 4.4.3.3 alternativeDurationDaysFormat :: FormatExtension -> Format CalendarDiffDays alternativeDurationDaysFormat fe = let toCD (y,(m,d)) = CalendarDiffDays (y * 12 + m) d fromCD (CalendarDiffDays mm d) = (quot mm 12,(rem mm 12,d)) in isoMap toCD fromCD $ (**>) (literalFormat "P") $ extDashFormat fe (clipFormat (0,9999) $ integerFormat NegSign $ Just 4) $ extDashFormat fe (clipFormat (0,12) $ integerFormat NegSign $ Just 2) $ (clipFormat (0,30) $ integerFormat NegSign $ Just 2) -- | ISO 8601:2004(E) sec. 4.4.3.3 alternativeDurationTimeFormat :: FormatExtension -> Format CalendarDiffTime alternativeDurationTimeFormat fe = let toCT (cd,(h,(m,s))) = mappend (calendarTimeDays cd) (calendarTimeTime $ daysAndTimeOfDayToTime 0 $ TimeOfDay h m s) fromCT (CalendarDiffTime mm t) = let (d,TimeOfDay h m s) = timeToDaysAndTimeOfDay t in (CalendarDiffDays mm d,(h,(m,s))) in isoMap toCT fromCT $ (<**>) (alternativeDurationDaysFormat fe) $ withTimeDesignator $ extColonFormat fe (clipFormat (0,24) $ integerFormat NegSign (Just 2)) $ extColonFormat fe (clipFormat (0,60) $ integerFormat NegSign (Just 2)) $ (clipFormat (0,60) $ decimalFormat NegSign (Just 2)) -- | ISO 8601:2004(E) sec. 4.4.4.1 intervalFormat :: Format a -> Format b -> Format (a,b) intervalFormat = sepFormat "/" -- | ISO 8601:2004(E) sec. 4.5 recurringIntervalFormat :: Format a -> Format b -> Format (Int,a,b) recurringIntervalFormat fa fb = isoMap (\(r,(a,b)) -> (r,a,b)) (\(r,a,b) -> (r,(a,b))) $ sepFormat "/" (literalFormat "R" **> integerFormat NoSign Nothing) $ intervalFormat fa fb class ISO8601 t where -- | The most commonly used ISO 8601 format for this type. iso8601Format :: Format t -- | Show in the most commonly used ISO 8601 format. iso8601Show :: ISO8601 t => t -> String iso8601Show = formatShow iso8601Format -- | Parse the most commonly used ISO 8601 format. iso8601ParseM :: ( #if MIN_VERSION_base(4,9,0) MonadFail m #else Monad m #endif ,ISO8601 t) => String -> m t iso8601ParseM = formatParseM iso8601Format -- | @yyyy-mm-dd@ (ISO 8601:2004(E) sec. 4.1.2.2 extended format) instance ISO8601 Day where iso8601Format = calendarFormat ExtendedFormat -- | @hh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a) extended format) instance ISO8601 TimeOfDay where iso8601Format = timeOfDayFormat ExtendedFormat -- | @±hh:mm@ (ISO 8601:2004(E) sec. 4.2.5.1 extended format) instance ISO8601 TimeZone where iso8601Format = timeOffsetFormat ExtendedFormat -- | @yyyy-mm-ddThh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.3.2 extended format) instance ISO8601 LocalTime where iso8601Format = localTimeFormat iso8601Format iso8601Format -- | @yyyy-mm-ddThh:mm:ss[.sss]±hh:mm@ (ISO 8601:2004(E) sec. 4.3.2 extended format) instance ISO8601 ZonedTime where iso8601Format = zonedTimeFormat iso8601Format iso8601Format ExtendedFormat -- | @yyyy-mm-ddThh:mm:ss[.sss]Z@ (ISO 8601:2004(E) sec. 4.3.2 extended format) instance ISO8601 UTCTime where iso8601Format = utcTimeFormat iso8601Format iso8601Format -- | @PyYmMdD@ (ISO 8601:2004(E) sec. 4.4.3.2) instance ISO8601 CalendarDiffDays where iso8601Format = durationDaysFormat -- | @PyYmMdDThHmMs[.sss]S@ (ISO 8601:2004(E) sec. 4.4.3.2) instance ISO8601 CalendarDiffTime where iso8601Format = durationTimeFormat #endif time-compat-1.9.3/src/Data/Time/LocalTime/0000755000000000000000000000000007346545000016343 5ustar0000000000000000time-compat-1.9.3/src/Data/Time/LocalTime/Compat.hs0000644000000000000000000001042507346545000020124 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable #-} module Data.Time.LocalTime.Compat ( -- * Time zones TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc, -- getting the locale time zone getTimeZone,getCurrentTimeZone, -- * Time of day TimeOfDay(..),midnight,midday,makeTimeOfDayValid, timeToDaysAndTimeOfDay,daysAndTimeOfDayToTime, utcToLocalTimeOfDay,localToUTCTimeOfDay, timeToTimeOfDay,timeOfDayToTime, dayFractionToTimeOfDay,timeOfDayToDayFraction, pastMidnight, sinceMidnight, -- * CalendarDiffTime CalendarDiffTime (..), calendarTimeDays, calendarTimeTime, scaleCalendarDiffTime, -- * Local Time LocalTime(..), addLocalTime,diffLocalTime, -- converting UTC and UT1 times to LocalTime utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1, -- * Zoned Time ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime, ) where import Data.Time.Orphans () import Data.Time.LocalTime import Data.Time.Clock.Compat import Data.Time.Calendar.Compat import Data.Fixed (Pico (..), showFixed, divMod') import Data.Monoid (Monoid (..)) import Data.Data (Data, Typeable) import Data.Semigroup (Semigroup (..)) ------------------------------------------------------------------------------- -- TimeOfDay ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,9,0) -- | Convert a period of time into a count of days and a time of day since midnight. -- The time of day will never have a leap second. timeToDaysAndTimeOfDay :: NominalDiffTime -> (Integer,TimeOfDay) timeToDaysAndTimeOfDay dt = let s = realToFrac dt (m,ms) = divMod' s 60 (h,hm) = divMod' m 60 (d,dh) = divMod' h 24 in (d,TimeOfDay dh hm ms) -- | Convert a count of days and a time of day since midnight into a period of time. daysAndTimeOfDayToTime :: Integer -> TimeOfDay -> NominalDiffTime daysAndTimeOfDayToTime d (TimeOfDay dh hm ms) = (+) (realToFrac ms) $ (*) 60 $ (+) (realToFrac hm) $ (*) 60 $ (+) (realToFrac dh) $ (*) 24 $ realToFrac d #endif #if !MIN_VERSION_time(1,10,0) -- | Same as 'timeToTimeOfDay'. pastMidnight :: DiffTime -> TimeOfDay pastMidnight = timeToTimeOfDay -- | Same as 'timeOfDayToTime'. sinceMidnight :: TimeOfDay -> DiffTime sinceMidnight = timeOfDayToTime #endif ------------------------------------------------------------------------------- -- CalendarDiffTime ------------------------------------------------------------------------------- #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_base(1,9,2) deriving instance Typeable CalendarDiffTime deriving instance Data CalendarDiffTime #endif #if !MIN_VERSION_time(1,9,2) data CalendarDiffTime = CalendarDiffTime { ctMonths :: Integer , ctTime :: NominalDiffTime } deriving (Eq, Data ,Typeable ) -- | Additive instance Semigroup CalendarDiffTime where CalendarDiffTime m1 d1 <> CalendarDiffTime m2 d2 = CalendarDiffTime (m1 + m2) (d1 + d2) instance Monoid CalendarDiffTime where mempty = CalendarDiffTime 0 0 mappend = (<>) instance Show CalendarDiffTime where show (CalendarDiffTime m t) = "P" ++ show m ++ "MT" ++ showFixed True (realToFrac t :: Pico) ++ "S" calendarTimeDays :: CalendarDiffDays -> CalendarDiffTime calendarTimeDays (CalendarDiffDays m d) = CalendarDiffTime m $ fromInteger d * nominalDay calendarTimeTime :: NominalDiffTime -> CalendarDiffTime calendarTimeTime dt = CalendarDiffTime 0 dt -- | Scale by a factor. Note that @scaleCalendarDiffTime (-1)@ will not perfectly invert a duration, due to variable month lengths. scaleCalendarDiffTime :: Integer -> CalendarDiffTime -> CalendarDiffTime scaleCalendarDiffTime k (CalendarDiffTime m d) = CalendarDiffTime (k * m) (fromInteger k * d) #endif ------------------------------------------------------------------------------- -- LocalTime ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,9,0) -- | addLocalTime a b = a + b addLocalTime :: NominalDiffTime -> LocalTime -> LocalTime addLocalTime x = utcToLocalTime utc . addUTCTime x . localTimeToUTC utc -- | diffLocalTime a b = a - b diffLocalTime :: LocalTime -> LocalTime -> NominalDiffTime diffLocalTime a b = diffUTCTime (localTimeToUTC utc a) (localTimeToUTC utc b) #endif time-compat-1.9.3/src/Data/Time/Orphans.hs0000644000000000000000000000277407346545000016452 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Orphans where import Data.Orphans () import Control.DeepSeq (NFData (..)) import Data.Time import Data.Time.Clock import Data.Time.Clock.TAI import Data.Time.Format #if !MIN_VERSION_time(1,4,0) instance NFData Day where rnf (ModifiedJulianDay d) = rnf d instance NFData UniversalTime where rnf (ModJulianDate d) = rnf d instance NFData DiffTime where rnf d = d `seq` () instance NFData AbsoluteTime where rnf d = d `seq` () instance NFData UTCTime where rnf (UTCTime d t) = rnf d `seq` rnf t instance NFData NominalDiffTime where rnf d = d `seq` () instance NFData LocalTime where rnf (LocalTime d tod) = rnf d `seq` rnf tod instance NFData ZonedTime where rnf (ZonedTime lt tz) = rnf lt `seq` rnf tz instance NFData TimeOfDay where rnf (TimeOfDay h m s) = rnf h `seq` rnf m `seq` rnf s instance NFData TimeZone where rnf (TimeZone a b c) = rnf a `seq` rnf b `seq` rnf c #endif #if !MIN_VERSION_time(1,6,0) instance ParseTime UniversalTime where -- substituteTimeSpecifier _ = timeSubstituteTimeSpecifier -- parseTimeSpecifier _ = timeParseTimeSpecifier buildTime l xs = localTimeToUT1 0 (buildTime l xs) instance FormatTime UniversalTime where formatCharacter c = fmap (\f tl fo t -> f tl fo (ut1ToLocalTime 0 t)) (formatCharacter c) instance Show UniversalTime where show t = show (ut1ToLocalTime 0 t) instance Read UniversalTime where readsPrec n s = [ (localTimeToUT1 0 t, r) | (t,r) <- readsPrec n s ] #endif time-compat-1.9.3/test/0000755000000000000000000000000007346545000013113 5ustar0000000000000000time-compat-1.9.3/test/Test.hs0000644000000000000000000000361207346545000014370 0ustar0000000000000000module Main where import Control.DeepSeq (force) import Data.Time.Calendar.Compat import Data.Time.Clock.System.Compat import Data.Time.Clock.TAI.Compat import Data.Time.Compat import Data.Time.Format.Compat import Test.HUnit.Base ((@?=)) main :: IO () main = do utc <- getCurrentTime -- UTCTime putStrLn $ formatTime defaultTimeLocale rfc822DateFormat (force utc) -- ZonedTime zt <- getZonedTime putStrLn $ formatTime defaultTimeLocale rfc822DateFormat (force zt) -- SystemTime st <- getSystemTime print $ force st -- FormatTime DayOfWeek formatTime defaultTimeLocale "%u %w %a %A" Monday @?= "1 1 Mon Monday" -- TAI taiNominalDayStart show (taiNominalDayStart (ModifiedJulianDay 123)) @?= "1859-03-20 00:00:00 TAI" _ParseTimeInstances :: [()] _ParseTimeInstances = [ () -- test (undefined :: CalendarDiffTime) , test (undefined :: Day) , () -- test (undefined :: DiffTime) , () -- test (undefined :: NominalDiffTime) , test (undefined :: UTCTime) , test (undefined :: UniversalTime) , () -- test (undefined :: CalendarDiffTime) , test (undefined :: TimeZone) , test (undefined :: TimeOfDay) , test (undefined :: LocalTime) , test (undefined :: ZonedTime) ] where test :: ParseTime t => t -> () test _ = () _FormatTimeInstances :: [()] _FormatTimeInstances = [ () -- test (undefined :: CalendarDiffTime) , test (undefined :: Day) , () -- test (undefined :: DiffTime) , () -- test (undefined :: NominalDiffTime) , test (undefined :: UTCTime) , test (undefined :: UniversalTime) , () -- test (undefined :: CalendarDiffTime) , test (undefined :: TimeZone) , test (undefined :: TimeOfDay) , test (undefined :: LocalTime) , test (undefined :: ZonedTime) , test (undefined :: DayOfWeek) ] where test :: FormatTime t => t -> () test _ = () time-compat-1.9.3/test/main/0000755000000000000000000000000007346545000014037 5ustar0000000000000000time-compat-1.9.3/test/main/Main.hs0000644000000000000000000000247507346545000015267 0ustar0000000000000000module Main where import Test.Tasty import Test.Calendar.AddDays import Test.Calendar.Calendars import Test.Calendar.ClipDates import Test.Calendar.ConvertBack import Test.Calendar.Duration import Test.Calendar.Easter import Test.Calendar.LongWeekYears import Test.Calendar.MonthDay import Test.Calendar.Valid import Test.Calendar.Week import Test.Clock.Conversion import Test.Clock.Resolution import Test.Clock.TAI import Test.Format.Format import Test.Format.ParseTime import Test.Format.ISO8601 import Test.LocalTime.Time import Test.LocalTime.TimeOfDay import Test.LocalTime.CalendarDiffTime tests :: TestTree tests = testGroup "Time" [ testGroup "Calendar" [ addDaysTest, testCalendars, clipDates, convertBack, longWeekYears, testMonthDay, testEaster, testValid, testWeek, testDuration ], testGroup "Clock" [ testClockConversion, testResolutions, testTAI ], testGroup "Format" [ testFormat, testParseTime, testISO8601 ], testGroup "LocalTime" [ testTime, testTimeOfDay, testCalendarDiffTime ] ] main :: IO () main = -- on older GHC we only compile #if __GLASGOW_HASKELL__ >=802 defaultMain tests #else return () #endif time-compat-1.9.3/test/main/Test/0000755000000000000000000000000007346545000014756 5ustar0000000000000000time-compat-1.9.3/test/main/Test/Arbitrary.hs0000644000000000000000000000726307346545000017261 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Arbitrary where import Data.Time.Compat import Data.Time.Clock.POSIX.Compat import Control.Monad import Data.Ratio import Test.Tasty.QuickCheck hiding (reason) instance Arbitrary DayOfWeek where arbitrary = fmap toEnum $ choose (1,7) instance Arbitrary Day where arbitrary = liftM ModifiedJulianDay $ choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31 shrink day = let (y, m, d) = toGregorian day dayShrink = if d > 1 then [fromGregorian y m (d - 1)] else [] monthShrink = if m > 1 then [fromGregorian y (m - 1) d] else [] yearShrink = if y > 2000 then [fromGregorian (y - 1) m d] else if y < 2000 then [fromGregorian (y + 1) m d] else [] in dayShrink ++ monthShrink ++ yearShrink instance CoArbitrary Day where coarbitrary (ModifiedJulianDay d) = coarbitrary d instance Arbitrary CalendarDiffDays where arbitrary = liftM2 CalendarDiffDays arbitrary arbitrary 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 :: Int)) secondsToDiffTime' :: Integer -> DiffTime secondsToDiffTime' = fromInteger picosecondsToDiffTime' :: Integer -> DiffTime picosecondsToDiffTime' x = fromRational (x % 10 ^ (12 :: Int)) instance CoArbitrary DiffTime where coarbitrary t = coarbitrary (fromEnum t) instance Arbitrary NominalDiffTime where arbitrary = oneof [intSecs, fracSecs] where limit = 1000 * 86400 picofactor = 10 ^ (12 :: Int) intSecs = liftM secondsToDiffTime' $ choose (negate limit, limit) fracSecs = liftM picosecondsToDiffTime' $ choose (negate limit * picofactor, limit * picofactor) secondsToDiffTime' :: Integer -> NominalDiffTime secondsToDiffTime' = fromInteger picosecondsToDiffTime' :: Integer -> NominalDiffTime picosecondsToDiffTime' x = fromRational (x % 10 ^ (12 :: Int)) instance CoArbitrary NominalDiffTime where coarbitrary t = coarbitrary (fromEnum t) instance Arbitrary CalendarDiffTime where arbitrary = liftM2 CalendarDiffTime arbitrary arbitrary 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 (floor (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 (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) instance Arbitrary UTCTime where arbitrary = liftM2 UTCTime arbitrary arbitrary instance CoArbitrary UTCTime where coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds t) :: Integer) instance Arbitrary UniversalTime where arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) -- 1000-01-1 to 9999-12-31 where k = 86400 instance CoArbitrary UniversalTime where coarbitrary (ModJulianDate d) = coarbitrary d time-compat-1.9.3/test/main/Test/Calendar/0000755000000000000000000000000007346545000016467 5ustar0000000000000000time-compat-1.9.3/test/main/Test/Calendar/AddDays.hs0000644000000000000000000000207107346545000020334 0ustar0000000000000000module Test.Calendar.AddDays(addDaysTest) where import Data.Time.Calendar.Compat 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 time-compat-1.9.3/test/main/Test/Calendar/AddDaysRef.hs0000644000000000000000000002766707346545000021013 0ustar0000000000000000module 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" ] time-compat-1.9.3/test/main/Test/Calendar/Calendars.hs0000644000000000000000000000147007346545000020721 0ustar0000000000000000module Test.Calendar.Calendars(testCalendars) where import Data.Time.Calendar.Julian.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Compat 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 time-compat-1.9.3/test/main/Test/Calendar/CalendarsRef.hs0000644000000000000000000000070607346545000021357 0ustar0000000000000000module 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" ] time-compat-1.9.3/test/main/Test/Calendar/ClipDates.hs0000644000000000000000000000275407346545000020703 0ustar0000000000000000module Test.Calendar.ClipDates(clipDates) where import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Compat 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 ] time-compat-1.9.3/test/main/Test/Calendar/ClipDatesRef.hs0000644000000000000000000004040007346545000021326 0ustar0000000000000000module 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" ] time-compat-1.9.3/test/main/Test/Calendar/ConvertBack.hs0000644000000000000000000000301007346545000021216 0ustar0000000000000000module Test.Calendar.ConvertBack(convertBack) where import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.Julian.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Compat 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 time-compat-1.9.3/test/main/Test/Calendar/Duration.hs0000644000000000000000000000342107346545000020610 0ustar0000000000000000module Test.Calendar.Duration ( testDuration ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Julian.Compat import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) testAddDiff :: TestTree testAddDiff = testGroup "add diff" [ testProperty "add diff GregorianDurationClip" $ \day1 day2 -> addGregorianDurationClip (diffGregorianDurationClip day2 day1) day1 == day2 , testProperty "add diff GregorianDurationRollOver" $ \day1 day2 -> addGregorianDurationRollOver (diffGregorianDurationRollOver day2 day1) day1 == day2 , testProperty "add diff JulianDurationClip" $ \day1 day2 -> addJulianDurationClip (diffJulianDurationClip day2 day1) day1 == day2 , testProperty "add diff JulianDurationRollOver" $ \day1 day2 -> addJulianDurationRollOver (diffJulianDurationRollOver day2 day1) day1 == day2 ] testClip :: (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree testClip (y1,m1,d1) (y2,m2,d2) (em, ed) = let day1 = fromGregorian y1 m1 d1 day2 = fromGregorian y2 m2 d2 expected = CalendarDiffDays em ed found = diffGregorianDurationClip day1 day2 in testCase (show day1 ++ " - " ++ show day2) $ assertEqual "" expected found testDiffs :: TestTree testDiffs = testGroup "diffs" [ testClip (2017, 04, 07) (2017, 04, 07) (0, 0) , testClip (2017, 04, 07) (2017, 04, 01) (0, 6) , testClip (2017, 04, 01) (2017, 04, 07) (0, -6) , testClip (2017, 04, 07) (2017, 02, 01) (2, 6) , testClip (2017, 02, 01) (2017, 04, 07) (-2, -6) ] testDuration :: TestTree testDuration = testGroup "CalendarDiffDays" [testAddDiff, testDiffs] time-compat-1.9.3/test/main/Test/Calendar/Easter.hs0000644000000000000000000000213207346545000020244 0ustar0000000000000000module Test.Calendar.Easter(testEaster) where import Data.Time.Calendar.Easter.Compat import Data.Time.Calendar.Compat import Data.Time.Format.Compat 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] time-compat-1.9.3/test/main/Test/Calendar/EasterRef.hs0000644000000000000000000000701407346545000020705 0ustar0000000000000000module 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" ] time-compat-1.9.3/test/main/Test/Calendar/LongWeekYears.hs0000644000000000000000000000123507346545000021543 0ustar0000000000000000module Test.Calendar.LongWeekYears(longWeekYears) where import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Compat 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] time-compat-1.9.3/test/main/Test/Calendar/LongWeekYearsRef.hs0000644000000000000000000000446007346545000022203 0ustar0000000000000000module 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: " ] time-compat-1.9.3/test/main/Test/Calendar/MonthDay.hs0000644000000000000000000000160207346545000020545 0ustar0000000000000000module Test.Calendar.MonthDay(testMonthDay) where import Data.Time.Calendar.MonthDay.Compat 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] time-compat-1.9.3/test/main/Test/Calendar/MonthDayRef.hs0000644000000000000000000003215007346545000021204 0ustar0000000000000000module 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" ] time-compat-1.9.3/test/main/Test/Calendar/Valid.hs0000644000000000000000000000747607346545000020100 0ustar0000000000000000module Test.Calendar.Valid(testValid) where import Data.Time.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Julian.Compat 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) ] time-compat-1.9.3/test/main/Test/Calendar/Week.hs0000644000000000000000000000625207346545000017723 0ustar0000000000000000module Test.Calendar.Week ( testWeek ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.WeekDate.Compat import Test.Tasty import Test.Tasty.HUnit testDay :: TestTree testDay = testCase "day" $ do let day = fromGregorian 2018 1 9 assertEqual "" (ModifiedJulianDay 58127) day assertEqual "" (2018, 2, 2) $ toWeekDate day assertEqual "" Tuesday $ dayOfWeek day allDaysOfWeek :: [DayOfWeek] allDaysOfWeek = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday] testAllDays :: String -> (DayOfWeek -> IO ()) -> TestTree testAllDays name f = testGroup name $ fmap (\wd -> testCase (show wd) $ f wd) allDaysOfWeek testSucc :: TestTree testSucc = testAllDays "succ" $ \wd -> assertEqual "" (toEnum $ succ $ fromEnum wd) $ succ wd testPred :: TestTree testPred = testAllDays "pred" $ \wd -> assertEqual "" (toEnum $ pred $ fromEnum wd) $ pred wd testSequences :: TestTree testSequences = testGroup "sequence" [ testCase "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday] , testCase "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday] , testCase "[Sunday .. Saturday]" $ assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday] , testCase "[Thursday .. Wednesday]" $ assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday] , testCase "[Tuesday ..]" $ assertEqual "" [ Tuesday , Wednesday , Thursday , Friday , Saturday , Sunday , Monday , Tuesday , Wednesday , Thursday , Friday , Saturday , Sunday , Monday , Tuesday ] $ take 15 [Tuesday ..] , testCase "[Wednesday, Tuesday ..]" $ assertEqual "" [ Wednesday , Tuesday , Monday , Sunday , Saturday , Friday , Thursday , Wednesday , Tuesday , Monday , Sunday , Saturday , Friday , Thursday , Wednesday ] $ take 15 [Wednesday,Tuesday ..] , testCase "[Sunday, Friday ..]" $ assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $ take 8 [Sunday,Friday ..] , testCase "[Monday,Sunday .. Tuesday]" $ assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday,Sunday .. Tuesday] , testCase "[Thursday, Saturday .. Tuesday]" $ assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday,Saturday .. Tuesday] ] testReadShow :: TestTree testReadShow = testAllDays "read show" $ \wd -> assertEqual "" wd $ read $ show wd testWeek :: TestTree testWeek = testGroup "Week" [testDay, testSucc, testPred, testSequences, testReadShow] time-compat-1.9.3/test/main/Test/Clock/0000755000000000000000000000000007346545000016011 5ustar0000000000000000time-compat-1.9.3/test/main/Test/Clock/Conversion.hs0000644000000000000000000000200307346545000020465 0ustar0000000000000000module Test.Clock.Conversion(testClockConversion) where import Data.Time.Clock.Compat import Data.Time.Clock.System.Compat 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) ] time-compat-1.9.3/test/main/Test/Clock/Resolution.hs0000644000000000000000000000273507346545000020517 0ustar0000000000000000module Test.Clock.Resolution(testResolutions) where import Data.Time.Clock.Compat import Data.Time.Clock.TAI.Compat import Control.Concurrent import Data.Fixed 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 -> [] time-compat-1.9.3/test/main/Test/Clock/TAI.hs0000644000000000000000000000442307346545000016765 0ustar0000000000000000# module Test.Clock.TAI(testTAI) where import Data.Time.Compat import Data.Time.Clock.TAI.Compat 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 ] ] time-compat-1.9.3/test/main/Test/Format/0000755000000000000000000000000007346545000016206 5ustar0000000000000000time-compat-1.9.3/test/main/Test/Format/Format.hs0000644000000000000000000001717007346545000020000 0ustar0000000000000000module Test.Format.Format(testFormat) where import Data.Time.Compat import Control.Monad (when) import Data.Proxy 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"] brokenFormats :: [String] brokenFormats = [ "%Z","%_Z","%-Z","%0Z" ,"%4Ez", "%4EZ" ,"%5Ez", "%5EZ" ,"%6Ez", "%6EZ" ,"%Ez", "%EZ" ] compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> proxy t -> TestTree compareExpected testname fmt str proxy = testCase testname $ when (fmt `notElem` brokenFormats) $ do let found :: ParseTime t => proxy t -> Maybe t found _ = parseTimeM False defaultTimeLocale fmt str assertEqual "" Nothing $ found proxy checkParse :: String -> String -> [TestTree] checkParse fmt str = [ compareExpected "Day" fmt str (Proxy :: Proxy Day), compareExpected "TimeOfDay" fmt str (Proxy :: Proxy TimeOfDay), compareExpected "LocalTime" fmt str (Proxy :: Proxy LocalTime), compareExpected "TimeZone" fmt str (Proxy :: Proxy TimeZone), compareExpected "UTCTime" fmt str (Proxy :: Proxy UTCTime) ] testCheckParse :: TestTree testCheckParse = testGroup "checkParse" $ tgroup formats $ \fmt -> tgroup somestrings $ \str -> checkParse fmt str days :: [Day] days = [(fromGregorian 2018 1 5) .. (fromGregorian 2018 1 26)] testDayOfWeek :: TestTree testDayOfWeek = testGroup "DayOfWeek" $ tgroup "uwaA" $ \fmt -> tgroup days $ \day -> let dayFormat = formatTime defaultTimeLocale ['%',fmt] day dowFormat = formatTime defaultTimeLocale ['%',fmt] $ dayOfWeek day in assertEqual "" dayFormat dowFormat {- testZone :: String -> String -> Int -> TestTree testZone fmt expected minutes = testCase (show fmt) $ assertEqual "" expected $ formatTime defaultTimeLocale fmt $ TimeZone minutes False "" testZonePair :: String -> String -> Int -> TestTree testZonePair mods expected minutes = testGroup (show mods ++ " " ++ show minutes) [ testZone ("%" ++ mods ++ "z") expected minutes, testZone ("%" ++ mods ++ "Z") expected minutes ] testTimeZone :: TestTree testTimeZone = testGroup "TimeZone" [ testZonePair "" "+0000" 0, testZonePair "E" "+00:00" 0, testZonePair "" "+0500" 300, testZonePair "E" "+05:00" 300, testZonePair "3" "+0500" 300, testZonePair "4E" "+05:00" 300, testZonePair "4" "+0500" 300, testZonePair "5E" "+05:00" 300, testZonePair "5" "+00500" 300, testZonePair "6E" "+005:00" 300, testZonePair "" "-0700" (-420), testZonePair "E" "-07:00" (-420), testZonePair "" "+1015" 615, testZonePair "E" "+10:15" 615, testZonePair "3" "+1015" 615, testZonePair "4E" "+10:15" 615, testZonePair "4" "+1015" 615, testZonePair "5E" "+10:15" 615, testZonePair "5" "+01015" 615, testZonePair "6E" "+010:15" 615, testZonePair "" "-1130" (-690), testZonePair "E" "-11:30" (-690) ] testAFormat :: FormatTime t => String -> String -> t -> TestTree testAFormat fmt expected t = testCase fmt $ assertEqual "" expected $ formatTime defaultTimeLocale fmt t testNominalDiffTime :: TestTree testNominalDiffTime = testGroup "NominalDiffTime" [ testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime), testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: NominalDiffTime), testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: NominalDiffTime), testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime), testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime), testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime), testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime), testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime), testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime) ] testDiffTime :: TestTree testDiffTime = testGroup "DiffTime" [ testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime), testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: DiffTime), testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: DiffTime), testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime), testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime), testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime), testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime), testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime), testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime) ] testCalenderDiffDays :: TestTree testCalenderDiffDays = testGroup "CalenderDiffDays" [ testAFormat "%yy%Bm%ww%Dd" "5y4m3w2d" $ CalendarDiffDays 64 23, testAFormat "%bm %dd" "64m 23d" $ CalendarDiffDays 64 23, testAFormat "%yy%Bm%ww%Dd" "-5y-4m-3w-2d" $ CalendarDiffDays (-64) (-23), testAFormat "%bm %dd" "-64m -23d" $ CalendarDiffDays (-64) (-23) ] testCalenderDiffTime :: TestTree testCalenderDiffTime = testGroup "CalenderDiffTime" [ testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "5y4m3w2d2h22m8s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21, testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "5y4m3w2d2h22m8.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21, testAFormat "%yy%Bm%ww%Dd%Hh%Mm%0ESs" "5y4m3w2d2h22m08.210000000000s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21, testAFormat "%bm %dd %hh %mm %Ess" "64m 23d 554h 33262m 1995728.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21, testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "-5y-4m-3w-2d-2h-22m-8s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21, testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "-5y-4m-3w-2d-2h-22m-8.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21, testAFormat "%bm %dd %hh %mm %Ess" "-64m -23d -554h -33262m -1995728.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21 ] -} testFormat :: TestTree testFormat = testGroup "testFormat" $ [ testCheckParse, testDayOfWeek -- testTimeZone, -- testNominalDiffTime, -- testDiffTime, -- testCalenderDiffDays, -- testCalenderDiffTime ] time-compat-1.9.3/test/main/Test/Format/ISO8601.hs0000644000000000000000000003473307346545000017525 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ISO8601(testISO8601) where import Data.Time.Compat import Data.Time.Format.ISO8601.Compat import Data.Ratio import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) import Test.TestUtil import Test.Arbitrary() deriving instance Eq ZonedTime readShowProperty :: (Eq a,Show a) => Format a -> a -> Property readShowProperty fmt val = case formatShowM fmt val of Nothing -> property Discard Just str -> let found = formatParseM fmt str expected = Just val in property $ if expected == found then succeeded else failed {reason = show str ++ ": expected " ++ (show expected) ++ ", found " ++ (show found)} readBoth :: NameTest t => (FormatExtension -> t) -> [TestTree] readBoth fmts = [ nameTest "extended" $ fmts ExtendedFormat, nameTest "basic" $ fmts BasicFormat ] readShowProperties :: (Eq a,Show a,Arbitrary a) => (FormatExtension -> Format a) -> [TestTree] readShowProperties fmts = readBoth $ \fe -> readShowProperty $ fmts fe newtype Durational t = MkDurational t instance Show t => Show (Durational t) where show (MkDurational t) = show t instance Arbitrary (Durational CalendarDiffDays) where arbitrary = do mm <- choose (-10000,10000) dd <- choose (-40,40) return $ MkDurational $ CalendarDiffDays mm dd instance Arbitrary (Durational CalendarDiffTime) where arbitrary = let limit = 40 * 86400 picofactor = 10 ^ (12 :: Int) in do mm <- choose (-10000,10000) ss <- choose (negate limit * picofactor, limit * picofactor) return $ MkDurational $ CalendarDiffTime mm $ fromRational $ ss % picofactor testReadShowFormat :: TestTree testReadShowFormat = nameTest "read-show format" [ nameTest "calendarFormat" $ readShowProperties $ calendarFormat, nameTest "yearMonthFormat" $ readShowProperty $ yearMonthFormat, nameTest "yearFormat" $ readShowProperty $ yearFormat, nameTest "centuryFormat" $ readShowProperty $ centuryFormat, nameTest "expandedCalendarFormat" $ readShowProperties $ expandedCalendarFormat 6, nameTest "expandedYearMonthFormat" $ readShowProperty $ expandedYearMonthFormat 6, nameTest "expandedYearFormat" $ readShowProperty $ expandedYearFormat 6, nameTest "expandedCenturyFormat" $ readShowProperty $ expandedCenturyFormat 4, nameTest "ordinalDateFormat" $ readShowProperties $ ordinalDateFormat, nameTest "expandedOrdinalDateFormat" $ readShowProperties $ expandedOrdinalDateFormat 6, nameTest "weekDateFormat" $ readShowProperties $ weekDateFormat, nameTest "yearWeekFormat" $ readShowProperties $ yearWeekFormat, nameTest "expandedWeekDateFormat" $ readShowProperties $ expandedWeekDateFormat 6, nameTest "expandedYearWeekFormat" $ readShowProperties $ expandedYearWeekFormat 6, nameTest "timeOfDayFormat" $ readShowProperties $ timeOfDayFormat, nameTest "hourMinuteFormat" $ readShowProperties $ hourMinuteFormat, nameTest "hourFormat" $ readShowProperty $ hourFormat, nameTest "withTimeDesignator" $ readShowProperties $ \fe -> withTimeDesignator $ timeOfDayFormat fe, nameTest "withUTCDesignator" $ readShowProperties $ \fe -> withUTCDesignator $ timeOfDayFormat fe, nameTest "timeOffsetFormat" $ readShowProperties $ timeOffsetFormat, nameTest "timeOfDayAndOffsetFormat" $ readShowProperties $ timeOfDayAndOffsetFormat, nameTest "localTimeFormat" $ readShowProperties $ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe), nameTest "zonedTimeFormat" $ readShowProperties $ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe, nameTest "utcTimeFormat" $ readShowProperties $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe), nameTest "dayAndTimeFormat" $ readShowProperties $ \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe), nameTest "timeAndOffsetFormat" $ readShowProperties $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe, nameTest "durationDaysFormat" $ readShowProperty $ durationDaysFormat, nameTest "durationTimeFormat" $ readShowProperty $ durationTimeFormat, nameTest "alternativeDurationDaysFormat" $ readBoth $ \fe (MkDurational t) -> readShowProperty (alternativeDurationDaysFormat fe) t, nameTest "alternativeDurationTimeFormat" $ readBoth $ \fe (MkDurational t) -> readShowProperty (alternativeDurationTimeFormat fe) t, nameTest "intervalFormat" $ readShowProperties $ \fe -> intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat, nameTest "recurringIntervalFormat" $ readShowProperties $ \fe -> recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat ] testShowFormat :: String -> Format t -> String -> t -> TestTree testShowFormat name fmt str t = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just str) $ formatShowM fmt t testShowFormats :: TestTree testShowFormats = nameTest "show format" [ testShowFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0, testShowFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0, testShowFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0, testShowFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5, testShowFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81, testShowFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0, testShowFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0, testShowFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0, testShowFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay, testShowFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay, testShowFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200, testShowFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180, testShowFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12, testShowFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634, testShowFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634, testShowFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $ CalendarDiffTime 0 $ 5 * nominalDay + 7278.77634, testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $ CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634, testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $ CalendarDiffTime 94 $ 7278.77634, testShowFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634, testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $ CalendarDiffDays 12 0, testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $ CalendarDiffDays 27 29, testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $ CalendarDiffDays (561 * 12 + 8) 29, testShowFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P0000-00-01T00:00:00" $ CalendarDiffTime 0 86400, testShowFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P0007-10-05T02:01:18.77634" $ CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634, testShowFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P4271-10-05T02:01:18.77634" $ CalendarDiffTime (12 * 4271 + 10) $ 5 * nominalDay + 7278.77634, testShowFormat "centuryFormat" centuryFormat "02" 2, testShowFormat "centuryFormat" centuryFormat "21" 21, testShowFormat "intervalFormat etc." (intervalFormat (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat)) durationTimeFormat) "2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S" (LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56),CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34), testShowFormat "recurringIntervalFormat etc." (recurringIntervalFormat (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat)) durationTimeFormat) "R74/2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S" (74,LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56),CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34), testShowFormat "recurringIntervalFormat etc." (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat) "R74/2015-06-13/P1Y2M7D" (74,fromGregorian 2015 6 13,CalendarDiffDays 14 7), testShowFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390)), testShowFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0), testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0), testShowFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10), testShowFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10)), testShowFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95), testShowFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95)), testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95), testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95)), testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-1100" (minutesToTimeZone $ negate $ 11 * 60), testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615), testShowFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553-06:30" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-390))), testShowFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553+06:30" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 390)), testShowFormat "utcTimeFormat" iso8601Format "2024-07-06T08:45:56.553Z" (UTCTime (fromGregorian 2024 07 06) (timeOfDayToTime $ TimeOfDay 8 45 56.553)), testShowFormat "utcTimeFormat" iso8601Format "2028-12-31T23:59:60.9Z" (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9)), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10), testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10), testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4), testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4), testShowFormat "weekDateFormat" (expandedWeekDateFormat 6 ExtendedFormat) "+001995-W05-6" (fromGregorian 1995 2 4), testShowFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4), testShowFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23), testShowFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23), testShowFormat "ordinalDateFormat" (expandedOrdinalDateFormat 5 ExtendedFormat) "+01846-235" (fromGregorian 1846 8 23), testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15), testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24), testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15), testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24), testShowFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0), testShowFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0), testShowFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51) ] testISO8601 :: TestTree testISO8601 = nameTest "ISO8601" [ testShowFormats, testReadShowFormat ] time-compat-1.9.3/test/main/Test/Format/ParseTime.hs0000644000000000000000000004766707346545000020457 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ParseTime(testParseTime,test_parse_format) where import Data.Time.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Control.Monad import Data.Char import Text.Read.Compat import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) import Test.TestUtil import Test.Arbitrary() 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 Test.Tasty.HUnit.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 :: Integer) "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 Test.Tasty.HUnit.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 Test.Tasty.HUnit.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) #if !MIN_VERSION_time(1,5,0) knownTimeZones _ = [] #endif 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 -- 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 (Just t) (readMaybe (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) => 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 "ZonedTime" $ tgroup zonedTimeAlmostFormats $ \fmt t -> (todSec $ localTimeOfDay $ zonedTimeToLocalTime t) < 60 ==> prop fmt t, nameTest "UTCTime" $ tgroup utcTimeAlmostFormats $ \fmt t -> utctDayTime t < 86400 ==> prop fmt t, nameTest "UniversalTime" $ tgroup universalTimeFormats prop -- nameTest "CalendarDiffDays" $ tgroup calendarDiffDaysFormats prop, -- nameTest "CalenderDiffTime" $ tgroup calendarDiffTimeFormats prop, -- nameTest "DiffTime" $ tgroup diffTimeFormats prop, -- nameTest "NominalDiffTime" $ tgroup nominalDiffTimeFormats 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 ++ zonedTimeAlmostFormats ++ partialZonedTimeFormats) prop_no_crash_bad_input, nameTest "UTCTime" $ tgroup (utcTimeAlmostFormats ++ 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) --nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result), --nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> 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", "%a, %d %b %Y %H:%M:%S.%q %Z", "%a, %d %b %Y %H:%M:%S%Q %Z"] zonedTimeAlmostFormats :: [FormatString ZonedTime] zonedTimeAlmostFormats = map FormatString ["%s.%q %z", "%s%Q %z", "%s.%q %Z", "%s%Q %Z"] utcTimeAlmostFormats :: [FormatString UTCTime] utcTimeAlmostFormats = map FormatString ["%s.%q","%s%Q"] universalTimeFormats :: [FormatString UniversalTime] universalTimeFormats = map FormatString [] calendarDiffDaysFormats :: [FormatString CalendarDiffDays] calendarDiffDaysFormats = map FormatString ["%yy%Bm%ww%Dd","%yy%Bm%dd","%bm%ww%Dd","%bm%dd"] calendarDiffTimeFormats :: [FormatString CalendarDiffTime] calendarDiffTimeFormats = map FormatString ["%yy%Bm%ww%Dd%Hh%Mm%ESs","%bm%ww%Dd%Hh%Mm%ESs","%bm%dd%Hh%Mm%ESs","%bm%hh%Mm%ESs","%bm%mm%ESs","%bm%mm%0ESs","%bm%Ess","%bm%0Ess"] diffTimeFormats :: [FormatString DiffTime] diffTimeFormats = map FormatString ["%ww%Dd%Hh%Mm%ESs","%dd%Hh%Mm%ESs","%hh%Mm%ESs","%mm%ESs","%mm%0ESs","%Ess","%0Ess"] nominalDiffTimeFormats :: [FormatString NominalDiffTime] nominalDiffTimeFormats = map FormatString ["%ww%Dd%Hh%Mm%ESs","%dd%Hh%Mm%ESs","%hh%Mm%ESs","%mm%ESs","%mm%0ESs","%Ess","%0Ess"] -- -- * 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" ] time-compat-1.9.3/test/main/Test/LocalTime/0000755000000000000000000000000007346545000016627 5ustar0000000000000000time-compat-1.9.3/test/main/Test/LocalTime/CalendarDiffTime.hs0000644000000000000000000000070407346545000022305 0ustar0000000000000000module Test.LocalTime.CalendarDiffTime ( testCalendarDiffTime ) where --import Data.Time.LocalTime import Test.Arbitrary () import Test.Tasty --import Test.Tasty.QuickCheck hiding (reason) --testReadShow :: TestTree --testReadShow = testProperty "read . show" $ \(t :: CalendarDiffTime) -> read (show t) == t testCalendarDiffTime :: TestTree testCalendarDiffTime = testGroup "CalendarDiffTime" [ --testReadShow ] time-compat-1.9.3/test/main/Test/LocalTime/Time.hs0000644000000000000000000000613107346545000020062 0ustar0000000000000000module Test.LocalTime.Time(testTime) where import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Compat 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 -- , show $ f $ TimeOfDay minBound 0 0 ] testTime :: TestTree testTime = testCase "testTime" $ assertEqual "times" testTimeRef $ unlines [ testCal, testUTC, testUT1, testTimeOfDayToDayFraction] time-compat-1.9.3/test/main/Test/LocalTime/TimeOfDay.hs0000644000000000000000000000123707346545000021007 0ustar0000000000000000module Test.LocalTime.TimeOfDay ( testTimeOfDay ) where import Data.Time.LocalTime.Compat import Test.Arbitrary () import Test.Tasty import Test.Tasty.QuickCheck hiding (reason) testTimeOfDay :: TestTree testTimeOfDay = testGroup "TimeOfDay" [ testProperty "daysAndTimeOfDayToTime . timeToDaysAndTimeOfDay" $ \ndt -> let (d, tod) = timeToDaysAndTimeOfDay ndt ndt' = daysAndTimeOfDayToTime d tod in ndt' == ndt , testProperty "timeOfDayToTime . timeToTimeOfDay" $ \dt -> let tod = timeToTimeOfDay dt dt' = timeOfDayToTime tod in dt' == dt ] time-compat-1.9.3/test/main/Test/LocalTime/TimeRef.hs0000644000000000000000000010754207346545000020527 0ustar0000000000000000module Test.LocalTime.TimeRef where import Data.Int is64Bit :: Bool is64Bit = if toInteger (maxBound :: Int) == toInteger (maxBound :: Int32) then False else if toInteger (maxBound :: Int) == toInteger (maxBound :: Int64) then True else error "unrecognised Int size" 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" -- ,if is64Bit then "-9223372036854775808:00:00" else "-2147483648:00:00" ,"" ] time-compat-1.9.3/test/main/Test/TestUtil.hs0000644000000000000000000000166007346545000017072 0ustar0000000000000000module 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 -- returns () in some versions 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 = Test.Tasty.HUnit.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 time-compat-1.9.3/time-compat.cabal0000644000000000000000000001037507346545000015345 0ustar0000000000000000cabal-version: 1.12 name: time-compat version: 1.9.3 synopsis: Compatibility package for time description: This packages tries to compat as much of @time@ features as possible. . /TODO:/ . * Difference type @ParseTime@ and @FormatTime@ instances are missing. . * Formatting varies depending on underlying @time@ version . * @dayFractionToTimeOfDay@ on extreme values category: Time, Compatibility license: BSD3 license-file: LICENSE maintainer: Oleg Grenrus author: Ashley Yakeley homepage: https://github.com/phadej/time-compat bug-reports: https://github.com/phadej/time-compat/issues build-type: Simple extra-source-files: CHANGELOG.md tested-with: GHC ==7.0.4 || ==7.2.2 || ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1 source-repository head type: git location: https://github.com/phadej/time-compat.git flag old-locale description: If true, use old-locale, otherwise use time 1.5 or newer. manual: False default: False library default-language: Haskell2010 hs-source-dirs: src other-extensions: CPP if impl(ghc >=7.2) default-extensions: Trustworthy build-depends: base >=4.3 && <4.15 , base-orphans >=0.8.1 && <0.9 , deepseq >=1.3.0.0 && <1.4 || >=1.4.1.1 && <1.5 , time >=1.2 && <1.3 || >=1.4 && <1.7 || >=1.8 && <1.9 || >=1.9.2 && <1.9.4 || >=1.10 && <1.10.1 if flag(old-locale) build-depends: old-locale >=1.0.0.2 && <1.1 , time >=0 && <1.5 else build-depends: time >=1.5 if !impl(ghc >=8.0) build-depends: fail >=4.9.0.0 && <4.10 , semigroups >=0.18.5 && <0.20 exposed-modules: Data.Time.Calendar.Compat Data.Time.Calendar.Easter.Compat Data.Time.Calendar.Julian.Compat Data.Time.Calendar.MonthDay.Compat Data.Time.Calendar.OrdinalDate.Compat Data.Time.Calendar.WeekDate.Compat Data.Time.Clock.Compat Data.Time.Clock.POSIX.Compat Data.Time.Clock.System.Compat Data.Time.Clock.TAI.Compat Data.Time.Compat Data.Time.Format.Compat Data.Time.Format.ISO8601.Compat Data.Time.LocalTime.Compat other-modules: Data.Format Data.Time.Calendar.Private Data.Time.Orphans test-suite instances default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs build-depends: base , deepseq , HUnit >=1.3.1 && <1.3.2 || >=1.6.0.0 && <1.7 , time-compat -- This test-suite is from test library test-suite main if !impl(ghc >=7.4) buildable: False default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test/main default-extensions: CPP DeriveDataTypeable ExistentialQuantification FlexibleInstances MultiParamTypeClasses Rank2Types ScopedTypeVariables StandaloneDeriving TupleSections UndecidableInstances ghc-options: -Wall -fwarn-tabs build-depends: base , base-compat >=0.10.5 && <0.12 , deepseq , QuickCheck >=2.13 && <2.14 , tagged >=0.8.6 && <0.9 , tasty >=1.2.1 && <1.3 , tasty-hunit >=0.10 && <0.11 , tasty-quickcheck >=0.10 && <0.11 , time-compat build-depends: time main-is: Main.hs other-modules: Test.Arbitrary Test.Calendar.AddDays Test.Calendar.AddDaysRef Test.Calendar.Calendars Test.Calendar.CalendarsRef Test.Calendar.ClipDates Test.Calendar.ClipDatesRef Test.Calendar.ConvertBack Test.Calendar.Duration Test.Calendar.Easter Test.Calendar.EasterRef Test.Calendar.LongWeekYears Test.Calendar.LongWeekYearsRef Test.Calendar.MonthDay Test.Calendar.MonthDayRef Test.Calendar.Valid Test.Calendar.Week Test.Clock.Conversion Test.Clock.Resolution Test.Clock.TAI Test.Format.Format Test.Format.ISO8601 Test.Format.ParseTime Test.LocalTime.CalendarDiffTime Test.LocalTime.Time Test.LocalTime.TimeOfDay Test.LocalTime.TimeRef Test.TestUtil