time-compat-1.9.6.1/0000755000000000000000000000000007346545000012276 5ustar0000000000000000time-compat-1.9.6.1/CHANGELOG.md0000644000000000000000000000140007346545000014102 0ustar0000000000000000# 1.9.6.1 - Support `time-1.12`. # 1.9.6 - Move `Hashable` instance here from `hashable-time` package. Note: `ZonedTime` instance is dropped, as `ZonedTime` doesn't have `Eq` instance. - Drop GHC-7.0 and GHC-7.2 support. # 1.9.5 - Support `time-1.11.1` - Add `NFData CalandarDiffDays` instance # 1.9.4 - Support `time-1.11` - `Data.Time.Calendar.Month` - `Data.Time.Calendar.Quarter` - Pattern synonyms - `parseTimeMultipleM` is not backported - `Month` is missing `ParseTime` instance - Compat extras: - Add `Ix`, `Enum`, `NFData` instances to `Month`, `Quarter`, `QuarterOfYear`, `CalendarDiffTime` and `DayOfWeek`. # 1.9.3 - Include `pastMidnight` and `sinceMidnight` aliases (backported from `time-1.10`) - Support `time-1.10` time-compat-1.9.6.1/LICENSE0000644000000000000000000000300307346545000013277 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.6.1/src/Data/0000755000000000000000000000000007346545000013736 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Format.hs0000644000000000000000000001621007346545000015522 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.6.1/src/Data/Time/Calendar/0000755000000000000000000000000007346545000016345 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/Compat.hs0000644000000000000000000001402207346545000020123 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif 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, dayOfWeekDiff, firstDayOfWeekOnAfter, -- * Type aliases DayOfMonth, MonthOfYear, Year, #if __GLASGOW_HASKELL__ >= 710 pattern YearMonthDay, #endif ) where import Data.Time.Calendar import Data.Time.Format import Data.Time.Orphans () #if !MIN_VERSION_time(1,11,0) import Data.Time.Calendar.Types #endif #if !MIN_VERSION_time(1,9,0) import Data.Time.Calendar.WeekDate.Compat #endif #if !MIN_VERSION_time(1,5,0) import System.Locale (TimeLocale (..)) #endif import Control.DeepSeq (NFData (..)) import Data.Data (Data, Typeable) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) ------------------------------------------------------------------------------- -- CalendarDiffTime ------------------------------------------------------------------------------- #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(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" instance NFData CalendarDiffDays where rnf (CalendarDiffDays x y) = rnf x `seq` rnf y 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 #if !MIN_VERSION_time(1,11,0) #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor for the proleptic Gregorian calendar. -- Invalid values will be clipped to the correct range, month first, then day. pattern YearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day pattern YearMonthDay y m d <- (toGregorian -> (y,m,d)) where YearMonthDay y m d = fromGregorian y m d #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearMonthDay #-} #endif #endif #endif ------------------------------------------------------------------------------- -- DayOfWeek ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,11,0) -- | @dayOfWeekDiff a b = a - b@ in range 0 to 6. -- The number of days from b to the next a. dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7 -- | The first day-of-week on or after some day firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d #endif time-compat-1.9.6.1/src/Data/Time/Calendar/Easter/0000755000000000000000000000000007346545000017570 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/Easter/Compat.hs0000644000000000000000000000032607346545000021350 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.6.1/src/Data/Time/Calendar/Julian/0000755000000000000000000000000007346545000017567 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/Julian/Compat.hs0000644000000000000000000000614207346545000021351 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif module Data.Time.Calendar.Julian.Compat ( Year, MonthOfYear, DayOfMonth, DayOfYear, -- JulianYearDay toJulianYearAndDay, fromJulianYearAndDay, fromJulianYearAndDayValid, showJulianYearAndDay, isJulianLeapYear, toJulian,fromJulian, #if __GLASGOW_HASKELL__ >= 710 pattern JulianYearMonthDay, #endif 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,11,0) import Data.Time.Calendar.Types #endif #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 #if !MIN_VERSION_time(1,11,0) #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor for the proleptic Julian calendar. -- Invalid values will be clipped to the correct range, month first, then day. pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day pattern JulianYearMonthDay y m d <- (toJulian -> (y,m,d)) where JulianYearMonthDay y m d = fromJulian y m d #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE JulianYearMonthDay #-} #endif #endif #endif time-compat-1.9.6.1/src/Data/Time/Calendar/Month/0000755000000000000000000000000007346545000017432 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/Month/Compat.hs0000644000000000000000000001414007346545000021211 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif module Data.Time.Calendar.Month.Compat ( Month(..), addMonths, diffMonths, #if __GLASGOW_HASKELL__ >= 710 pattern YearMonth, #endif fromYearMonthValid, #if __GLASGOW_HASKELL__ >= 710 pattern MonthDay, #endif fromMonthDayValid, -- * time-compat extras fromYearMonth, toYearMonth, fromMonthDay, toMonthDay, ) where #if MIN_VERSION_time(1,11,0) import Data.Time.Calendar import Data.Time.Calendar.Month -- | Part of @YearMonth@ pattern fromYearMonth :: Year -> MonthOfYear -> Month fromYearMonth = YearMonth -- | Part of @YearMonth@ pattern toYearMonth :: Month -> (Year, MonthOfYear) toYearMonth (YearMonth y m) = (y, m) -- | Part of 'MonthDay' pattern fromMonthDay :: Month -> DayOfMonth -> Day fromMonthDay = MonthDay -- | Part of 'MonthDay' pattern toMonthDay :: Day -> (Month,DayOfMonth) toMonthDay (MonthDay m d) = (m, d) #else #if MIN_VERSION_time(1,9,0) import Data.Time.Format.Internal #else import Data.Time.Format #endif import Data.Time.Calendar import Data.Time.Calendar.Julian import Data.Time.Calendar.Types -- import Data.Time.Calendar.Days import Data.Time.Calendar.Private import Data.Data import Data.Fixed import Text.Read import Text.ParserCombinators.ReadP import Control.DeepSeq (NFData (..)) import Data.Ix (Ix (..)) import Data.Hashable (Hashable (..)) -- | An absolute count of common calendar months. -- Number is equal to @(year * 12) + (monthOfYear - 1)@. newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable) instance NFData Month where rnf (MkMonth m) = rnf m instance Hashable Month where hashWithSalt salt (MkMonth x) = hashWithSalt salt x instance Enum Month where succ (MkMonth a) = MkMonth (succ a) pred (MkMonth a) = MkMonth (pred a) toEnum = MkMonth . toEnum fromEnum (MkMonth a) = fromEnum a enumFrom (MkMonth a) = fmap MkMonth (enumFrom a) enumFromThen (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromThen a b) enumFromTo (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromTo a b) enumFromThenTo (MkMonth a) (MkMonth b) (MkMonth c) = fmap MkMonth (enumFromThenTo a b c) instance Ix Month where range (MkMonth a, MkMonth b) = fmap MkMonth (range (a, b)) index (MkMonth a, MkMonth b) (MkMonth c) = index (a, b) c inRange (MkMonth a, MkMonth b) (MkMonth c) = inRange (a, b) c rangeSize (MkMonth a, MkMonth b) = rangeSize (a, b) -- | Show as @yyyy-mm@. instance Show Month where show ym = case toYearMonth ym of (y, m) -> show4 y ++ "-" ++ show2 m -- | Read as @yyyy-mm@. instance Read Month where readPrec = do y <- readPrec _ <- lift $ char '-' m <- readPrec return $ fromYearMonth y m ------------------------------------------------------------------------------- -- ForematTime Month ------------------------------------------------------------------------------- toSomeDay :: Month -> Day toSomeDay (MkMonth m) = let (y,my) = divMod' m 12 in fromGregorian y (succ (fromInteger my)) 1 #if MIN_VERSION_time(1,9,0) #define FORMAT_OPTS fo #elif MIN_VERSION_time(1,8,0) #define FORMAT_OPTS tl mpo i #else #define FORMAT_OPTS tl mpo #endif #if MIN_VERSION_time(1,9,0) #define FORMAT_ARG _arg #else #define FORMAT_ARG #endif instance FormatTime Month where -- Year Count formatCharacter FORMAT_ARG 'Y' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'Y') formatCharacter FORMAT_ARG 'y' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'y') formatCharacter FORMAT_ARG 'c' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'c') -- Month of Year formatCharacter FORMAT_ARG 'B' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'B') formatCharacter FORMAT_ARG 'b' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'b') formatCharacter FORMAT_ARG 'h' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'h') formatCharacter FORMAT_ARG 'm' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter FORMAT_ARG 'm') formatCharacter FORMAT_ARG _ = Nothing addMonths :: Integer -> Month -> Month addMonths n (MkMonth a) = MkMonth $ a + n diffMonths :: Month -> Month -> Integer diffMonths (MkMonth a) (MkMonth b) = a - b fromYearMonthValid :: Year -> MonthOfYear -> Maybe Month fromYearMonthValid y my = do my' <- clipValid 1 12 my return $ fromYearMonth y my' -- | Part of @YearMonth@ pattern fromYearMonth :: Year -> MonthOfYear -> Month fromYearMonth y my = MkMonth $ (y * 12) + toInteger (pred $ clip 1 12 my) -- | Part of @YearMonth@ pattern toYearMonth :: Month -> (Year, MonthOfYear) toYearMonth (MkMonth m) = case divMod' m 12 of (y, my) -> (y, succ (fromInteger my)) #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor. -- Invalid months of year will be clipped to the correct range. pattern YearMonth :: Year -> MonthOfYear -> Month pattern YearMonth y my <- (toYearMonth -> (y, my)) where YearMonth y my = fromYearMonth y my #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearMonth #-} #endif #endif -- | Part of 'MonthDay' pattern toMonthDay :: Day -> (Month,DayOfMonth) toMonthDay d = case toGregorian d of (y, my, dm) -> (fromYearMonth y my, dm) -- | Part of 'MonthDay' pattern fromMonthDay :: Month -> DayOfMonth -> Day fromMonthDay m dm = case toYearMonth m of (y, my) -> fromGregorian y my dm fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day fromMonthDayValid m dm = case toYearMonth m of (y, my) -> fromGregorianValid y my dm #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor. -- Invalid days of month will be clipped to the correct range. pattern MonthDay :: Month -> DayOfMonth -> Day pattern MonthDay m dm <- (toMonthDay -> (m,dm)) where MonthDay (YearMonth y my) dm = fromGregorian y my dm #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE MonthDay #-} #endif #endif #endif time-compat-1.9.6.1/src/Data/Time/Calendar/MonthDay/0000755000000000000000000000000007346545000020070 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/MonthDay/Compat.hs0000644000000000000000000000254607346545000021656 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} #endif module Data.Time.Calendar.MonthDay.Compat ( MonthOfYear, DayOfMonth, DayOfYear, #if __GLASGOW_HASKELL__ >= 710 -- patterns #endif monthAndDayToDayOfYear, monthAndDayToDayOfYearValid, dayOfYearToMonthAndDay, monthLength, ) where import Data.Time.Orphans () import Data.Time.Calendar.MonthDay #if !MIN_VERSION_time(1,11,0) import Data.Time.Calendar.Types #endif {- #if !MIN_VERSION_time(1,12,0) #if __GLASGOW_HASKELL__ >= 710 pattern January :: MonthOfYear pattern January = 1 pattern February :: MonthOfYear pattern February = 2 pattern March :: MonthOfYear pattern March = 3 pattern April :: MonthOfYear pattern April = 4 pattern May :: MonthOfYear pattern May = 5 pattern June :: MonthOfYear pattern June = 6 pattern July :: MonthOfYear pattern July = 7 pattern August :: MonthOfYear pattern August = 8 pattern September :: MonthOfYear pattern September = 9 pattern October :: MonthOfYear pattern October = 10 pattern November :: MonthOfYear pattern November = 11 -- | The twelve 'MonthOfYear' patterns form a @COMPLETE@ set. pattern December :: MonthOfYear pattern December = 12 #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE January, February, March, April, May, June, July, August, September, October, November, December #-} #endif #endif #endif -} time-compat-1.9.6.1/src/Data/Time/Calendar/OrdinalDate/0000755000000000000000000000000007346545000020533 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/OrdinalDate/Compat.hs0000644000000000000000000000435707346545000022323 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif module Data.Time.Calendar.OrdinalDate.Compat ( Day, Year, DayOfYear, WeekOfYear, toOrdinalDate, fromOrdinalDate, #if __GLASGOW_HASKELL__ >= 710 pattern YearDay, #endif fromOrdinalDateValid, showOrdinalDate, isLeapYear, mondayStartWeek, sundayStartWeek, fromMondayStartWeek, fromMondayStartWeekValid, fromSundayStartWeek, fromSundayStartWeekValid, ) where import Data.Time.Orphans () import Data.Time.Calendar.OrdinalDate hiding (fromSundayStartWeekValid) #if MIN_VERSION_time(1,6,0) import Data.Time.Calendar.OrdinalDate (fromSundayStartWeekValid) #else import Data.Time.Calendar.Private #endif #if !MIN_VERSION_time(1,11,0) import Data.Time.Calendar import Data.Time.Calendar.Types #endif #if !MIN_VERSION_time(1,11,0) #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor for ISO 8601 Ordinal Date format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366). pattern YearDay :: Year -> DayOfYear -> Day pattern YearDay y d <- (toOrdinalDate -> (y,d)) where YearDay y d = fromOrdinalDate y d #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearDay #-} #endif #endif #endif #if !MIN_VERSION_time(1,6,0) fromSundayStartWeekValid :: Year -- ^ Year. -> WeekOfYear -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime'). -> Int -- ^ Day of week. -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime'). -> Maybe Day fromSundayStartWeekValid year w d = do d' <- clipValid 0 6 d let -- first day of the year firstDay = fromOrdinalDate year 1 -- 0-based week of year zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7 -- 0-based week number zbWeek = w - 1 -- 0-based day of week zbDay = d' -- 0-based day in year zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay return $ addDays zbYearDay' firstDay #endif time-compat-1.9.6.1/src/Data/Time/Calendar/Private.hs0000644000000000000000000000335607346545000020322 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.6.1/src/Data/Time/Calendar/Quarter/0000755000000000000000000000000007346545000017770 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/Quarter/Compat.hs0000644000000000000000000001123207346545000021546 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif module Data.Time.Calendar.Quarter.Compat ( QuarterOfYear(..), addQuarters, diffQuarters, Quarter(..), #if __GLASGOW_HASKELL__ >= 710 pattern YearQuarter, #endif monthOfYearQuarter, monthQuarter, dayQuarter, -- * time-compat extras fromYearQuarter, toYearQuarter, ) where #if MIN_VERSION_time(1,11,0) import Data.Time.Calendar (Year) import Data.Time.Calendar.Quarter -- | Part of @YearQuarter@ pattern fromYearQuarter :: Year -> QuarterOfYear -> Quarter fromYearQuarter = YearQuarter -- | Part of @YearQuarter@ pattern toYearQuarter :: Quarter -> (Year, QuarterOfYear) toYearQuarter (YearQuarter y m) = (y, m) #else import Data.Data (Data) import Data.Typeable (Typeable) import Text.Read (Read (..)) import Data.Fixed (mod', divMod') import Text.ParserCombinators.ReadPrec (lift) import Text.ParserCombinators.ReadP (char) import Control.DeepSeq (NFData (..)) import Data.Ix (Ix (..)) import Data.Hashable (Hashable (..)) import Data.Time.Calendar import Data.Time.Calendar.Types import Data.Time.Calendar.Private import Data.Time.Calendar.Month.Compat -- | Quarters of each year. Each quarter corresponds to three months. data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Data, Typeable, Read, Show) instance NFData QuarterOfYear where rnf Q1 = () rnf Q2 = () rnf Q3 = () rnf Q4 = () instance Hashable QuarterOfYear where hashWithSalt salt = hashWithSalt salt . fromEnum -- | maps Q1..Q4 to 1..4 instance Enum QuarterOfYear where toEnum i = case mod' i 4 of 1 -> Q1 2 -> Q2 3 -> Q3 _ -> Q4 fromEnum Q1 = 1 fromEnum Q2 = 2 fromEnum Q3 = 3 fromEnum Q4 = 4 instance Bounded QuarterOfYear where minBound = Q1 maxBound = Q4 -- | An absolute count of year quarters. -- Number is equal to @(year * 4) + (quarterOfYear - 1)@. newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable) instance NFData Quarter where rnf (MkQuarter m) = rnf m instance Hashable Quarter where hashWithSalt salt (MkQuarter x) = hashWithSalt salt x instance Enum Quarter where succ (MkQuarter a) = MkQuarter (succ a) pred (MkQuarter a) = MkQuarter (pred a) toEnum = MkQuarter . toEnum fromEnum (MkQuarter a) = fromEnum a enumFrom (MkQuarter a) = fmap MkQuarter (enumFrom a) enumFromThen (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromThen a b) enumFromTo (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromTo a b) enumFromThenTo (MkQuarter a) (MkQuarter b) (MkQuarter c) = fmap MkQuarter (enumFromThenTo a b c) instance Ix Quarter where range (MkQuarter a, MkQuarter b) = fmap MkQuarter (range (a, b)) index (MkQuarter a, MkQuarter b) (MkQuarter c) = index (a, b) c inRange (MkQuarter a, MkQuarter b) (MkQuarter c) = inRange (a, b) c rangeSize (MkQuarter a, MkQuarter b) = rangeSize (a, b) -- | Show as @yyyy-Qn@. instance Show Quarter where show q = case toYearQuarter q of (y, qy) -> show4 y ++ "-" ++ show qy -- | Read as @yyyy-Qn@. instance Read Quarter where readPrec = do y <- readPrec _ <- lift $ char '-' m <- readPrec return $ fromYearQuarter y m addQuarters :: Integer -> Quarter -> Quarter addQuarters n (MkQuarter a) = MkQuarter $ a + n diffQuarters :: Quarter -> Quarter -> Integer diffQuarters (MkQuarter a) (MkQuarter b) = a - b #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor. pattern YearQuarter :: Year -> QuarterOfYear -> Quarter pattern YearQuarter y qy <- (toYearQuarter -> (y, qy)) where YearQuarter y qy = fromYearQuarter y qy #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearQuarter #-} #endif #endif monthOfYearQuarter :: MonthOfYear -> QuarterOfYear monthOfYearQuarter my | my <= 3 = Q1 monthOfYearQuarter my | my <= 6 = Q2 monthOfYearQuarter my | my <= 9 = Q3 monthOfYearQuarter _ = Q4 monthQuarter :: Month -> Quarter monthQuarter m = case toYearMonth m of (y, my) -> fromYearQuarter y $ monthOfYearQuarter my dayQuarter :: Day -> Quarter dayQuarter d = case toMonthDay d of (m, _) -> monthQuarter m -- | Part of @YearQuarter@ pattern fromYearQuarter :: Year -> QuarterOfYear -> Quarter fromYearQuarter y qy = MkQuarter $ y * 4 + toInteger (pred $ fromEnum qy) -- | Part of @YearQuarter@ pattern toYearQuarter :: Quarter -> (Year, QuarterOfYear) toYearQuarter (MkQuarter y) = case divMod' y 4 of (y, qy) -> (y, toEnum (succ (fromInteger qy))) #endif time-compat-1.9.6.1/src/Data/Time/Calendar/Types.hs0000644000000000000000000000141507346545000020006 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.Types ( Year, MonthOfYear, DayOfMonth, DayOfYear, WeekOfYear, ) where #if MIN_VERSION_time(1,11,0) import Data.Time.Calendar (DayOfMonth, MonthOfYear, Year) import Data.Time.Calendar.MonthDay (DayOfYear) import Data.Time.Calendar.WeekDate (WeekOfYear) #else -- | Year of Common Era. type Year = Integer -- | Month of year, in range 1 (January) to 12 (December). type MonthOfYear = Int -- | Day of month, in range 1 to 31. type DayOfMonth = Int -- | Day of year, in range 1 (January 1st) to 366. -- December 31st is 365 in a common year, 366 in a leap year. type DayOfYear = Int -- | Week of year, by various reckonings, generally in range 0-53 depending on reckoning type WeekOfYear = Int #endif time-compat-1.9.6.1/src/Data/Time/Calendar/WeekDate/0000755000000000000000000000000007346545000020036 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Calendar/WeekDate/Compat.hs0000644000000000000000000001452307346545000021622 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} #endif module Data.Time.Calendar.WeekDate.Compat ( Year, WeekOfYear, DayOfWeek(..), dayOfWeek, FirstWeekType (..), toWeekCalendar, fromWeekCalendar, fromWeekCalendarValid, -- * ISO 8601 Week Date format toWeekDate, fromWeekDate, #if __GLASGOW_HASKELL__ >= 710 pattern YearWeekDay, #endif fromWeekDateValid, showWeekDate, ) where import Data.Time.Orphans () import Data.Time.Calendar import Data.Time.Calendar.WeekDate #if !MIN_VERSION_time(1,9,0) import Data.Time.Format #endif #if !MIN_VERSION_time(1,11,0) import Data.Data (Data) import Data.Typeable (Typeable) import Data.Time.Calendar.Types import Data.Time.Calendar.Private import Data.Time.Calendar.OrdinalDate #endif import Control.DeepSeq (NFData (..)) import Data.Hashable (Hashable (..)) #if !MIN_VERSION_time(1,11,0) data FirstWeekType = FirstWholeWeek -- ^ first week is the first whole week of the year | FirstMostWeek -- ^ first week is the first week with four days in the year deriving (Eq, Typeable) firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day firstDayOfWeekCalendar wt dow year = let jan1st = fromOrdinalDate year 1 in case wt of FirstWholeWeek -> firstDayOfWeekOnAfter dow jan1st FirstMostWeek -> firstDayOfWeekOnAfter dow $ addDays (-3) jan1st -- Note that the year number matches the weeks, and so is not always the same as the Gregorian year number. toWeekCalendar :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Day -> (Year, WeekOfYear, DayOfWeek) toWeekCalendar wt ws d = let dw = dayOfWeek d (y0,_) = toOrdinalDate d j1p = firstDayOfWeekCalendar wt ws $ pred y0 j1 = firstDayOfWeekCalendar wt ws y0 j1s = firstDayOfWeekCalendar wt ws $ succ y0 in if d < j1 then (pred y0,succ $ div (fromInteger $ diffDays d j1p) 7,dw) else if d < j1s then (y0,succ $ div (fromInteger $ diffDays d j1) 7,dw) else (succ y0,succ $ div (fromInteger $ diffDays d j1s) 7,dw) -- | Convert from the given kind of "week calendar". -- Invalid week and day values will be clipped to the correct range. fromWeekCalendar :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Year -> WeekOfYear -> DayOfWeek -> Day fromWeekCalendar wt ws y wy dw = let d1 :: Day d1 = firstDayOfWeekCalendar wt ws y wy' = clip 1 53 wy getday :: WeekOfYear -> Day getday wy'' = addDays (toInteger $ (pred wy'' * 7) + (dayOfWeekDiff dw ws)) d1 d1s = firstDayOfWeekCalendar wt ws $ succ y day = getday wy' in if wy' == 53 then if day >= d1s then getday 52 else day else day -- | Convert from the given kind of "week calendar". -- Invalid week and day values will return Nothing. fromWeekCalendarValid :: FirstWeekType -- ^ how to reckon the first week of the year -> DayOfWeek -- ^ the first day of each week -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day fromWeekCalendarValid wt ws y wy dw = let d = fromWeekCalendar wt ws y wy dw in if toWeekCalendar wt ws d == (y,wy,dw) then Just d else Nothing #if __GLASGOW_HASKELL__ >= 710 -- | Bidirectional abstract constructor for ISO 8601 Week Date format. -- Invalid week values will be clipped to the correct range. pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day pattern YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw) #if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE YearWeekDay #-} #endif #endif #endif #if !MIN_VERSION_time(1,9,0) data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday deriving (Eq, Ord, Show, Read, Typeable, Data) instance NFData DayOfWeek where rnf !_ = () instance Hashable DayOfWeek where hashWithSalt salt = hashWithSalt salt . fromEnum -- | \"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 ------------------------------------------------------------------------------- -- FormatTime DayOfWeek ------------------------------------------------------------------------------- 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 #if !MIN_VERSION_time(1,11,0) -- | @dayOfWeekDiff a b = a - b@ in range 0 to 6. -- The number of days from b to the next a. dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7 -- | The first day-of-week on or after some day firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d #endif time-compat-1.9.6.1/src/Data/Time/Clock/0000755000000000000000000000000007346545000015667 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Clock/Compat.hs0000644000000000000000000000302607346545000017447 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, -- * Type aliases Year, MonthOfYear, DayOfMonth, ) where import Data.Time.Orphans () import Data.Time.Calendar.Types 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 diffTimeToPicoseconds = truncate . (1000000000000 *) #endif time-compat-1.9.6.1/src/Data/Time/Clock/POSIX/0000755000000000000000000000000007346545000016571 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Clock/POSIX/Compat.hs0000644000000000000000000000073307346545000020353 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.6.1/src/Data/Time/Clock/System/0000755000000000000000000000000007346545000017153 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Clock/System/Compat.hs0000644000000000000000000000724107346545000020736 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.Data (Data) 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,Data) 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.6.1/src/Data/Time/Clock/TAI/0000755000000000000000000000000007346545000016304 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Clock/TAI/Compat.hs0000644000000000000000000000424607346545000020071 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.6.1/src/Data/Time/0000755000000000000000000000000007346545000014634 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Compat.hs0000644000000000000000000000053107346545000016412 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.6.1/src/Data/Time/Format/0000755000000000000000000000000007346545000016064 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Format/Compat.hs0000644000000000000000000001103707346545000017645 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, -- parseTimeMultipleM, -- TODO 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 -- TODO: -- -- #if !MIN_VERSION_time(1,11,0) -- -- | Parses a time value given a list of pairs of format and input. -- -- Resulting value is constructed from all provided specifiers. -- parseTimeMultipleM -- :: (Fail.MonadFail m, ParseTime t) -- => Bool -- ^ Accept leading and trailing whitespace? -- -> TimeLocale -- ^ Time locale. -- -> [(String, String)] -- ^ Pairs of (format string, input string). -- -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format. -- parseTimeMultipleM = undefined -- parseTimeMultipleM' Proxy -- #endif time-compat-1.9.6.1/src/Data/Time/Format/ISO8601/0000755000000000000000000000000007346545000017035 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/Format/ISO8601/Compat.hs0000644000000000000000000003566107346545000020627 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.6.1/src/Data/Time/LocalTime/0000755000000000000000000000000007346545000016505 5ustar0000000000000000time-compat-1.9.6.1/src/Data/Time/LocalTime/Compat.hs0000644000000000000000000001062607346545000020271 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 (..)) import Control.DeepSeq (NFData (..)) ------------------------------------------------------------------------------- -- 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_time(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 NFData CalendarDiffTime where rnf (CalendarDiffTime x y) = rnf x `seq` rnf y 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.6.1/src/Data/Time/Orphans.hs0000644000000000000000000001405407346545000016606 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} module Data.Time.Orphans () where import Data.Orphans () import Control.DeepSeq (NFData (..)) import Data.Typeable (Typeable) import Data.Data (Data) import Data.Time import Data.Time.Clock import Data.Time.Clock.TAI import Data.Time.Format import Data.Hashable (Hashable (..)) #if MIN_VERSION_time(1,5,0) import Data.Time.Format (TimeLocale (..)) #else import System.Locale (TimeLocale (..)) #endif #if MIN_VERSION_time(1,8,0) import Data.Time.Clock.System #endif #if !MIN_VERSION_time(1,11,0) import Data.Fixed (Pico) import Text.Read (Read (..)) import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadPrec #endif #if MIN_VERSION_time(1,11,0) import Data.Ix (Ix (..)) import Data.Time.Calendar.Month import Data.Time.Calendar.Quarter #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 #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,11,0) deriving instance Ord DayOfWeek #endif #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,10,0) #if __GLASGOW_HASKELL__ <710 deriving instance Typeable DayOfWeek #endif deriving instance Data DayOfWeek #endif #if MIN_VERSION_time(1,8,0) && !MIN_VERSION_time(1,10,0) #if __GLASGOW_HASKELL__ <710 deriving instance Typeable SystemTime #endif deriving instance Data SystemTime #endif #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,11,1) instance NFData DayOfWeek where rnf !_ = () instance NFData CalendarDiffTime where rnf (CalendarDiffTime x y) = rnf x `seq` rnf y instance NFData CalendarDiffDays where rnf (CalendarDiffDays x y) = rnf x `seq` rnf y #endif #if !MIN_VERSION_time(1,11,0) instance Read DiffTime where readPrec = do t <- readPrec :: ReadPrec Pico _ <- lift $ char 's' return $ realToFrac t instance Read NominalDiffTime where readPrec = do t <- readPrec :: ReadPrec Pico _ <- lift $ char 's' return $ realToFrac t #endif #if MIN_VERSION_time(1,11,0) && !MIN_VERSION_time(1,11,1) instance NFData Month where rnf (MkMonth m) = rnf m instance Enum Month where succ (MkMonth a) = MkMonth (succ a) pred (MkMonth a) = MkMonth (pred a) toEnum = MkMonth . toEnum fromEnum (MkMonth a) = fromEnum a enumFrom (MkMonth a) = fmap MkMonth (enumFrom a) enumFromThen (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromThen a b) enumFromTo (MkMonth a) (MkMonth b) = fmap MkMonth (enumFromTo a b) enumFromThenTo (MkMonth a) (MkMonth b) (MkMonth c) = fmap MkMonth (enumFromThenTo a b c) instance Ix Month where range (MkMonth a, MkMonth b) = fmap MkMonth (range (a, b)) index (MkMonth a, MkMonth b) (MkMonth c) = index (a, b) c inRange (MkMonth a, MkMonth b) (MkMonth c) = inRange (a, b) c rangeSize (MkMonth a, MkMonth b) = rangeSize (a, b) instance NFData QuarterOfYear where rnf Q1 = () rnf Q2 = () rnf Q3 = () rnf Q4 = () instance NFData Quarter where rnf (MkQuarter m) = rnf m instance Enum Quarter where succ (MkQuarter a) = MkQuarter (succ a) pred (MkQuarter a) = MkQuarter (pred a) toEnum = MkQuarter . toEnum fromEnum (MkQuarter a) = fromEnum a enumFrom (MkQuarter a) = fmap MkQuarter (enumFrom a) enumFromThen (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromThen a b) enumFromTo (MkQuarter a) (MkQuarter b) = fmap MkQuarter (enumFromTo a b) enumFromThenTo (MkQuarter a) (MkQuarter b) (MkQuarter c) = fmap MkQuarter (enumFromThenTo a b c) instance Ix Quarter where range (MkQuarter a, MkQuarter b) = fmap MkQuarter (range (a, b)) index (MkQuarter a, MkQuarter b) (MkQuarter c) = index (a, b) c inRange (MkQuarter a, MkQuarter b) (MkQuarter c) = inRange (a, b) c rangeSize (MkQuarter a, MkQuarter b) = rangeSize (a, b) #endif ------------------------------------------------------------------------------- -- Hashable ------------------------------------------------------------------------------- instance Hashable UniversalTime where hashWithSalt salt = hashWithSalt salt . getModJulianDate instance Hashable DiffTime where hashWithSalt salt = hashWithSalt salt . toRational instance Hashable UTCTime where hashWithSalt salt (UTCTime d dt) = salt `hashWithSalt` d `hashWithSalt` dt instance Hashable NominalDiffTime where hashWithSalt salt = hashWithSalt salt . toRational instance Hashable Day where hashWithSalt salt (ModifiedJulianDay d) = hashWithSalt salt d instance Hashable TimeZone where hashWithSalt salt (TimeZone m s n) = salt `hashWithSalt` m `hashWithSalt` s `hashWithSalt` n instance Hashable TimeOfDay where hashWithSalt salt (TimeOfDay h m s) = salt `hashWithSalt` h `hashWithSalt` m `hashWithSalt` s instance Hashable LocalTime where hashWithSalt salt (LocalTime d tod) = salt `hashWithSalt` d `hashWithSalt` tod instance Hashable TimeLocale where hashWithSalt salt (TimeLocale a b c d e f g h) = salt `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d `hashWithSalt` e `hashWithSalt` f `hashWithSalt` g `hashWithSalt` h #if MIN_VERSION_time(1,9,0) instance Hashable DayOfWeek where hashWithSalt salt = hashWithSalt salt . fromEnum #endif #if MIN_VERSION_time(1,11,0) instance Hashable Month where hashWithSalt salt (MkMonth x) = hashWithSalt salt x instance Hashable Quarter where hashWithSalt salt (MkQuarter x) = hashWithSalt salt x instance Hashable QuarterOfYear where hashWithSalt salt = hashWithSalt salt . fromEnum #endif time-compat-1.9.6.1/test-instances/0000755000000000000000000000000007346545000015242 5ustar0000000000000000time-compat-1.9.6.1/test-instances/Test.hs0000644000000000000000000000702707346545000016523 0ustar0000000000000000module Main where import Control.DeepSeq (NFData (rnf), force) import Data.Hashable (Hashable) import Data.Time.Calendar.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.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) , test (undefined :: Month) ] where test :: FormatTime t => t -> () test _ = () _NFDataInstances :: [()] _NFDataInstances = [ test (undefined :: CalendarDiffTime) , test (undefined :: Day) , test (undefined :: DiffTime) , test (undefined :: NominalDiffTime) , test (undefined :: UTCTime) , test (undefined :: UniversalTime) , test (undefined :: CalendarDiffTime) , test (undefined :: CalendarDiffDays) , test (undefined :: TimeZone) , test (undefined :: TimeOfDay) , test (undefined :: LocalTime) , test (undefined :: ZonedTime) , test (undefined :: DayOfWeek) , test (undefined :: Month) , test (undefined :: Quarter) , test (undefined :: QuarterOfYear) ] where test :: NFData t => t -> () test = rnf _EnumInstances :: [()] _EnumInstances = [ test (undefined :: Day) , test (undefined :: Month) , test (undefined :: Quarter) , test (undefined :: QuarterOfYear) ] where test :: Enum t => t -> () test _ = () _HashableInstances :: [()] _HashableInstances = [ test (undefined :: TimeLocale) , test (undefined :: LocalTime) , test (undefined :: TimeOfDay) , test (undefined :: TimeZone) , test (undefined :: UniversalTime) , test (undefined :: UTCTime) , test (undefined :: NominalDiffTime) , test (undefined :: DiffTime) , test (undefined :: DayOfWeek) , test (undefined :: Day) , test (undefined :: QuarterOfYear) , test (undefined :: Quarter) , test (undefined :: Month) ] where test :: Hashable t => t -> () test _ = () time-compat-1.9.6.1/test/main/0000755000000000000000000000000007346545000014201 5ustar0000000000000000time-compat-1.9.6.1/test/main/Main.hs0000644000000000000000000000256107346545000015425 0ustar0000000000000000module Main where import Test.Types() import Test.Calendar.AddDays import Test.Calendar.CalendarProps 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.Compile () import Test.Format.Format import Test.Format.ISO8601 import Test.Format.ParseTime import Test.LocalTime.CalendarDiffTime import Test.LocalTime.Time import Test.LocalTime.TimeOfDay import Test.Tasty tests :: TestTree tests = testGroup "Time" [ testGroup "Calendar" [ addDaysTest , testCalendarProps , 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 = defaultMain tests time-compat-1.9.6.1/test/main/Test/0000755000000000000000000000000007346545000015120 5ustar0000000000000000time-compat-1.9.6.1/test/main/Test/Arbitrary.hs0000644000000000000000000001253607346545000017422 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Arbitrary where import Control.Monad import Data.Fixed import Data.Ratio import Data.Time.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Data.Time.Clock.POSIX.Compat import Test.Tasty.QuickCheck hiding (reason) instance Arbitrary DayOfWeek where arbitrary = fmap toEnum $ choose (1, 7) instance Arbitrary FirstWeekType where arbitrary = do b <- arbitrary return $ if b then FirstWholeWeek else FirstMostWeek deriving instance Show FirstWeekType instance Arbitrary Month where arbitrary = liftM MkMonth $ choose (-30000, 200000) instance Arbitrary Quarter where arbitrary = liftM MkQuarter $ choose (-30000, 200000) instance Arbitrary QuarterOfYear where arbitrary = liftM toEnum $ choose (1, 4) 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 reduceDigits :: Int -> Pico -> Maybe Pico reduceDigits (-1) _ = Nothing reduceDigits n x = let d :: Pico d = 10 ^^ (negate n) r = mod' x d in case r of 0 -> reduceDigits (n - 1) x _ -> Just $ x - r instance Arbitrary TimeOfDay where arbitrary = liftM timeToTimeOfDay arbitrary shrink (TimeOfDay h m s) = let shrinkInt 0 = [] shrinkInt 1 = [0] shrinkInt _ = [0, 1] shrinkPico 0 = [] shrinkPico 1 = [0] shrinkPico p = case reduceDigits 12 p of Just p' -> [0, 1, p'] Nothing -> [0, 1] in [TimeOfDay h' m s | h' <- shrinkInt h] ++ [TimeOfDay h m' s | m' <- shrinkInt m] ++ [TimeOfDay h m s' | s' <- shrinkPico s] instance CoArbitrary TimeOfDay where coarbitrary t = coarbitrary (timeOfDayToTime t) instance Arbitrary LocalTime where arbitrary = liftM2 LocalTime arbitrary arbitrary shrink (LocalTime d tod) = [LocalTime d' tod | d' <- shrink d] ++ [LocalTime d tod' | tod' <- shrink tod] instance CoArbitrary LocalTime where coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer) instance Arbitrary TimeZone where arbitrary = liftM minutesToTimeZone $ choose (-720, 720) shrink (TimeZone 0 _ _) = [] shrink (TimeZone _ s n) = [TimeZone 0 s n] instance CoArbitrary TimeZone where coarbitrary tz = coarbitrary (timeZoneMinutes tz) instance Arbitrary ZonedTime where arbitrary = liftM2 ZonedTime arbitrary arbitrary shrink (ZonedTime d tz) = [ZonedTime d' tz | d' <- shrink d] ++ [ZonedTime d tz' | tz' <- shrink tz] instance CoArbitrary ZonedTime where coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) instance Arbitrary UTCTime where arbitrary = liftM2 UTCTime arbitrary arbitrary shrink t = fmap (localTimeToUTC utc) $ shrink $ utcToLocalTime utc t 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 shrink t = fmap (localTimeToUT1 0) $ shrink $ ut1ToLocalTime 0 t instance CoArbitrary UniversalTime where coarbitrary (ModJulianDate d) = coarbitrary d time-compat-1.9.6.1/test/main/Test/Calendar/0000755000000000000000000000000007346545000016631 5ustar0000000000000000time-compat-1.9.6.1/test/main/Test/Calendar/AddDays.hs0000644000000000000000000000213107346545000020473 0ustar0000000000000000module Test.Calendar.AddDays ( addDaysTest ) where import Data.Time.Calendar import Test.Calendar.AddDaysRef import Test.Tasty import Test.Tasty.HUnit 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.6.1/test/main/Test/Calendar/AddDaysRef.hs0000644000000000000000000003260007346545000021134 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.6.1/test/main/Test/Calendar/CalendarProps.hs0000644000000000000000000000156107346545000021725 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Calendar.CalendarProps ( testCalendarProps ) where #if __GLASGOW_HASKELL__ >= 710 import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Test.TestUtil import Test.Tasty import Test.Arbitrary () testYearMonth :: TestTree testYearMonth = nameTest "YearMonth" $ \m -> case m of YearMonth y my -> m == YearMonth y my testMonthDay :: TestTree testMonthDay = nameTest "MonthDay" $ \d -> case d of MonthDay m dm -> d == MonthDay m dm testYearQuarter :: TestTree testYearQuarter = nameTest "YearQuarter" $ \q -> case q of YearQuarter y qy -> q == YearQuarter y qy testCalendarProps :: TestTree testCalendarProps = nameTest "calender-props" [testYearMonth,testMonthDay,testYearQuarter] #else import Test.Tasty testCalendarProps :: TestTree testCalendarProps = testGroup "calendar-props" [] #endif time-compat-1.9.6.1/test/main/Test/Calendar/Calendars.hs0000644000000000000000000000142407346545000021062 0ustar0000000000000000module Test.Calendar.Calendars ( testCalendars ) where import Data.Time.Calendar import Data.Time.Calendar.Julian import Data.Time.Calendar.WeekDate import Test.Calendar.CalendarsRef import Test.Tasty import Test.Tasty.HUnit 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.6.1/test/main/Test/Calendar/CalendarsRef.hs0000644000000000000000000000075107346545000021521 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.6.1/test/main/Test/Calendar/ClipDates.hs0000644000000000000000000000331107346545000021033 0ustar0000000000000000module Test.Calendar.ClipDates ( clipDates ) where import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Test.Calendar.ClipDatesRef import Test.Tasty import Test.Tasty.HUnit 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 testPairs :: String -> [String] -> [String] -> TestTree testPairs name expected found = testGroup name $ fmap (\(e,f) -> testCase e $ assertEqual "" e f) $ zip expected found -- clipDates :: TestTree clipDates = testGroup "clipDates" [ testPairs "YearAndDay" clipDatesYearAndDayRef $ map yearAndDay $ tupleUp2 [1968, 1969, 1971] [-4, 0, 1, 200, 364, 365, 366, 367, 700], testPairs "Gregorian" clipDatesGregorianDayRef $ 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], testPairs "ISOWeekDay" clipDatesISOWeekDayRef $ map iSOWeekDay $ tupleUp3 [1968, 1969, 2004] [-20, -1, 0, 1, 20, 51, 52, 53, 54] [-2, -1, 0, 1, 4, 6, 7, 8, 9] ] time-compat-1.9.6.1/test/main/Test/Calendar/ClipDatesRef.hs0000644000000000000000000004721107346545000021477 0ustar0000000000000000module Test.Calendar.ClipDatesRef where clipDatesYearAndDayRef :: [String] clipDatesYearAndDayRef = [ "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" ] clipDatesGregorianDayRef :: [String] clipDatesGregorianDayRef = [ "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" ] clipDatesISOWeekDayRef :: [String] clipDatesISOWeekDayRef = [ "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.6.1/test/main/Test/Calendar/ConvertBack.hs0000644000000000000000000000267707346545000021402 0ustar0000000000000000module Test.Calendar.ConvertBack ( convertBack ) where import Data.Time.Calendar import Data.Time.Calendar.Julian import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate 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.6.1/test/main/Test/Calendar/Duration.hs0000644000000000000000000000342407346545000020755 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.6.1/test/main/Test/Calendar/Easter.hs0000644000000000000000000000215507346545000020413 0ustar0000000000000000module Test.Calendar.Easter ( testEaster ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Easter.Compat import Data.Time.Format.Compat import Test.Calendar.EasterRef import Test.Tasty import Test.Tasty.HUnit -- 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.6.1/test/main/Test/Calendar/EasterRef.hs0000644000000000000000000000755507346545000021061 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.6.1/test/main/Test/Calendar/LongWeekYears.hs0000644000000000000000000000136707346545000021713 0ustar0000000000000000module Test.Calendar.LongWeekYears ( longWeekYears ) where import Data.Time.Calendar import Data.Time.Calendar.WeekDate import Test.Calendar.LongWeekYearsRef import Test.Tasty import Test.Tasty.HUnit 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.6.1/test/main/Test/Calendar/LongWeekYearsRef.hs0000644000000000000000000000627707346545000022355 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.6.1/test/main/Test/Calendar/MonthDay.hs0000644000000000000000000000166407346545000020717 0ustar0000000000000000module Test.Calendar.MonthDay ( testMonthDay ) where import Data.Time.Calendar.MonthDay import Test.Calendar.MonthDayRef import Test.Tasty import Test.Tasty.HUnit 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.6.1/test/main/Test/Calendar/MonthDayRef.hs0000644000000000000000000004275707346545000021364 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.6.1/test/main/Test/Calendar/Valid.hs0000644000000000000000000001160007346545000020222 0ustar0000000000000000module Test.Calendar.Valid ( testValid ) where import Data.Time.Compat import Data.Time.Calendar.Julian.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.QuickCheck hiding (reason) 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 WYear = MkWYear Year deriving (Eq, Show) instance Arbitrary WYear where arbitrary = fmap MkWYear $ choose (-1000, 3000) newtype WMonthOfYear = MkWMonthOfYear MonthOfYear deriving (Eq, Show) instance Arbitrary WMonthOfYear where arbitrary = fmap MkWMonthOfYear $ choose (-5, 17) newtype WDayOfMonth = MkWDayOfMonth DayOfMonth deriving (Eq, Show) instance Arbitrary WDayOfMonth where arbitrary = fmap MkWDayOfMonth $ choose (-5, 35) newtype WDayOfYear = MkWDayOfYear DayOfYear deriving (Eq, Show) instance Arbitrary WDayOfYear where arbitrary = fmap MkWDayOfYear $ choose (-20, 400) newtype WWeekOfYear = MkWWeekOfYear WeekOfYear deriving (Eq, Show) instance Arbitrary WWeekOfYear where arbitrary = fmap MkWWeekOfYear $ choose (-5, 60) newtype WDayOfWeek = MkWDayOfWeek Int deriving (Eq, Show) instance Arbitrary WDayOfWeek where arbitrary = fmap MkWDayOfWeek $ choose (-5, 15) fromYMD :: (WYear, WMonthOfYear, WDayOfMonth) -> (Year, MonthOfYear, DayOfMonth) fromYMD (MkWYear y, MkWMonthOfYear ym, MkWDayOfMonth md) = (y, ym, md) fromYD :: (WYear, WDayOfYear) -> (Year, DayOfYear) fromYD (MkWYear y, MkWDayOfYear yd) = (y, yd) fromYWD :: (WYear, WWeekOfYear, WDayOfWeek) -> (Year, WeekOfYear, Int) fromYWD (MkWYear y, MkWWeekOfYear yw, MkWDayOfWeek 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.6.1/test/main/Test/Calendar/Week.hs0000644000000000000000000001173307346545000020065 0ustar0000000000000000module Test.Calendar.Week ( testWeek ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Test.TestUtil import Test.Tasty import Test.Tasty.HUnit import Test.Arbitrary () testDay :: TestTree testDay = nameTest "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 = nameTest name $ fmap (\wd -> nameTest (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 = nameTest "sequence" [ nameTest "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday] , nameTest "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday] , nameTest "[Sunday .. Saturday]" $ assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday] , nameTest "[Thursday .. Wednesday]" $ assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday] , nameTest "[Tuesday ..]" $ assertEqual "" [ Tuesday , Wednesday , Thursday , Friday , Saturday , Sunday , Monday , Tuesday , Wednesday , Thursday , Friday , Saturday , Sunday , Monday , Tuesday ] $ take 15 [Tuesday ..] , nameTest "[Wednesday, Tuesday ..]" $ assertEqual "" [ Wednesday , Tuesday , Monday , Sunday , Saturday , Friday , Thursday , Wednesday , Tuesday , Monday , Sunday , Saturday , Friday , Thursday , Wednesday ] $ take 15 [Wednesday,Tuesday ..] , nameTest "[Sunday, Friday ..]" $ assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $ take 8 [Sunday,Friday ..] , nameTest "[Monday,Sunday .. Tuesday]" $ assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday,Sunday .. Tuesday] , nameTest "[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 prop_firstDayOfWeekOnAfter_onAfter :: DayOfWeek -> Day -> Bool prop_firstDayOfWeekOnAfter_onAfter dw d = firstDayOfWeekOnAfter dw d >= d prop_firstDayOfWeekOnAfter_Day :: DayOfWeek -> Day -> Bool prop_firstDayOfWeekOnAfter_Day dw d = dayOfWeek (firstDayOfWeekOnAfter dw d) == dw prop_toFromWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> Bool prop_toFromWeekCalendar wt ws d = let (y,wy,dw) = toWeekCalendar wt ws d in fromWeekCalendar wt ws y wy dw == d prop_weekChanges :: FirstWeekType -> DayOfWeek -> Day -> Bool prop_weekChanges wt ws d = let (_,wy0,_) = toWeekCalendar wt ws d (_,wy1,dw) = toWeekCalendar wt ws $ succ d in if dw == ws then wy0 /= wy1 else wy0 == wy1 prop_weekYearWholeStart :: DayOfWeek -> Year -> Bool prop_weekYearWholeStart ws y = let d = fromWeekCalendar FirstWholeWeek ws y 1 ws (y',dy) = toOrdinalDate d in y == y' && dy >= 1 && dy <= 7 prop_weekYearMostStart :: DayOfWeek -> Year -> Bool prop_weekYearMostStart ws y = let d = fromWeekCalendar FirstMostWeek ws y 2 ws (y',dy) = toOrdinalDate d in y == y' && dy >= 5 && dy <= 11 testDiff :: TestTree testDiff = nameTest "diff" [ nameTest "Friday - Tuesday" $ assertEqual "" 3 $ dayOfWeekDiff Friday Tuesday, nameTest "Tuesday - Friday" $ assertEqual "" 4 $ dayOfWeekDiff Tuesday Friday, nameTest "firstDayOfWeekOnAfter_onAfter" prop_firstDayOfWeekOnAfter_onAfter, nameTest "firstDayOfWeekOnAfter_Day" prop_firstDayOfWeekOnAfter_Day, nameTest "toFromWeekCalendar" prop_toFromWeekCalendar, nameTest "weekChanges" prop_weekChanges, nameTest "weekYearWholeStart" prop_weekYearWholeStart, nameTest "weekYearMostStart" prop_weekYearMostStart ] testWeek :: TestTree testWeek = nameTest "Week" [testDay, testSucc, testPred, testSequences, testReadShow, testDiff] time-compat-1.9.6.1/test/main/Test/Clock/0000755000000000000000000000000007346545000016153 5ustar0000000000000000time-compat-1.9.6.1/test/main/Test/Clock/Conversion.hs0000644000000000000000000000207307346545000020636 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.6.1/test/main/Test/Clock/Resolution.hs0000644000000000000000000000353607346545000020661 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Clock.Resolution ( testResolutions ) where import Control.Concurrent import Data.Fixed import Data.Time.Clock.Compat import Data.Time.Clock.TAI.Compat 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 $ -- 100us do threadDelay 1 -- 1us getTime times2 <- repeatN 100 $ -- 1ms do threadDelay 10 -- 10us getTime times3 <- repeatN 100 $ -- 10ms do threadDelay 100 -- 100us getTime times4 <- repeatN 100 $ -- 100ms do threadDelay 1000 -- 1ms getTime let times = fmap (\t -> timeDiff t t0) $ times0 ++ times1 ++ times2 ++ times3 ++ times4 #if MIN_VERSION_time(1,8,0) assertEqual "resolution" res $ gcdAll times #else assertBool ("resolution " ++ show (res, gcdAll times)) (res >= gcdAll times) #endif 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.6.1/test/main/Test/Clock/TAI.hs0000644000000000000000000000465407346545000017135 0ustar0000000000000000module 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.6.1/test/main/Test/Format/0000755000000000000000000000000007346545000016350 5ustar0000000000000000time-compat-1.9.6.1/test/main/Test/Format/Compile.hs0000644000000000000000000000057207346545000020300 0ustar0000000000000000-- Tests succeed if module compiles {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Format.Compile ( ) where -- Doesn't work with old time -- -- import Data.Time.Compat -- -- newtype WrappedUTCTime = -- MkWrappedUTCTime UTCTime -- deriving (FormatTime, ParseTime) -- -- newtype Wrapped t = -- MkWrapped t -- deriving (FormatTime, ParseTime) time-compat-1.9.6.1/test/main/Test/Format/Format.hs0000644000000000000000000002116707346545000020143 0ustar0000000000000000module Test.Format.Format ( testFormat ) where import Data.Proxy import Data.Time.Compat 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"] compareExpected :: (Eq t, Show t, ParseTime t) => String -> String -> String -> Proxy t -> TestTree compareExpected testname fmt str proxy = testCase testname $ 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) , testAFormat "%3Es" "1.200" (1.2 :: NominalDiffTime) , testAFormat "%3ES" "01.200" (1.2 :: NominalDiffTime) , testAFormat "%3ES" "01.200" (61.2 :: NominalDiffTime) , testAFormat "%3Es" "1.245" (1.24582 :: NominalDiffTime) , testAFormat "%3ES" "01.245" (1.24582 :: NominalDiffTime) , testAFormat "%3ES" "01.245" (61.24582 :: 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) , testAFormat "%3Es" "1.200" (1.2 :: DiffTime) , testAFormat "%3ES" "01.200" (1.2 :: DiffTime) , testAFormat "%3ES" "01.200" (61.2 :: DiffTime) , testAFormat "%3Es" "1.245" (1.24582 :: DiffTime) , testAFormat "%3ES" "01.245" (1.24582 :: DiffTime) , testAFormat "%3ES" "01.245" (61.24582 :: 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.6.1/test/main/Test/Format/ISO8601.hs0000644000000000000000000003445507346545000017670 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ISO8601 ( testISO8601 ) where import Data.Ratio import Data.Time.Compat import Data.Time.Format.ISO8601.Compat import Test.Arbitrary () import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) import Test.TestUtil 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 -- https://github.com/haskellari/time-compat/issues/23 -- , 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.6.1/test/main/Test/Format/ParseTime.hs0000644000000000000000000007020507346545000020601 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ParseTime ( testParseTime , test_parse_format ) where #if MIN_VERSION_base(4,11,0) #else import Data.Semigroup hiding (option) #endif import Control.Monad import Data.Char import Data.Maybe import Data.Proxy import Data.Time.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Test.Arbitrary () import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) import Test.TestUtil import Text.Read.Compat format :: FormatTime t => String -> t -> String format f t = formatTime defaultTimeLocale f t parse :: ParseTime t => Bool -> String -> String -> Maybe t parse sp f t = parseTimeM sp defaultTimeLocale f t data FormatOnly data ParseAndFormat data FormatCode pf t = MkFormatCode { fcModifier :: String , fcWidth :: Maybe Int , fcAlt :: Bool , fcSpecifier :: Char } instance Show (FormatCode pf t) where show (MkFormatCode m w a s) = let ms = m ws = fromMaybe "" $ fmap show w as = if a then "E" else "" ss = [s] in '%' : (ms <> ws <> as <> ss) formatCode :: FormatTime t => FormatCode pf t -> t -> String formatCode fc = format $ show fc parseCode :: ParseTime t => FormatCode ParseAndFormat t -> String -> Maybe t parseCode fc = parse False $ show fc class HasFormatCodes t where allFormatCodes :: Proxy t -> [(Bool, Char)] incompleteS :: Maybe t incompleteS = Nothing minCodeWidth :: Char -> Int minCodeWidth _ = 0 fcShrink :: FormatCode pf t -> [FormatCode pf t] fcShrink fc = let fc1 = case fcWidth fc of Nothing -> [] Just w | w > (minCodeWidth $ fcSpecifier fc) -> [fc {fcWidth = Nothing}, fc {fcWidth = Just $ w - 1}] Just _ -> [fc {fcWidth = Nothing}] fc2 = case fcAlt fc of False -> [] True -> [fc {fcAlt = False}] fc3 = case fcModifier fc of "" -> [] _ -> [fc {fcModifier = ""}] in fc1 ++ fc2 ++ fc3 instance HasFormatCodes t => Arbitrary (FormatCode FormatOnly t) where arbitrary = do m <- oneof [return "", oneof $ fmap return ["", "-", "_", "0", "^", "#"]] (a, s) <- oneof $ fmap return $ allFormatCodes (Proxy :: Proxy t) w <- case minCodeWidth s of 0 -> return Nothing mw -> oneof [return Nothing, fmap Just $ choose (mw, 15)] return $ MkFormatCode m w a s shrink = fcShrink instance HasFormatCodes t => Arbitrary (FormatCode ParseAndFormat t) where arbitrary = do (a, s) <- oneof $ fmap return $ allFormatCodes (Proxy :: Proxy t) m <- case s of 'Z' -> return "" 'z' -> return "" _ -> oneof [return "", oneof $ fmap return ["", "-", "_", "0"]] return $ MkFormatCode m Nothing a s shrink = fcShrink 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 -700s" [0, 1, 50, 99] (parseCYY (-7)) , makeExhaustiveTest "parse %-C %y -70000s" [0, 1, 50, 99] (parseCYY (-70000)) , 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 ])) -- , (-1166)])) 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) defaultTimeZoneTests :: TestTree defaultTimeZoneTests = testGroup "default time zones" [] -- (fmap testParseTimeZone (knownTimeZones defaultTimeLocale)) militaryTimeZoneTests :: TestTree militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12]) -- 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)) prop_read_show_ZonedUTC :: ZonedTime -> Result prop_read_show_ZonedUTC t = compareResult (Just $ zonedTimeToUTC t) (readMaybe (show t)) prop_read_show_LocalUTC :: LocalTime -> Result prop_read_show_LocalUTC t = compareResult (Just $ localTimeToUTC utc 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) -- t == parse (format t) 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) -- t == parse (upper (format t)) 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) -- t == parse (lower (format t)) 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) -- Default time is 1970-01-01 00:00:00 +0000 (which was a Thursday) in1970 :: Maybe String -> Char -> String -> Maybe String in1970 _ 'j' "366" = Nothing -- 1970 was not a leap year in1970 _ 'U' "53" = Nothing -- last day of 1970 was Sunday-start-week 52 in1970 _ 'W' "53" = Nothing -- last day of 1970 was Monday-start-week 52 in1970 (Just s) 'S' "60" = Just s -- no leap second without other data in1970 _ _ s = Just s -- format t == format (parse (format t)) prop_format_parse_format :: forall t. (HasFormatCodes t, FormatTime t, ParseTime t) => Proxy t -> FormatCode ParseAndFormat t -> t -> Result prop_format_parse_format _ fc v = let s1 = formatCode fc v ms1 = in1970 (fmap (formatCode fc) (incompleteS :: Maybe t)) (fcSpecifier fc) s1 mv2 :: Maybe t mv2 = parseCode fc s1 ms2 = fmap (formatCode fc) mv2 in compareResult ms1 ms2 instance HasFormatCodes Day where allFormatCodes _ = [(False, s) | s <- "DFxYyCBbhmdejfVUW"] instance HasFormatCodes TimeOfDay where allFormatCodes _ = [(False, s) | s <- "RTXrPpHkIlMSqQ"] instance HasFormatCodes LocalTime where allFormatCodes _ = allFormatCodes (Proxy :: Proxy Day) ++ allFormatCodes (Proxy :: Proxy TimeOfDay) instance HasFormatCodes TimeZone where allFormatCodes _ = [(a, s) | a <- [False, True], s <- "zZ"] instance HasFormatCodes ZonedTime where allFormatCodes _ = [(False, s) | s <- "cs"] ++ allFormatCodes (Proxy :: Proxy LocalTime) ++ allFormatCodes (Proxy :: Proxy TimeZone) instance HasFormatCodes UTCTime where allFormatCodes _ = [(False, s) | s <- "cs"] ++ allFormatCodes (Proxy :: Proxy LocalTime) incompleteS = Just $ UTCTime (fromGregorian 2000 1 1) 0 instance HasFormatCodes UniversalTime where allFormatCodes _ = allFormatCodes (Proxy :: Proxy LocalTime) -- -- * 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 "Month" $ tgroup monthFormats 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 -- time-compat doesn't have instances -- , nameTest "CalendarDiffDays" $ tgroup calendarDiffDaysFormats prop -- , nameTest "CalenderDiffTime" $ tgroup calendarDiffTimeFormats prop -- , nameTest "DiffTime" $ tgroup diffTimeFormats prop -- , nameTest "NominalDiffTime" $ tgroup nominalDiffTimeFormats prop ] allTypes :: (forall t. (Eq t, Show t, Arbitrary t, FormatTime t, ParseTime t, HasFormatCodes t) => String -> Proxy t -> r) -> [r] allTypes f = [ f "Day" (Proxy :: Proxy Day) , f "TimeOfDay" (Proxy :: Proxy TimeOfDay) , f "LocalTime" (Proxy :: Proxy LocalTime) , f "TimeZone" (Proxy :: Proxy TimeZone) , f "ZonedTime" (Proxy :: Proxy ZonedTime) , f "UTCTime" (Proxy :: Proxy UTCTime) , f "UniversalTime" (Proxy :: Proxy UniversalTime) ] allLeapSecondTypes :: (forall t. (Eq t, Show t, Arbitrary t, FormatTime t, ParseTime t, HasFormatCodes t) => String -> t -> r) -> [r] allLeapSecondTypes f = let day :: Day day = fromGregorian 2000 01 01 lsTimeOfDay :: TimeOfDay lsTimeOfDay = TimeOfDay 23 59 60.5 lsLocalTime :: LocalTime lsLocalTime = LocalTime day lsTimeOfDay lsZonedTime :: ZonedTime lsZonedTime = ZonedTime lsLocalTime utc lsUTCTime :: UTCTime lsUTCTime = UTCTime day 86400.5 in [ f "TimeOfDay" lsTimeOfDay , f "LocalTime" lsLocalTime , f "ZonedTime" lsZonedTime , f "UTCTime" lsUTCTime ] parseEmptyTest :: forall t. ParseTime t => Proxy t -> Assertion parseEmptyTest _ = case parse False "" "" :: Maybe t of Just _ -> return () Nothing -> assertFailure "failed" parseEmptyTests :: TestTree parseEmptyTests = nameTest "parse empty" $ allTypes $ \name p -> nameTest name $ parseEmptyTest p formatParseFormatTests :: TestTree formatParseFormatTests = nameTest "format_parse_format" [ localOption (QuickCheckTests 50000) $ nameTest "general" $ allTypes $ \name p -> nameTest name $ prop_format_parse_format p, nameTest "leapsecond" $ allLeapSecondTypes $ \name t -> nameTest name $ \fc -> prop_format_parse_format Proxy fc t ] 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 "Month" (prop_read_show :: Month -> Result) , nameTest "QuarterOfYear" (prop_read_show :: QuarterOfYear -> Result) , nameTest "Quarter" (prop_read_show :: Quarter -> 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 "UTCTime (zoned)" prop_read_show_ZonedUTC , nameTest "UTCTime (local)" prop_read_show_LocalUTC , nameTest "UniversalTime" (prop_read_show :: UniversalTime -> Result) , nameTest "NominalDiffTime" (prop_read_show :: NominalDiffTime -> Result) , nameTest "DiffTime" (prop_read_show :: DiffTime -> 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 = localOption (QuickCheckTests 2000) $ 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 , parseEmptyTests , 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" , "%C-%y-%B-%d" , "%C-%y-%b-%d" , "%C-%y-%h-%d" -- ordinal dates , "%Y-%j" , "%C-%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" ] monthFormats :: [FormatString Month] monthFormats = map FormatString -- numeric year, month [ "%Y-%m" , "%Y%m" , "%C%y%m" , "%Y %m" , "%m/%Y" , "%m/%Y" , "%Y/%m" , "%C %y %m" -- month names , "%Y-%B" , "%Y-%b" , "%Y-%h" , "%C-%y-%B" , "%C-%y-%b" , "%C-%y-%h" ] 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", "%Ez", "%EZ"] 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 ["%H", "%M", "%S", "%H:%M"] 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.6.1/test/main/Test/LocalTime/0000755000000000000000000000000007346545000016771 5ustar0000000000000000time-compat-1.9.6.1/test/main/Test/LocalTime/CalendarDiffTime.hs0000644000000000000000000000070407346545000022447 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.6.1/test/main/Test/LocalTime/Time.hs0000644000000000000000000000577407346545000020240 0ustar0000000000000000module Test.LocalTime.Time ( testTime ) where import Data.Time import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate import Test.LocalTime.TimeRef import Test.Tasty import Test.Tasty.HUnit 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.6.1/test/main/Test/LocalTime/TimeOfDay.hs0000644000000000000000000000123607346545000021150 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.6.1/test/main/Test/LocalTime/TimeRef.hs0000644000000000000000000012366207346545000020672 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.6.1/test/main/Test/TestUtil.hs0000644000000000000000000000166307346545000017237 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.6.1/test/main/Test/Types.hs0000644000000000000000000000132707346545000016563 0ustar0000000000000000module Test.Types(CheckInstances) where import Data.Data import Data.Time.Compat import Data.Time.Clock.System.Compat import Data.Time.Clock.TAI.Compat class (Typeable t, Data t) => CheckDataInstances t class (Typeable t, Data t, Eq t) => CheckInstances t instance CheckInstances UTCTime instance CheckInstances NominalDiffTime instance CheckInstances Day instance CheckInstances DayOfWeek instance CheckInstances TimeOfDay instance CheckInstances LocalTime instance CheckInstances TimeZone instance CheckDataInstances ZonedTime instance CheckInstances CalendarDiffDays instance CheckInstances CalendarDiffTime instance CheckInstances SystemTime instance CheckInstances AbsoluteTime instance CheckInstances UniversalTime time-compat-1.9.6.1/time-compat.cabal0000644000000000000000000001160507346545000015504 0ustar0000000000000000cabal-version: 1.12 name: time-compat version: 1.9.6.1 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/haskellari/time-compat bug-reports: https://github.com/haskellari/time-compat/issues build-type: Simple extra-source-files: CHANGELOG.md tested-with: GHC ==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.4 || ==8.10.4 || ==9.0.1 source-repository head type: git location: https://github.com/haskellari/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.5 && <4.16 , base-orphans >=0.8.4 && <0.9 , deepseq >=1.3.0.0 && <1.4 || >=1.4.1.1 && <1.5 , time >=1.4 && <1.7 || >=1.8 && <1.9 || >=1.9.2 && <1.9.4 || >=1.10 && <1.10.1 || >=1.11 && <1.11.2 || >=1.12 && <1.13 , hashable >=1.3.2.0 && <1.4 if flag(old-locale) build-depends: old-locale >=1.0.0.2 && <1.1 , time >=1.4 && <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.Month.Compat Data.Time.Calendar.MonthDay.Compat Data.Time.Calendar.OrdinalDate.Compat Data.Time.Calendar.Quarter.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.Calendar.Types Data.Time.Orphans test-suite instances default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test-instances main-is: Test.hs build-depends: base , deepseq , HUnit >=1.3.1 && <1.3.2 || >=1.6.0.0 && <1.7 , hashable >=1.3.1.0 && <1.4 , time-compat -- This test-suite is from time library -- Changes: -- * imports: Data.Time -> Data.Time.Compat etc -- * disabled Test.Format.ParseTime -- * Test.Format.Format has also trees disabled -- * Test.Format.Compile doesn't work -- * disabled 'TimeOfDay minBound 0 0' (Test.LocalTime.Time) -- 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.15 , tagged >=0.8.6 && <0.9 , tasty >=1.2.1 && <1.5 , tasty-hunit >=0.10 && <0.11 , tasty-quickcheck >=0.10 && <0.11 , time-compat if !impl(ghc >=8.0) build-depends: fail >=4.9.0.0 && <4.10 , semigroups >=0.18.5 && <0.20 build-depends: time main-is: Main.hs other-modules: Test.Arbitrary Test.Calendar.AddDays Test.Calendar.AddDaysRef Test.Calendar.CalendarProps 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.Compile Test.Format.Format Test.Format.ISO8601 Test.Format.ParseTime Test.LocalTime.CalendarDiffTime Test.LocalTime.Time Test.LocalTime.TimeOfDay Test.LocalTime.TimeRef Test.TestUtil Test.Types