time-compat-1.9.8/0000755000000000000000000000000007346545000012141 5ustar0000000000000000time-compat-1.9.8/CHANGELOG.md0000644000000000000000000000145607346545000013760 0ustar0000000000000000# 1.9.7 - Drop support for GHCs prior 8.6.5 # 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.8/LICENSE0000644000000000000000000000300307346545000013142 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.8/src/Data/0000755000000000000000000000000007346545000013601 5ustar0000000000000000time-compat-1.9.8/src/Data/Format.hs0000644000000000000000000001553007346545000015371 0ustar0000000000000000module Data.Format ( Productish(..) , Summish(..) , parseReader , Format(..) , formatShow , formatParseM , isoMap , mapMFormat , filterFormat , clipFormat , enumMap , literalFormat , specialCaseShowFormat , specialCaseFormat , optionalFormat , casesFormat , optionalSignFormat , mandatorySignFormat , SignOption(..) , integerFormat , decimalFormat ) where import Control.Monad.Fail import Prelude hiding (fail) import Data.Void import Data.Char import Text.ParserCombinators.ReadP 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 :: ( MonadFail m ) => 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 :: ( MonadFail m ) => 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.8/src/Data/Time/Calendar/0000755000000000000000000000000007346545000016210 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/Compat.hs0000644000000000000000000002651007346545000017773 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.Time.Calendar.Compat ( -- * Days Day(..),addDays,diffDays, -- * DayPeriod DayPeriod (..), periodAllDays, periodLength, periodFromDay, periodToDay, periodToDayValid, -- * CalendarDiffTime CalendarDiffDays (..), calendarDay,calendarWeek,calendarMonth,calendarYear,scaleCalendarDiffDays, -- * Year, month and day Year, pattern CommonEra, pattern BeforeCommonEra, MonthOfYear, pattern January, pattern February, pattern March, pattern April, pattern May, pattern June, pattern July, pattern August, pattern September, pattern October, pattern November, pattern December, DayOfMonth, -- * 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, weekAllDays, weekFirstDay, weekLastDay, -- * Type aliases pattern YearMonthDay, ) where #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,14,0) import Data.Time.Calendar hiding (diffGregorianDurationRollOver) #else import Data.Time.Calendar #endif import Data.Time.Format import Data.Time.Orphans () #if !MIN_VERSION_time(1,12,1) 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,12,0) import Data.Time.Calendar.MonthDay.Compat #endif #if !MIN_VERSION_time(1,12,0) import Data.Time.Calendar.Types #endif #if !MIN_VERSION_time(1,12,1) import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat #endif import Control.DeepSeq (NFData (..)) import Data.Data (Data, Typeable) import GHC.Generics (Generic) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import qualified Language.Haskell.TH.Syntax as TH ------------------------------------------------------------------------------- -- 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, Typeable, Generic, TH.Lift) -- | 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 -- TODO: -- instance Read CalendarDiffDays where -- readsPrec = error "TODO" ------------------------------------------------------------------------------- -- 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 #endif #if !MIN_VERSION_time(1,14,0) -- | Calendrical difference, with as many whole months as possible. diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays diffGregorianDurationRollOver day2 day1 = let (y1, m1, _) = toGregorian day1 (y2, m2, _) = toGregorian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 findpos mdiff = let dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1 dd = diffDays day2 dayAllowed in if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff) findneg mdiff = let dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1 dd = diffDays day2 dayAllowed in if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff) in if day2 >= day1 then findpos ymdiff else findneg ymdiff #endif #if !MIN_VERSION_time(1,11,0) -- | 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 {-# COMPLETE YearMonthDay #-} #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 #if !MIN_VERSION_time(1,12,2) -- | Returns a week containing the given 'Day' where the first day is the -- 'DayOfWeek' specified. -- -- Examples: -- -- >>> weekAllDays Sunday (YearMonthDay 2022 02 21) -- [YearMonthDay 2022 2 20 .. YearMonthDay 2022 2 26] -- -- >>> weekAllDays Monday (YearMonthDay 2022 02 21) -- [YearMonthDay 2022 2 21 .. YearMonthDay 2022 2 27] -- -- >>> weekAllDays Tuesday (YearMonthDay 2022 02 21) -- [YearMonthDay 2022 2 15 .. YearMonthDay 2022 2 21] -- -- @since 1.12.2 weekAllDays :: DayOfWeek -> Day -> [Day] weekAllDays firstDay day = [weekFirstDay firstDay day .. weekLastDay firstDay day] -- | Returns the first day of a week containing the given 'Day'. -- -- Examples: -- -- >>> weekFirstDay Sunday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 20 -- -- >>> weekFirstDay Monday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 21 -- -- >>> weekFirstDay Tuesday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 15 -- -- @since 1.12.2 weekFirstDay :: DayOfWeek -> Day -> Day weekFirstDay firstDay day = addDays (negate 7) $ firstDayOfWeekOnAfter firstDay $ succ day -- | Returns the last day of a week containing the given 'Day'. -- -- Examples: -- -- >>> weekLastDay Sunday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 26 -- -- >>> weekLastDay Monday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 27 -- -- >>> weekLastDay Tuesday (YearMonthDay 2022 02 21) -- YearMonthDay 2022 2 21 -- -- @since 1.12.2 weekLastDay :: DayOfWeek -> Day -> Day weekLastDay firstDay day = pred $ firstDayOfWeekOnAfter firstDay $ succ day #endif ------------------------------------------------------------------------------- -- Days ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,12,1) class Ord p => DayPeriod p where -- | Returns the first 'Day' in a period of days. periodFirstDay :: p -> Day -- | Returns the last 'Day' in a period of days. periodLastDay :: p -> Day -- | Get the period this day is in. dayPeriod :: Day -> p -- | A list of all the days in this period. -- -- @since 1.12.1 periodAllDays :: DayPeriod p => p -> [Day] periodAllDays p = [periodFirstDay p .. periodLastDay p] -- | The number of days in this period. -- -- @since 1.12.1 periodLength :: DayPeriod p => p -> Int periodLength p = succ $ fromInteger $ diffDays (periodLastDay p) (periodFirstDay p) -- | Get the period this day is in, with the 1-based day number within the period. -- -- @periodFromDay (periodFirstDay p) = (p,1)@ -- -- @since 1.12.1 periodFromDay :: DayPeriod p => Day -> (p, Int) periodFromDay d = let p = dayPeriod d dt = succ $ fromInteger $ diffDays d $ periodFirstDay p in (p, dt) -- | Inverse of 'periodFromDay'. -- -- @since 1.12.1 periodToDay :: DayPeriod p => p -> Int -> Day periodToDay p i = addDays (toInteger $ pred i) $ periodFirstDay p -- | Validating inverse of 'periodFromDay'. -- -- @since 1.12.1 periodToDayValid :: DayPeriod p => p -> Int -> Maybe Day periodToDayValid p i = let d = periodToDay p i in if fst (periodFromDay d) == p then Just d else Nothing instance DayPeriod Day where periodFirstDay = id periodLastDay = id dayPeriod = id instance DayPeriod Year where periodFirstDay y = YearMonthDay y January 1 periodLastDay y = YearMonthDay y December 31 dayPeriod (YearMonthDay y _ _) = y instance DayPeriod Month where periodFirstDay (YearMonth y m) = YearMonthDay y m 1 periodLastDay (YearMonth y m) = YearMonthDay y m 31 -- clips to correct day dayPeriod (YearMonthDay y my _) = YearMonth y my instance DayPeriod Quarter where periodFirstDay (YearQuarter y q) = case q of Q1 -> periodFirstDay $ YearMonth y January Q2 -> periodFirstDay $ YearMonth y April Q3 -> periodFirstDay $ YearMonth y July Q4 -> periodFirstDay $ YearMonth y October periodLastDay (YearQuarter y q) = case q of Q1 -> periodLastDay $ YearMonth y March Q2 -> periodLastDay $ YearMonth y June Q3 -> periodLastDay $ YearMonth y September Q4 -> periodLastDay $ YearMonth y December dayPeriod (MonthDay m _) = monthQuarter m #endif time-compat-1.9.8/src/Data/Time/Calendar/Easter/0000755000000000000000000000000007346545000017433 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/Easter/Compat.hs0000644000000000000000000000032607346545000021213 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.8/src/Data/Time/Calendar/Julian/0000755000000000000000000000000007346545000017432 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/Julian/Compat.hs0000644000000000000000000000646507346545000021224 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.Julian.Compat ( Year, MonthOfYear, DayOfMonth, DayOfYear, -- JulianYearDay toJulianYearAndDay, fromJulianYearAndDay, fromJulianYearAndDayValid, showJulianYearAndDay, isJulianLeapYear, toJulian,fromJulian, pattern JulianYearMonthDay, 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 () #if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,14,0) import Data.Time.Calendar.Julian hiding (diffJulianDurationRollOver) #else import Data.Time.Calendar.Julian #endif 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 #endif #if !MIN_VERSION_time(1,14,0) diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays diffJulianDurationRollOver day2 day1 = let (y1, m1, _) = toJulian day1 (y2, m2, _) = toJulian day2 ym1 = y1 * 12 + toInteger m1 ym2 = y2 * 12 + toInteger m2 ymdiff = ym2 - ym1 findpos mdiff = let dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1 dd = diffDays day2 dayAllowed in if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff) findneg mdiff = let dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1 dd = diffDays day2 dayAllowed in if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff) in if day2 >= day1 then findpos ymdiff else findneg ymdiff #endif #if !MIN_VERSION_time(1,11,0) -- | 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 {-# COMPLETE JulianYearMonthDay #-} #endif time-compat-1.9.8/src/Data/Time/Calendar/Month/0000755000000000000000000000000007346545000017275 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/Month/Compat.hs0000644000000000000000000001335207346545000021060 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.Month.Compat ( Month(..), addMonths, diffMonths, pattern YearMonth, fromYearMonthValid, pattern MonthDay, 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 (..)) import qualified Language.Haskell.TH.Syntax as TH -- | An absolute count of common calendar months. -- Number is equal to @(year * 12) + (monthOfYear - 1)@. newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable, TH.Lift) 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 #else #define FORMAT_OPTS tl mpo i #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)) -- | 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 {-# COMPLETE YearMonth #-} -- | 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 -- | 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 {-# COMPLETE MonthDay #-} #endif time-compat-1.9.8/src/Data/Time/Calendar/MonthDay/0000755000000000000000000000000007346545000017733 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/MonthDay/Compat.hs0000644000000000000000000000261107346545000021512 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.MonthDay.Compat ( MonthOfYear, DayOfMonth, DayOfYear, pattern January, pattern February, pattern March, pattern April, pattern May, pattern June, pattern July, pattern August, pattern September, pattern October, pattern November, pattern December, 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) 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 {-# COMPLETE January, February, March, April, May, June, July, August, September, October, November, December #-} #endif time-compat-1.9.8/src/Data/Time/Calendar/OrdinalDate/0000755000000000000000000000000007346545000020376 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/OrdinalDate/Compat.hs0000644000000000000000000000176007346545000022161 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.OrdinalDate.Compat ( Day, Year, DayOfYear, WeekOfYear, toOrdinalDate, fromOrdinalDate, pattern YearDay, fromOrdinalDateValid, showOrdinalDate, isLeapYear, mondayStartWeek, sundayStartWeek, fromMondayStartWeek, fromMondayStartWeekValid, fromSundayStartWeek, fromSundayStartWeekValid, ) where import Data.Time.Orphans () import Data.Time.Calendar.OrdinalDate hiding (fromSundayStartWeekValid) import Data.Time.Calendar.OrdinalDate (fromSundayStartWeekValid) #if !MIN_VERSION_time(1,11,0) import Data.Time.Calendar import Data.Time.Calendar.Types #endif #if !MIN_VERSION_time(1,11,0) -- | 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 {-# COMPLETE YearDay #-} #endif time-compat-1.9.8/src/Data/Time/Calendar/Private.hs0000644000000000000000000000335607346545000020165 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.8/src/Data/Time/Calendar/Quarter/0000755000000000000000000000000007346545000017633 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/Quarter/Compat.hs0000644000000000000000000001100507346545000021407 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.Quarter.Compat ( QuarterOfYear(..), addQuarters, diffQuarters, Quarter(..), pattern YearQuarter, 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 GHC.Generics (Generic) import qualified Language.Haskell.TH.Syntax as TH 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, Ix, TH.Lift, Generic) 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, Generic) 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 -- | Bidirectional abstract constructor. pattern YearQuarter :: Year -> QuarterOfYear -> Quarter pattern YearQuarter y qy <- (toYearQuarter -> (y, qy)) where YearQuarter y qy = fromYearQuarter y qy {-# COMPLETE YearQuarter #-} 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.8/src/Data/Time/Calendar/Types.hs0000644000000000000000000000314607346545000017654 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.Types ( Year, MonthOfYear, DayOfMonth, DayOfYear, WeekOfYear, pattern CommonEra, pattern BeforeCommonEra, ) 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) #endif #if MIN_VERSION_time(1,12,1) import Data.Time.Calendar (pattern CommonEra, pattern BeforeCommonEra) #endif #if !MIN_VERSION_time(1,11,0) -- | 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 #if !MIN_VERSION_time(1,12,1) -- | Also known as Anno Domini. pattern CommonEra :: Integer -> Year pattern CommonEra n <- ((\y -> if y > 0 then Just y else Nothing) -> Just n) where CommonEra n = n -- | Also known as Before Christ. -- Note that Year 1 = 1 CE, and the previous Year 0 = 1 BCE. -- 'CommonEra' and 'BeforeCommonEra' form a @COMPLETE@ set. pattern BeforeCommonEra :: Integer -> Year pattern BeforeCommonEra n <- ((\y -> if y <= 0 then Just (1 - y) else Nothing) -> Just n) where BeforeCommonEra n = 1 - n {-# COMPLETE CommonEra, BeforeCommonEra #-} #endif time-compat-1.9.8/src/Data/Time/Calendar/WeekDate/0000755000000000000000000000000007346545000017701 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Calendar/WeekDate/Compat.hs0000644000000000000000000001414507346545000021465 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Time.Calendar.WeekDate.Compat ( Year, WeekOfYear, DayOfWeek(..), dayOfWeek, FirstWeekType (..), toWeekCalendar, fromWeekCalendar, fromWeekCalendarValid, -- * ISO 8601 Week Date format toWeekDate, fromWeekDate, pattern YearWeekDay, 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.Ix (Ix) import Data.Time.Calendar.Types import Data.Time.Calendar.Private import Data.Time.Calendar.OrdinalDate import GHC.Generics (Generic) import qualified Language.Haskell.TH.Syntax as TH #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, TH.Lift) 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 -- | 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) {-# COMPLETE YearWeekDay #-} #endif #if !MIN_VERSION_time(1,9,0) data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday deriving (Eq, Ord, Show, Read, Typeable, Data, Ix, TH.Lift, Generic) 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) #define FORMAT_OPTS tl mpo i 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.8/src/Data/Time/Clock/0000755000000000000000000000000007346545000015532 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Clock/Compat.hs0000644000000000000000000000214407346545000017312 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskellQuotes #-} 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) import Debug.Trace #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 time-compat-1.9.8/src/Data/Time/Clock/POSIX/0000755000000000000000000000000007346545000016434 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Clock/POSIX/Compat.hs0000644000000000000000000000044007346545000020211 0ustar0000000000000000module 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 time-compat-1.9.8/src/Data/Time/Clock/System/0000755000000000000000000000000007346545000017016 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Clock/System/Compat.hs0000644000000000000000000000041207346545000020572 0ustar0000000000000000module Data.Time.Clock.System.Compat ( systemEpochDay, SystemTime(..), truncateSystemTimeLeapSecond, getSystemTime, systemToUTCTime, utcToSystemTime, systemToTAITime, ) where import Data.Time.Orphans () import Data.Time.Clock.System time-compat-1.9.8/src/Data/Time/Clock/TAI/0000755000000000000000000000000007346545000016147 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Clock/TAI/Compat.hs0000644000000000000000000000075307346545000017733 0ustar0000000000000000module Data.Time.Clock.TAI.Compat ( -- * TAI arithmetic AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime, taiNominalDayStart, -- * leap-second map type LeapSecondMap, -- * conversion between UTC and TAI with map T.utcDayLength,T.utcToTAITime,T.taiToUTCTime, 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 time-compat-1.9.8/src/Data/Time/0000755000000000000000000000000007346545000014477 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Compat.hs0000644000000000000000000000053107346545000016255 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.8/src/Data/Time/Format/0000755000000000000000000000000007346545000015727 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Format/Compat.hs0000644000000000000000000000547407346545000017520 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,9,0)) import Data.Time.Format hiding (parseTimeM) #else import Data.Time.Format #endif import qualified Control.Monad.Fail as Fail import qualified Data.Time.Format -- parseTimeM has always Fail.MonadFail constraint #if !MIN_VERSION_time(1,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 #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.8/src/Data/Time/Format/ISO8601/0000755000000000000000000000000007346545000016700 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/Format/ISO8601/Compat.hs0000644000000000000000000003550707346545000020471 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 :: ( MonadFail m ) => (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 :: ( MonadFail m ,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.8/src/Data/Time/LocalTime/0000755000000000000000000000000007346545000016350 5ustar0000000000000000time-compat-1.9.8/src/Data/Time/LocalTime/Compat.hs0000644000000000000000000001104007346545000020123 0ustar0000000000000000{-# LANGUAGE CPP #-} 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.Time.Format.Compat import Data.Fixed (Pico (..), showFixed, divMod') import Data.Monoid (Monoid (..)) import Data.Data (Data, Typeable) import Data.Semigroup (Semigroup (..)) import Control.DeepSeq (NFData (..)) import GHC.Generics (Generic) ------------------------------------------------------------------------------- -- 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 , Generic ) -- | 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 -- TODO: -- instance Read CalendarDiffTime where -- readsPrec = error "TODO" ------------------------------------------------------------------------------- -- 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.8/src/Data/Time/Orphans.hs0000644000000000000000000001664307346545000016457 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TemplateHaskellQuotes #-} module Data.Time.Orphans () where import Data.Orphans () import Control.DeepSeq (NFData (..)) import Data.Ix (Ix) 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 (..)) import Data.Time.Format (TimeLocale (..)) import Data.Time.Clock.System #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 import Data.Time.Calendar.WeekDate #endif #if !MIN_VERSION_time(1,14,0) import GHC.Generics (Generic) import qualified Language.Haskell.TH.Syntax as TH import Data.Fixed (Fixed (..), Pico) #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) deriving instance Data DayOfWeek #endif #if MIN_VERSION_time(1,8,0) && !MIN_VERSION_time(1,10,0) 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 deriving instance Ix DayOfWeek #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) deriving instance Ix QuarterOfYear #endif ------------------------------------------------------------------------------- -- Lift & Generic ------------------------------------------------------------------------------- #if !MIN_VERSION_time(1,14,0) deriving instance TH.Lift Day deriving instance TH.Lift UTCTime deriving instance TH.Lift UniversalTime deriving instance Generic Day deriving instance Generic LocalTime deriving instance Generic TimeOfDay deriving instance Generic TimeZone deriving instance Generic UTCTime deriving instance Generic UniversalTime deriving instance Generic ZonedTime #if MIN_VERSION_time(1,9,0) deriving instance TH.Lift DayOfWeek deriving instance TH.Lift CalendarDiffDays deriving instance Generic CalendarDiffDays deriving instance Generic CalendarDiffTime #endif #if MIN_VERSION_time(1,11,0) deriving instance Generic Quarter deriving instance TH.Lift Month deriving instance TH.Lift QuarterOfYear deriving instance TH.Lift FirstWeekType #endif instance TH.Lift DiffTime where lift x = [| picosecondsToDiffTime x' |] where x' = diffTimeToPicoseconds x #if MIN_VERSION_template_haskell(2,16,0) liftTyped x = [|| picosecondsToDiffTime x' ||] where x' = diffTimeToPicoseconds x #endif #if MIN_VERSION_time(1,9,1) instance TH.Lift NominalDiffTime where lift x = [| secondsToNominalDiffTime (MkFixed x' :: Pico) |] where x' = case nominalDiffTimeToSeconds x of MkFixed y -> y #if MIN_VERSION_template_haskell(2,16,0) liftTyped x = [|| secondsToNominalDiffTime (MkFixed x' :: Pico) ||] where x' = case nominalDiffTimeToSeconds x of MkFixed y -> y #endif #else instance TH.Lift NominalDiffTime where lift x = [| realToFrac (MkFixed x' :: Pico) |] where x' = case realToFrac x :: Pico of MkFixed y -> y #if MIN_VERSION_template_haskell(2,16,0) liftTyped x = [|| realToFrac (MkFixed x' :: Pico) ||] where x' = case realToFrac x :: Pico of MkFixed y -> y #endif #endif #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.8/test-instances/0000755000000000000000000000000007346545000015105 5ustar0000000000000000time-compat-1.9.8/test-instances/Test.hs0000644000000000000000000002404107346545000016361 0ustar0000000000000000{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ConstraintKinds #-} module Main where import Control.DeepSeq (NFData (rnf), force) import Data.Hashable (Hashable) import Data.Data (Data) import Data.Kind (Type, Constraint) import GHC.Generics (Generic) import qualified Data.Monoid as Mon import qualified Data.Semigroup as Semi import qualified Language.Haskell.TH.Syntax as TH import Data.Time.Calendar.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Clock.System.Compat import Data.Time.Clock.TAI.Compat import Data.Time.Compat import Data.Time.Format.Compat import Data.Time.Format.ISO8601.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" ------------------------------------------------------------------------------- -- per type instances ------------------------------------------------------------------------------- _instances :: [()] _instances = [ inst (P @TimeZone) (P @Data) , inst (P @TimeZone) (P @Generic) , inst (P @TimeZone) (P @Read) , inst (P @TimeZone) (P @Show) , inst (P @TimeZone) (P @NFData) , inst (P @TimeZone) (P @Eq) , inst (P @TimeZone) (P @Ord) , inst (P @TimeZone) (P @FormatTime) , inst (P @TimeZone) (P @ISO8601) , inst (P @TimeZone) (P @ParseTime) , inst (P @TimeOfDay) (P @Data) , inst (P @TimeOfDay) (P @Generic) , inst (P @TimeOfDay) (P @Read) , inst (P @TimeOfDay) (P @Show) , inst (P @TimeOfDay) (P @NFData) , inst (P @TimeOfDay) (P @Eq) , inst (P @TimeOfDay) (P @Ord) , inst (P @TimeOfDay) (P @FormatTime) , inst (P @TimeOfDay) (P @ISO8601) , inst (P @TimeOfDay) (P @ParseTime) , inst (P @CalendarDiffTime) (P @Data) , inst (P @CalendarDiffTime) (P @Mon.Monoid) , inst (P @CalendarDiffTime) (P @Semi.Semigroup) , inst (P @CalendarDiffTime) (P @Generic) -- , inst (P @CalendarDiffTime) (P @Read) , inst (P @CalendarDiffTime) (P @Show) , inst (P @CalendarDiffTime) (P @NFData) , inst (P @CalendarDiffTime) (P @Eq) -- , inst (P @CalendarDiffTime) (P @FormatTime) , inst (P @CalendarDiffTime) (P @ISO8601) -- , inst (P @CalendarDiffTime) (P @ParseTime) , inst (P @LocalTime) (P @Data) , inst (P @LocalTime) (P @Generic) , inst (P @LocalTime) (P @Read) , inst (P @LocalTime) (P @Show) , inst (P @LocalTime) (P @NFData) , inst (P @LocalTime) (P @Eq) , inst (P @LocalTime) (P @Ord) , inst (P @LocalTime) (P @FormatTime) , inst (P @LocalTime) (P @ISO8601) , inst (P @LocalTime) (P @ParseTime) , inst (P @ZonedTime) (P @Data) , inst (P @ZonedTime) (P @Generic) , inst (P @ZonedTime) (P @Read) , inst (P @ZonedTime) (P @Show) , inst (P @ZonedTime) (P @NFData) , inst (P @ZonedTime) (P @FormatTime) , inst (P @ZonedTime) (P @ISO8601) , inst (P @ZonedTime) (P @ParseTime) , inst (P @UniversalTime) (P @Data) , inst (P @UniversalTime) (P @Generic) , inst (P @UniversalTime) (P @Read) , inst (P @UniversalTime) (P @Show) , inst (P @UniversalTime) (P @NFData) , inst (P @UniversalTime) (P @Eq) , inst (P @UniversalTime) (P @Ord) , inst (P @UniversalTime) (P @FormatTime) , inst (P @UniversalTime) (P @ParseTime) , inst (P @UniversalTime) (P @TH.Lift) , inst (P @DiffTime) (P @Data) , inst (P @DiffTime) (P @Read) , inst (P @DiffTime) (P @Show) , inst (P @DiffTime) (P @NFData) , inst (P @DiffTime) (P @Eq) , inst (P @DiffTime) (P @Ord) -- , inst (P @DiffTime) (P @FormatTime) -- , inst (P @DiffTime) (P @ParseTime) , inst (P @DiffTime) (P @TH.Lift) , inst (P @UTCTime) (P @Data) , inst (P @UTCTime) (P @Generic) , inst (P @UTCTime) (P @Read) , inst (P @UTCTime) (P @Show) , inst (P @UTCTime) (P @NFData) , inst (P @UTCTime) (P @Eq) , inst (P @UTCTime) (P @Ord) , inst (P @UTCTime) (P @FormatTime) , inst (P @UTCTime) (P @ISO8601) , inst (P @UTCTime) (P @ParseTime) , inst (P @UTCTime) (P @TH.Lift) , inst (P @NominalDiffTime) (P @Data) -- , inst (P @NominalDiffTime) (P @Read) , inst (P @NominalDiffTime) (P @Show) , inst (P @NominalDiffTime) (P @NFData) , inst (P @NominalDiffTime) (P @Eq) , inst (P @NominalDiffTime) (P @Ord) -- , inst (P @NominalDiffTime) (P @FormatTime) -- , inst (P @NominalDiffTime) (P @ISO8601) -- , inst (P @NominalDiffTime) (P @ParseTime) , inst (P @NominalDiffTime) (P @TH.Lift) , inst (P @Day) (P @Data) , inst (P @Day) (P @Generic) , inst (P @Day) (P @Read) , inst (P @Day) (P @Show) , inst (P @Day) (P @NFData) , inst (P @Day) (P @Eq) , inst (P @Day) (P @Ord) , inst (P @Day) (P @FormatTime) , inst (P @Day) (P @ISO8601) , inst (P @Day) (P @ParseTime) , inst (P @Day) (P @TH.Lift) , inst (P @CalendarDiffDays) (P @Data) , inst (P @CalendarDiffDays) (P @Mon.Monoid) , inst (P @CalendarDiffDays) (P @Semi.Semigroup) , inst (P @CalendarDiffDays) (P @Generic) -- , inst (P @CalendarDiffDays) (P @Read) , inst (P @CalendarDiffDays) (P @Show) , inst (P @CalendarDiffDays) (P @NFData) , inst (P @CalendarDiffDays) (P @Eq) -- , inst (P @CalendarDiffDays) (P @FormatTime) , inst (P @CalendarDiffDays) (P @ISO8601) -- , inst (P @CalendarDiffDays) (P @ParseTime) , inst (P @CalendarDiffDays) (P @TH.Lift) , inst (P @DayOfWeek) (P @Data) , inst (P @DayOfWeek) (P @Read) , inst (P @DayOfWeek) (P @Show) , inst (P @DayOfWeek) (P @NFData) , inst (P @DayOfWeek) (P @Eq) , inst (P @DayOfWeek) (P @FormatTime) , inst (P @DayOfWeek) (P @TH.Lift) , inst (P @FirstWeekType) (P @Eq) , inst (P @FirstWeekType) (P @TH.Lift) , inst (P @Month) (P @Data) , inst (P @Month) (P @Read) , inst (P @Month) (P @Show) , inst (P @Month) (P @NFData) , inst (P @Month) (P @Eq) , inst (P @Month) (P @Ord) , inst (P @Month) (P @FormatTime) -- , inst (P @Month) (P @ParseTime) , inst (P @Month) (P @TH.Lift) , inst (P @Quarter) (P @Data) , inst (P @Quarter) (P @Read) , inst (P @Quarter) (P @Show) , inst (P @Quarter) (P @NFData) , inst (P @Quarter) (P @Eq) , inst (P @Quarter) (P @Ord) , inst (P @Quarter) (P @Generic) , inst (P @QuarterOfYear) (P @Data) , inst (P @QuarterOfYear) (P @Read) , inst (P @QuarterOfYear) (P @Show) , inst (P @QuarterOfYear) (P @NFData) , inst (P @QuarterOfYear) (P @Eq) , inst (P @QuarterOfYear) (P @Ord) , inst (P @QuarterOfYear) (P @Eq) , inst (P @QuarterOfYear) (P @TH.Lift) , inst (P @Day) (P @DayPeriod) , inst (P @Month) (P @DayPeriod) , inst (P @Quarter) (P @DayPeriod) , inst (P @Year) (P @DayPeriod) ] data P a = P inst :: c a => P a -> P c -> () inst _ _ = () ------------------------------------------------------------------------------- -- Old tests ------------------------------------------------------------------------------- _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.8/test/main/0000755000000000000000000000000007346545000014044 5ustar0000000000000000time-compat-1.9.8/test/main/Main.hs0000644000000000000000000000306207346545000015265 0ustar0000000000000000module Main where import Test.Calendar.AddDays import Test.Calendar.CalendarProps import Test.Calendar.Calendars import Test.Calendar.ClipDates import Test.Calendar.ConvertBack import Test.Calendar.DayPeriod import Test.Calendar.Duration import Test.Calendar.Easter import Test.Calendar.LongWeekYears import Test.Calendar.MonthDay import Test.Calendar.MonthOfYear import Test.Calendar.Valid import Test.Calendar.Week import Test.Calendar.Year import Test.Clock.Conversion import Test.Clock.Lift (testLift) 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 import Test.Types () tests :: TestTree tests = testGroup "Time" [ testGroup "Calendar" [ addDaysTest , testCalendarProps , testCalendars , clipDates , convertBack , longWeekYears , testDayPeriod , testMonthDay , testMonthOfYear , testEaster , testValid , testWeek , testYear , testDuration ] , testGroup "Clock" [testClockConversion, testResolutions, testTAI, testLift] -- , testGroup "Format" [testFormat, testParseTime, testISO8601] , testGroup "LocalTime" [{- testTime, -} testTimeOfDay, testCalendarDiffTime] ] main :: IO () main = defaultMain tests time-compat-1.9.8/test/main/Test/0000755000000000000000000000000007346545000014763 5ustar0000000000000000time-compat-1.9.8/test/main/Test/Arbitrary.hs0000644000000000000000000001317307346545000017263 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.Month.Compat import Data.Time.Calendar.Quarter.Compat import Data.Time.Calendar.WeekDate.Compat import Data.Time.Clock.POSIX.Compat import System.Random 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) deriving instance Random Day supportedDayRange :: (Day, Day) supportedDayRange = (fromGregorian (-9899) 1 1, fromGregorian 9999 12 31) instance Arbitrary Day where arbitrary = choose supportedDayRange 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.8/test/main/Test/Calendar/0000755000000000000000000000000007346545000016474 5ustar0000000000000000time-compat-1.9.8/test/main/Test/Calendar/AddDays.hs0000644000000000000000000000224607346545000020345 0ustar0000000000000000module Test.Calendar.AddDays ( addDaysTest, ) where import Data.Time.Calendar.Compat 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.8/test/main/Test/Calendar/AddDaysRef.hs0000644000000000000000000003260007346545000020777 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.8/test/main/Test/Calendar/CalendarProps.hs0000644000000000000000000000131207346545000021562 0ustar0000000000000000module Test.Calendar.CalendarProps ( testCalendarProps, ) where import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Test.Arbitrary () import Test.Tasty import Test.TestUtil 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] time-compat-1.9.8/test/main/Test/Calendar/Calendars.hs0000644000000000000000000000144607346545000020731 0ustar0000000000000000module Test.Calendar.Calendars ( testCalendars, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Julian.Compat import Data.Time.Calendar.WeekDate.Compat 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.8/test/main/Test/Calendar/CalendarsRef.hs0000644000000000000000000000075107346545000021364 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.8/test/main/Test/Calendar/ClipDates.hs0000644000000000000000000000337107346545000020704 0ustar0000000000000000module Test.Calendar.ClipDates ( clipDates, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat 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.8/test/main/Test/Calendar/ClipDatesRef.hs0000644000000000000000000004270507346545000021345 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.8/test/main/Test/Calendar/ConvertBack.hs0000644000000000000000000000301607346545000021231 0ustar0000000000000000module Test.Calendar.ConvertBack ( convertBack, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Julian.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat import Test.Tasty import Test.Tasty.HUnit checkDay :: Show t => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String checkDay encodeDay decodeDay decodeDayValid day = let st = encodeDay day day' = decodeDay st mday' = decodeDayValid st a = if day /= day' then unwords [show day, "-> ", show st, "-> ", show day', "(diff", show (diffDays day' day) ++ ")"] else "" b = if Just day /= mday' then unwords [show day, "->", show st, "->", show mday'] else "" in a ++ b checkers :: [Day -> String] checkers = [ checkDay toOrdinalDate (\(y, d) -> fromOrdinalDate y d) (\(y, d) -> fromOrdinalDateValid y d) , checkDay toWeekDate (\(y, w, d) -> fromWeekDate y w d) (\(y, w, d) -> fromWeekDateValid y w d) , checkDay toGregorian (\(y, m, d) -> fromGregorian y m d) (\(y, m, d) -> fromGregorianValid y m d) , checkDay toJulian (\(y, m, d) -> fromJulian y m d) (\(y, m, d) -> fromJulianValid y m d) ] days :: [Day] days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++ (fmap (\year -> (fromGregorian year 1 4)) [1980 .. 2000]) convertBack :: TestTree convertBack = testCase "convertBack" $ assertEqual "" "" $ concatMap (\ch -> concatMap ch days) checkers time-compat-1.9.8/test/main/Test/Calendar/DayPeriod.hs0000644000000000000000000001361107346545000020712 0ustar0000000000000000module Test.Calendar.DayPeriod ( testDayPeriod, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck newtype WDay = MkWDay Day deriving (Eq, Show) instance Arbitrary WDay where arbitrary = do (MkWYear y) <- arbitrary (MkWMonthOfYear m) <- arbitrary (MkWDayOfMonth d) <- arbitrary pure $ MkWDay $ YearMonthDay y m 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 WMonth = MkWMonth Month deriving (Eq, Show) instance Arbitrary WMonth where arbitrary = do (MkWYear y) <- arbitrary (MkWMonthOfYear m) <- arbitrary pure $ MkWMonth $ YearMonth y m newtype WDayOfMonth = MkWDayOfMonth DayOfMonth deriving (Eq, Show) instance Arbitrary WDayOfMonth where arbitrary = fmap MkWDayOfMonth $ choose (-5, 35) newtype WQuarterOfYear = MkWQuarterOfYear QuarterOfYear deriving (Eq, Show) instance Arbitrary WQuarterOfYear where arbitrary = fmap MkWQuarterOfYear $ elements [Q1 .. Q4] newtype WQuarter = MkWQuarter Quarter deriving (Eq, Show) instance Arbitrary WQuarter where arbitrary = do (MkWYear y) <- arbitrary (MkWQuarterOfYear q) <- arbitrary pure $ MkWQuarter $ YearQuarter y q testDayPeriod :: TestTree testDayPeriod = testGroup "DayPeriod" [ testGroup "Day" testDay , testGroup "Month" testMonth , testGroup "Quarter" testQuarter , testGroup "Year" testYear , testGroup "Week" testWeek ] testDay :: [TestTree] testDay = [ testProperty "periodFirstDay" $ \(MkWDay d) -> periodFirstDay d == d , testProperty "periodLastDay" $ \(MkWDay d) -> periodLastDay d == d , testProperty "dayPeriod" $ \(MkWDay d) -> dayPeriod d == d , testProperty "periodAllDays" $ \(MkWDay d) -> periodAllDays d == [d] , testProperty "periodLength" $ \(MkWDay d) -> periodLength d == 1 ] testMonth :: [TestTree] testMonth = [ testProperty "periodFirstDay" $ \(MkWMonth my@(YearMonth y m)) -> periodFirstDay my == YearMonthDay y m 1 , testGroup "periodLastDay" [ testCase "leap year" $ periodLastDay (YearMonth 2024 February) @?= YearMonthDay 2024 February 29 , testCase "regular year" $ periodLastDay (YearMonth 2023 February) @?= YearMonthDay 2023 February 28 ] , testProperty "dayPeriod" $ \(MkWMonth my@(YearMonth y m), MkWDayOfMonth d) -> dayPeriod (YearMonthDay y m d) == my , testProperty "periodAllDays" $ \(MkWMonth my@(YearMonth y1 m1)) -> all (== (y1, m1)) $ map (\(YearMonthDay y2 m2 _) -> (y2, m2)) $ periodAllDays my , testGroup "periodLength" [ testProperty "property tests" $ \(MkWMonth my) -> periodLength my >= 28 , testCase "leap year" $ periodLength (YearMonth 2024 February) @?= 29 , testCase "regular year" $ periodLength (YearMonth 2023 February) @?= 28 ] ] testQuarter :: [TestTree] testQuarter = [ testGroup "periodFirstDay" [ testProperty "Q1" $ \(MkWYear y) -> periodFirstDay (YearQuarter y Q1) == YearMonthDay y January 1 , testProperty "Q2" $ \(MkWYear y) -> periodFirstDay (YearQuarter y Q2) == YearMonthDay y April 1 , testProperty "Q3" $ \(MkWYear y) -> periodFirstDay (YearQuarter y Q3) == YearMonthDay y July 1 , testProperty "Q4" $ \(MkWYear y) -> periodFirstDay (YearQuarter y Q4) == YearMonthDay y October 1 ] , testGroup "periodLastDay" [ testProperty "Q1" $ \(MkWYear y) -> periodLastDay (YearQuarter y Q1) == YearMonthDay y March 31 , testProperty "Q2" $ \(MkWYear y) -> periodLastDay (YearQuarter y Q2) == YearMonthDay y June 30 , testProperty "Q3" $ \(MkWYear y) -> periodLastDay (YearQuarter y Q3) == YearMonthDay y September 30 , testProperty "Q4" $ \(MkWYear y) -> periodLastDay (YearQuarter y Q4) == YearMonthDay y December 31 ] , testProperty "dayPeriod" $ \(MkWMonth my@(YearMonth y m), MkWDayOfMonth d) -> dayPeriod (YearMonthDay y m d) == monthQuarter my , testProperty "periodAllDays" $ \(MkWQuarter q) -> all (== q) $ map dayQuarter $ periodAllDays q , testProperty "periodLength" $ \(MkWQuarter q) -> periodLength q >= 90 ] testYear :: [TestTree] testYear = [ testProperty "periodFirstDay" $ \(MkWYear y) -> periodFirstDay y == YearMonthDay y January 1 , testProperty "periodLastDay" $ \(MkWYear y) -> periodLastDay y == YearMonthDay y December 31 , testProperty "dayPeriod" $ \(MkWYear y, MkWMonthOfYear m, MkWDayOfMonth d) -> dayPeriod (YearMonthDay y m d) == y , testProperty "periodAllDays" $ \(MkWYear y1) -> all (== y1) $ map (\(YearMonthDay y2 _ _) -> y2) $ periodAllDays y1 , testProperty "periodLength" $ \(MkWYear y) -> periodLength y >= 365 ] testWeek :: [TestTree] testWeek = [ testProperty "weekFirstDay/weekLastDay range" $ \dw (MkWDay d) -> let f = weekFirstDay dw d l = weekLastDay dw d in f <= d && d <= l , testProperty "weekFirstDay/weekLastDay range" $ \dw (MkWDay d) -> let f = weekFirstDay dw d l = weekLastDay dw d in addDays 6 f == l , testProperty "weekFirstDay dayOfWeek" $ \dw (MkWDay d) -> let f = weekFirstDay dw d in dayOfWeek f == dw ] time-compat-1.9.8/test/main/Test/Calendar/Duration.hs0000644000000000000000000000770007346545000020621 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) data AddDiff = MkAddDiff { adName :: String , adAdd :: CalendarDiffDays -> Day -> Day , adDifference :: Day -> Day -> CalendarDiffDays , adFromYMD :: Integer -> Int -> Int -> Day } gregorianClip :: AddDiff gregorianClip = MkAddDiff "gregorianClip" addGregorianDurationClip diffGregorianDurationClip fromGregorian gregorianRollOver :: AddDiff gregorianRollOver = MkAddDiff "gregorianRollOver" addGregorianDurationRollOver diffGregorianDurationRollOver fromGregorian julianClip :: AddDiff julianClip = MkAddDiff "julianClip" addJulianDurationClip diffJulianDurationClip fromJulian julianRollOver :: AddDiff julianRollOver = MkAddDiff "julianRollOver" addJulianDurationRollOver diffJulianDurationRollOver fromJulian addDiffs :: [AddDiff] addDiffs = [ gregorianClip , gregorianRollOver , julianClip , julianRollOver ] testAddDiff :: AddDiff -> TestTree testAddDiff MkAddDiff{..} = testProperty adName $ \day1 day2 -> adAdd (adDifference day2 day1) day1 == day2 testAddDiffs :: TestTree testAddDiffs = testGroup "add-diff" $ fmap testAddDiff addDiffs newtype Smallish = MkSmallish Integer deriving (Eq, Ord) deriving newtype instance Show Smallish instance Arbitrary Smallish where arbitrary = do b <- arbitrary n <- if b then choose (0, 60) else return 30 return $ MkSmallish n testPositiveDiff :: AddDiff -> TestTree testPositiveDiff MkAddDiff{..} = testProperty adName $ \day1 (MkSmallish i) -> let day2 = addDays i day1 r = adDifference day2 day1 in property $ cdMonths r >= 0 && cdDays r >= 0 testPositiveDiffs :: TestTree testPositiveDiffs = testGroup "positive-diff" $ fmap testPositiveDiff addDiffs testSpecific :: AddDiff -> (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree testSpecific MkAddDiff{..} (y2, m2, d2) (y1, m1, d1) (em, ed) = let day1 = adFromYMD y1 m1 d1 day2 = adFromYMD y2 m2 d2 expected = CalendarDiffDays em ed found = adDifference day2 day1 in testCase (adName ++ ": " ++ show day2 ++ " - " ++ show day1) $ do assertEqual "add" day2 $ adAdd found day1 assertEqual "diff" expected found testSpecificPair :: (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> (Integer, Integer) -> TestTree testSpecificPair day2 day1 clipD rollD = testGroup (show day2 ++ " - " ++ show day1) [ testSpecific gregorianClip day2 day1 clipD , testSpecific gregorianRollOver day2 day1 rollD , testSpecific julianClip day2 day1 clipD , testSpecific julianRollOver day2 day1 rollD ] testSpecifics :: TestTree testSpecifics = testGroup "specific" [ testSpecificPair (2017, 04, 07) (2017, 04, 07) (0, 0) (0, 0) , testSpecific gregorianClip (2017, 04, 07) (2017, 04, 01) (0, 6) , testSpecific gregorianClip (2017, 04, 01) (2017, 04, 07) (0, -6) , testSpecific gregorianClip (2017, 04, 07) (2017, 02, 01) (2, 6) , testSpecific gregorianClip (2017, 02, 01) (2017, 04, 07) (-2, -6) , testSpecificPair (2000, 03, 01) (2000, 01, 30) (1, 1) (1, 0) , testSpecificPair (2001, 03, 01) (2001, 01, 30) (1, 1) (0, 30) , testSpecificPair (2001, 03, 01) (2000, 01, 30) (13, 1) (12, 30) , testSpecificPair (2000, 03, 01) (2000, 01, 31) (1, 1) (0, 30) , testSpecificPair (2001, 03, 01) (2001, 01, 31) (1, 1) (0, 29) , testSpecificPair (2001, 03, 01) (2000, 01, 31) (13, 1) (12, 29) , testSpecificPair (2001, 10, 01) (2001, 08, 31) (1, 1) (1, 0) ] testDuration :: TestTree testDuration = testGroup "CalendarDiffDays" [testAddDiffs, testPositiveDiffs, testSpecifics] time-compat-1.9.8/test/main/Test/Calendar/Easter.hs0000644000000000000000000000230107346545000020247 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.8/test/main/Test/Calendar/EasterRef.hs0000644000000000000000000000755507346545000020724 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.8/test/main/Test/Calendar/LongWeekYears.hs0000644000000000000000000000145507346545000021554 0ustar0000000000000000module Test.Calendar.LongWeekYears ( longWeekYears, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.WeekDate.Compat 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.8/test/main/Test/Calendar/LongWeekYearsRef.hs0000644000000000000000000000627707346545000022220 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.8/test/main/Test/Calendar/MonthDay.hs0000644000000000000000000000202207346545000020547 0ustar0000000000000000module Test.Calendar.MonthDay ( testMonthDay, ) where import Data.Time.Calendar.MonthDay.Compat 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.8/test/main/Test/Calendar/MonthDayRef.hs0000644000000000000000000004275707346545000021227 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.8/test/main/Test/Calendar/MonthOfYear.hs0000644000000000000000000000107007346545000021221 0ustar0000000000000000module Test.Calendar.MonthOfYear ( testMonthOfYear, ) where import Data.Foldable import Data.Time.Calendar.Compat import Test.Tasty import Test.Tasty.HUnit matchMonthOfYear :: MonthOfYear -> Int matchMonthOfYear m = case m of January -> 1 February -> 2 March -> 3 April -> 4 May -> 5 June -> 6 July -> 7 August -> 8 September -> 9 October -> 10 November -> 11 December -> 12 testMonthOfYear :: TestTree testMonthOfYear = testCase "MonthOfYear" $ for_ [1 .. 12] $ \m -> assertEqual (show m) m $ matchMonthOfYear m time-compat-1.9.8/test/main/Test/Calendar/Valid.hs0000644000000000000000000001210207346545000020063 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.8/test/main/Test/Calendar/Week.hs0000644000000000000000000002032707346545000017727 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.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.TestUtil 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 ] testWeekDays :: TestTree testWeekDays = nameTest "Week Days" [ testGroup "weekAllDays" weekAllDaysTests , testGroup "weekFirstDay" weekFirstDayTests , testGroup "weekLastDay" weekLastDayTests ] weekAllDaysTests :: [TestTree] weekAllDaysTests = [ testGroup "Property Tests" [ nameTest "Week have 7 days" weekHaveSevenDays , nameTest "Day is part of the week" dayIsPartOfWeek ] , testGroup "Unit Tests" [ nameTest "FirstDay is less than Day-DayOfWeek" $ assertEqual "" [YearMonthDay 2023 12 31 .. YearMonthDay 2024 1 6] (weekAllDays Sunday (YearMonthDay 2024 1 1)) , nameTest "FirstDay is equal to Day-DayOfWeek" $ assertEqual "" [YearMonthDay 2024 2 26 .. YearMonthDay 2024 3 3] (weekAllDays Monday (YearMonthDay 2024 2 26)) , nameTest "FirstDay is greater than Day-DayOfWeek" $ assertEqual "" [YearMonthDay 2022 2 15 .. YearMonthDay 2022 2 21] (weekAllDays Tuesday (YearMonthDay 2022 2 21)) ] ] where weekHaveSevenDays :: DayOfWeek -> Day -> Bool weekHaveSevenDays fd d = length (weekAllDays fd d) == 7 dayIsPartOfWeek :: DayOfWeek -> Day -> Bool dayIsPartOfWeek fd d = d `elem` weekAllDays fd d weekFirstDayTests :: [TestTree] weekFirstDayTests = [ testGroup "Property Tests" [ nameTest "FirsyDay matches the Day-DayOfWeek" firstDayMatchesDay ] , testGroup "Unit Tests" [ nameTest "FirstDay is less than Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 20) (weekFirstDay Sunday (YearMonthDay 2022 2 21)) , nameTest "FirstDay is equal to Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 21) (weekFirstDay Monday (YearMonthDay 2022 2 21)) , nameTest "FirstDay is greater than Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 15) (weekFirstDay Tuesday (YearMonthDay 2022 2 21)) ] ] where firstDayMatchesDay :: DayOfWeek -> Day -> Bool firstDayMatchesDay fd d = dayOfWeek (weekFirstDay fd d) == fd weekLastDayTests :: [TestTree] weekLastDayTests = [ nameTest "FirstDay is less than Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 26) (weekLastDay Sunday (YearMonthDay 2022 2 21)) , nameTest "FirstDay is equal to Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 27) (weekLastDay Monday (YearMonthDay 2022 2 21)) , nameTest "FirstDay is greater than Day-DayOfWeek" $ assertEqual "" (YearMonthDay 2022 2 21) (weekLastDay Tuesday (YearMonthDay 2022 2 21)) ] testWeek :: TestTree testWeek = nameTest "Week" [ testDay , testSucc , testPred , testSequences , testReadShow , testDiff , testWeekDays ] time-compat-1.9.8/test/main/Test/Calendar/Year.hs0000644000000000000000000000154107346545000017731 0ustar0000000000000000module Test.Calendar.Year ( testYear, ) where import Data.Time.Calendar.Compat import Data.Time.Calendar.OrdinalDate.Compat import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.TestUtil cbRoundTrip :: TestTree cbRoundTrip = nameTest "CE-BCE" $ \(YearDay y _) -> case y of CommonEra n -> case id y of BeforeCommonEra _ -> False _ -> n >= 1 && y == CommonEra n _ -> case id y of BeforeCommonEra n -> n >= 1 && y == BeforeCommonEra n _ -> False testYear :: TestTree testYear = nameTest "Year" [ cbRoundTrip , nameTest "succ 1" $ assertEqual "" (BeforeCommonEra 1) $ succ $ BeforeCommonEra 2 , nameTest "succ 2" $ assertEqual "" (CommonEra 1) $ succ $ BeforeCommonEra 1 , nameTest "succ 3" $ assertEqual "" (CommonEra 2) $ succ $ CommonEra 1 ] time-compat-1.9.8/test/main/Test/Clock/0000755000000000000000000000000007346545000016016 5ustar0000000000000000time-compat-1.9.8/test/main/Test/Clock/Conversion.hs0000644000000000000000000000216607346545000020504 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.8/test/main/Test/Clock/Lift.hs0000644000000000000000000000075507346545000017257 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Test.Clock.Lift ( testLift, ) where import Data.Time.Clock.Compat import qualified Language.Haskell.TH.Syntax as TH import Test.Tasty import Test.Tasty.HUnit testLift :: TestTree testLift = testGroup "Lift instances" [ testCase "DiffTime" $ $(TH.lift (secondsToDiffTime 100)) @?= secondsToDiffTime 100 , testCase "NominalDiffTime" $ $(TH.lift (secondsToNominalDiffTime 100)) @?= secondsToNominalDiffTime 100 ] time-compat-1.9.8/test/main/Test/Clock/Resolution.hs0000644000000000000000000000362207346545000020520 0ustar0000000000000000module 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 (reportedRes, 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 foundGrid = gcdAll times assertBool ("reported resolution: " <> show reportedRes <> ", found: " <> show foundGrid) $ foundGrid <= reportedRes 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.8/test/main/Test/Clock/TAI.hs0000644000000000000000000000467007346545000016776 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.8/test/main/Test/Format/0000755000000000000000000000000007346545000016213 5ustar0000000000000000time-compat-1.9.8/test/main/Test/Format/Compile.hs0000644000000000000000000000047407346545000020144 0ustar0000000000000000-- Tests succeed if module compiles {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Format.Compile ( ) where {- import Data.Time.Compat newtype WrappedUTCTime = MkWrappedUTCTime UTCTime deriving (FormatTime, ParseTime) newtype Wrapped t = MkWrapped t deriving (FormatTime, ParseTime) -} time-compat-1.9.8/test/main/Test/Format/Format.hs0000644000000000000000000002166007346545000020004 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.8/test/main/Test/Format/ISO8601.hs0000644000000000000000000004415707346545000017533 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ISO8601 ( testISO8601, ) where import Data.Coerce import Data.Ratio import Data.Time.Compat import Data.Time.Format.ISO8601.Compat -- import Data.Time.Format.Internal.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) => (a -> Bool) -> Format a -> a -> Property readShowProperty skip _ val | skip val = property Discard 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)} class SpecialTestValues a where -- | values that should always be tested specialTestValues :: [a] instance {-# OVERLAPPABLE #-} SpecialTestValues a where specialTestValues = [] instance SpecialTestValues TimeOfDay where specialTestValues = [TimeOfDay 0 0 0, TimeOfDay 0 0 60, TimeOfDay 1 0 60, TimeOfDay 24 0 0] readShowTestCheck :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (a -> Bool) -> Format a -> [TestTree] readShowTestCheck skip fmt = [nameTest "random" $ readShowProperty skip fmt, nameTest "special" $ fmap (\a -> nameTest (show a) $ readShowProperty skip fmt a) $ filter (not . skip) specialTestValues] readShowTest :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => Format a -> [TestTree] readShowTest = readShowTestCheck $ \_ -> False readBoth :: NameTest t => (FormatExtension -> t) -> [TestTree] readBoth fmts = [nameTest "extended" $ fmts ExtendedFormat, nameTest "basic" $ fmts BasicFormat] readShowTestsCheck :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (a -> Bool) -> (FormatExtension -> Format a) -> [TestTree] readShowTestsCheck skip fmts = readBoth $ \fe -> readShowTestCheck skip $ fmts fe readShowTests :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (FormatExtension -> Format a) -> [TestTree] readShowTests = readShowTestsCheck $ \_ -> False newtype Durational t = MkDurational {unDurational :: t} deriving (Eq) 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 durationalFormat :: Format a -> Format (Durational a) durationalFormat = coerce testReadShowFormat :: TestTree testReadShowFormat = testGroup "read-show format" [] {- nameTest "read-show format" [] [ nameTest "calendarFormat" $ readShowTests $ calendarFormat , nameTest "yearMonthFormat" $ readShowTest $ yearMonthFormat , nameTest "yearFormat" $ readShowTest $ yearFormat , nameTest "centuryFormat" $ readShowTest $ centuryFormat , nameTest "expandedCalendarFormat" $ readShowTests $ expandedCalendarFormat 6 , nameTest "expandedYearMonthFormat" $ readShowTest $ expandedYearMonthFormat 6 , nameTest "expandedYearFormat" $ readShowTest $ expandedYearFormat 6 , nameTest "expandedCenturyFormat" $ readShowTest $ expandedCenturyFormat 4 , nameTest "ordinalDateFormat" $ readShowTests $ ordinalDateFormat , nameTest "expandedOrdinalDateFormat" $ readShowTests $ expandedOrdinalDateFormat 6 , nameTest "weekDateFormat" $ readShowTests $ weekDateFormat , nameTest "yearWeekFormat" $ readShowTests $ yearWeekFormat , nameTest "expandedWeekDateFormat" $ readShowTests $ expandedWeekDateFormat 6 , nameTest "expandedYearWeekFormat" $ readShowTests $ expandedYearWeekFormat 6 , nameTest "timeOfDayFormat" $ readShowTests $ timeOfDayFormat , nameTest "hourMinuteFormat" $ readShowTestsCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourMinuteFormat , nameTest "hourFormat" $ readShowTestCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourFormat , nameTest "withTimeDesignator" $ readShowTests $ \fe -> withTimeDesignator $ timeOfDayFormat fe , nameTest "withUTCDesignator" $ readShowTests $ \fe -> withUTCDesignator $ timeOfDayFormat fe , nameTest "timeOffsetFormat" $ readShowTests $ timeOffsetFormat , nameTest "timeOfDayAndOffsetFormat" $ readShowTests $ timeOfDayAndOffsetFormat , nameTest "localTimeFormat" $ readShowTests $ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe) , nameTest "zonedTimeFormat" $ readShowTests $ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe , nameTest "utcTimeFormat" $ readShowTests $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe) , nameTest "dayAndTimeFormat" $ readShowTests $ \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe) , nameTest "timeAndOffsetFormat" $ readShowTests $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe , nameTest "durationDaysFormat" $ readShowTest $ durationDaysFormat , nameTest "durationTimeFormat" $ readShowTest $ durationTimeFormat , nameTest "alternativeDurationDaysFormat" $ readBoth $ \fe -> readShowTest (durationalFormat $ alternativeDurationDaysFormat fe) , nameTest "alternativeDurationTimeFormat" $ readBoth $ \fe -> readShowTest (durationalFormat $ alternativeDurationTimeFormat fe) , nameTest "intervalFormat" $ readShowTests $ \fe -> intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat , nameTest "recurringIntervalFormat" $ readShowTests $ \fe -> recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat ] -} testShowReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree testShowReadFormat name fmt str val = nameTest (name ++ ": " ++ str) [ nameTest "show" $ assertEqual "" (Just str) $ formatShowM fmt val , nameTest "read" $ assertEqual "" (Just val) $ formatParseM fmt str ] testReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree testReadFormat name fmt str val = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just val) $ formatParseM fmt str testShowFormats :: TestTree testShowFormats = testGroup "show format" [] {- nameTest "show format" [ testShowReadFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0 , testShowReadFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0 , testShowReadFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0 , testShowReadFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5 , testShowReadFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay , testShowReadFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200 , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180 , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12 , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634 , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $ CalendarDiffTime 0 $ 5 * nominalDay + 7278.77634 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $ CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $ CalendarDiffTime 94 $ 7278.77634 , testShowReadFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634 , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $ CalendarDiffDays 12 0 , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $ CalendarDiffDays 27 29 , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $ CalendarDiffDays (561 * 12 + 8) 29 , testShowReadFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P0000-00-01T00:00:00" $ CalendarDiffTime 0 86400 , testShowReadFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P0007-10-05T02:01:18.77634" $ CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634 , testShowReadFormat "alternativeDurationTimeFormat" (alternativeDurationTimeFormat ExtendedFormat) "P4271-10-05T02:01:18.77634" $ CalendarDiffTime (12 * 4271 + 10) $ 5 * nominalDay + 7278.77634 , testShowReadFormat "centuryFormat" centuryFormat "02" 2 , testShowReadFormat "centuryFormat" centuryFormat "21" 21 , testShowReadFormat "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 ) , testShowReadFormat "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 ) , testShowReadFormat "recurringIntervalFormat etc." (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat) "R74/2015-06-13/P1Y2M7D" (74, fromGregorian 2015 6 13, CalendarDiffDays 14 7) , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390)) , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:00" (minutesToTimeZone (-360)) , testReadFormat "timeOffsetFormat" iso8601Format "-06" (minutesToTimeZone (-360)) , testShowReadFormat "timeOffsetFormat" iso8601Format "+11:00" (minutesToTimeZone 660) , testReadFormat "timeOffsetFormat" iso8601Format "+11" (minutesToTimeZone 660) , testShowReadFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" iso8601Format "+00" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" iso8601Format "-00:00" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" iso8601Format "-00" (minutesToTimeZone 0) , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+00" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0000" (minutesToTimeZone 0) , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-00" (minutesToTimeZone 0) , testShowReadFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10) , testShowReadFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10)) , testShowReadFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95) , testShowReadFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95)) , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95) , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95)) , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-1100" (minutesToTimeZone $ negate $ 11 * 60) , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615) , testShowReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553-06:30" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-390))) , testShowReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553-06:00" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-360))) , testReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553-06" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-360))) , testShowReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553+06:30" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 390)) , testShowReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553+06:00" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 360)) , testReadFormat "zonedTimeFormat" iso8601Format "2024-07-06T08:45:56.553+06" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 360)) , testShowReadFormat "utcTimeFormat" iso8601Format "2024-07-06T08:45:56.553Z" (UTCTime (fromGregorian 2024 07 06) (timeOfDayToTime $ TimeOfDay 8 45 56.553)) , testShowReadFormat "utcTimeFormat" iso8601Format "2028-12-31T23:59:60.9Z" (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9)) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10) , testShowReadFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10) , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4) , testShowReadFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4) , testShowReadFormat "weekDateFormat" (expandedWeekDateFormat 6 ExtendedFormat) "+001995-W05-6" (fromGregorian 1995 2 4) , testShowReadFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4) , testShowReadFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23) , testShowReadFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23) , testShowReadFormat "ordinalDateFormat" (expandedOrdinalDateFormat 5 ExtendedFormat) "+01846-235" (fromGregorian 1846 8 23) , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15) , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24) , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15) , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24) , testShowReadFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0) , testShowReadFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0) , testShowReadFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51) ] -} testISO8601 :: TestTree testISO8601 = nameTest "ISO8601" [testShowFormats, testReadShowFormat] time-compat-1.9.8/test/main/Test/Format/ParseTime.hs0000644000000000000000000007260307346545000020450 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ParseTime ( testParseTime, test_parse_format, ) where import Control.Monad import Data.Char import Data.Maybe import Data.Proxy import Data.Time.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.Quarter.Compat import Data.Time.Calendar.WeekDate.Compat import Test.Arbitrary (supportedDayRange) import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) import Test.TestUtil 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" [] {- [ readsTests , simpleFormatTests , extests , spacingTests , 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)] ) ) testReads :: (Eq a, Show a, Read a) => [(a, String)] -> String -> TestTree testReads expected target = let found = reads target result = assertEqual "" expected found name = show target in Test.Tasty.HUnit.testCase name result readsTestsParensSpaces :: forall a. (Eq a, Show a, Read a) => a -> String -> TestTree readsTestsParensSpaces expected target = testGroup target [ testReads [(expected, "")] $ target , testReads [(expected, "")] $ "(" ++ target ++ ")" , testReads [(expected, "")] $ " (" ++ target ++ ")" , testReads [(expected, " ")] $ " ( " ++ target ++ " ) " , testReads [(expected, " ")] $ " (( " ++ target ++ " )) " , testReads ([] :: [(a, String)]) $ "(" ++ target , testReads [(expected, ")")] $ "" ++ target ++ ")" , testReads [(expected, "")] $ "((" ++ target ++ "))" , testReads [(expected, " ")] $ " ( ( " ++ target ++ " ) ) " ] readsTests :: TestTree readsTests = testGroup "reads" [ readsTestsParensSpaces (3 :: Integer) "3" , readsTestsParensSpaces "a" "\"a\"" , readsTestsParensSpaces testDay "1912-07-08" , -- , readsTestsParensSpaces testDay "1912-7-8" readsTestsParensSpaces testTimeOfDay "08:04:02" -- , readsTestsParensSpaces testTimeOfDay "8:4:2" ] where testDay = fromGregorian 1912 7 8 testTimeOfDay = TimeOfDay 8 4 2 epoch :: LocalTime epoch = LocalTime (fromGregorian 1970 0 0) midnight testReadSTime :: (Show a, Eq a, ParseTime a) => [(a, String)] -> String -> String -> TestTree testReadSTime 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 simpleFormatTests :: TestTree simpleFormatTests = testGroup "simple" [ testReadSTime [(epoch, "")] "" "" , testReadSTime [(epoch, " ")] "" " " , testReadSTime [(epoch, "")] " " " " , testReadSTime [(epoch, "")] " " " " , testReadSTime [(epoch, "")] "%k" "0" , testReadSTime [(epoch, "")] "%k" " 0" , testReadSTime [(epoch, "")] "%m" "01" , testReadSTime [(epoch, " ")] "%m" "01 " , testReadSTime [(epoch, " ")] " %m" " 01 " , testReadSTime [(epoch, "")] " %m" " 01" , -- https://ghc.haskell.org/trac/ghc/ticket/9150 testReadSTime [(epoch, "")] " %M" " 00" , testReadSTime [(epoch, "")] "%M " "00 " , testReadSTime [(epoch, "")] "%Q" "" , testReadSTime [(epoch, " ")] "%Q" " " , testReadSTime [(epoch, "X")] "%Q" "X" , testReadSTime [(epoch, " X")] "%Q" " X" , testReadSTime [(epoch, "")] "%Q " " " , testReadSTime [(epoch, "")] "%Q X" " X" , testReadSTime [(epoch, "")] "%QX" "X" ] spacingForFormatTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree spacingForFormatTests expected formatStr target = testGroup formatStr [ 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) ] spacingTests :: TestTree spacingTests = testGroup "spacing" [ spacingForFormatTests epoch "%Q" "" , spacingForFormatTests epoch "%Q" ".0" , spacingForFormatTests epoch "%k" " 0" , spacingForFormatTests epoch "%M" "00" , spacingForFormatTests epoch "%m" "01" , spacingForFormatTests (TimeZone 120 False "") "%z" "+0200" , spacingForFormatTests (TimeZone 120 False "") "%Z" "+0200" , spacingForFormatTests (TimeZone (-480) False "PST") "%Z" "PST" ] particularParseTests :: TestTree particularParseTests = testGroup "particular" [ parseTest @Day True Nothing "%-d%-m%0Y" "2122012" -- ISSUE #232 , parseTest @Day True Nothing "%-d%-m%0Y" "2132012" -- ISSUE #232 ] 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 :: forall t. (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 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 -- reads_expect :: a -> [(a, String)] reads_expect t = [(t, "")] prop_read_show :: (Read a, Show a, Eq a) => a -> Result prop_read_show t = compareResult (reads_expect t) (reads (show t)) prop_read_show_ZonedUTC :: ZonedTime -> Result prop_read_show_ZonedUTC t = compareResult (reads_expect $ zonedTimeToUTC t) (reads (show t)) prop_read_show_LocalUTC :: LocalTime -> Result prop_read_show_LocalUTC t = compareResult (reads_expect $ localTimeToUTC utc t) (reads (show t)) prop_read_show_UTC_no_TZ :: UTCTime -> Result prop_read_show_UTC_no_TZ t = compareResult (reads_expect t) $ reads $ show $ utcToLocalTime utc 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 -- , 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 "#177" $ [ nameTest "start" $ \fc -> prop_format_parse_format Proxy fc (fst supportedDayRange) , nameTest "end" $ \fc -> prop_format_parse_format Proxy fc (snd supportedDayRange) ] , 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 "UTCTime (no TZ)" prop_read_show_UTC_no_TZ , 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.8/test/main/Test/LocalTime/0000755000000000000000000000000007346545000016634 5ustar0000000000000000time-compat-1.9.8/test/main/Test/LocalTime/CalendarDiffTime.hs0000644000000000000000000000322307346545000022311 0ustar0000000000000000module Test.LocalTime.CalendarDiffTime ( testCalendarDiffTime, ) where import Data.Time.Compat import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.TestUtil testReadShowExact :: (Read a, Show a, Eq a) => String -> a -> TestTree testReadShowExact t v = nameTest t [ nameTest "show" $ assertEqual "show" t $ show v , nameTest "read" $ assertEqual "read" v $ read t ] testCalendarDiffTime :: TestTree testCalendarDiffTime = testGroup "CalendarDiffTime" [] {- nameTest "CalendarDiffTime" [ testReadShowExact "P0D" $ CalendarDiffTime 0 0 , testReadShowExact "P1DT1S" $ CalendarDiffTime 0 $ secondsToNominalDiffTime 86401 , testReadShowExact "P-1DT1S" $ CalendarDiffTime 0 $ secondsToNominalDiffTime $ negate 86399 , testReadShowExact "P-1D" $ CalendarDiffTime 0 $ secondsToNominalDiffTime $ negate 86400 , testReadShowExact "P-2DT23H59M59S" $ CalendarDiffTime 0 $ secondsToNominalDiffTime $ negate 86401 , testReadShowExact "P1M-1DT1S" $ CalendarDiffTime 1 $ secondsToNominalDiffTime $ negate 86399 , testReadShowExact "P1M-1D" $ CalendarDiffTime 1 $ secondsToNominalDiffTime $ negate 86400 , testReadShowExact "P1M-2DT23H59M59S" $ CalendarDiffTime 1 $ secondsToNominalDiffTime $ negate 86401 , testReadShowExact "P-1Y-1M-1DT1S" $ CalendarDiffTime (-13) $ secondsToNominalDiffTime $ negate 86399 , testReadShowExact "P-1Y-1M-1D" $ CalendarDiffTime (-13) $ secondsToNominalDiffTime $ negate 86400 , testReadShowExact "P-1Y-1M-2DT23H59M59S" $ CalendarDiffTime (-13) $ secondsToNominalDiffTime $ negate 86401 ] -} time-compat-1.9.8/test/main/Test/LocalTime/Time.hs0000644000000000000000000000615407346545000020074 0ustar0000000000000000module Test.LocalTime.Time ( testTime, ) where import Data.Time.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat 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.8/test/main/Test/LocalTime/TimeOfDay.hs0000644000000000000000000000132707346545000021014 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.8/test/main/Test/LocalTime/TimeRef.hs0000644000000000000000000012365707346545000020541 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.8/test/main/Test/TestUtil.hs0000644000000000000000000000166307346545000017102 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.8/test/main/Test/Types.hs0000644000000000000000000000240407346545000016423 0ustar0000000000000000module Test.Types () where import Control.DeepSeq import Data.Data import Data.Ix import Data.Time.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 class (Typeable t, Data t, NFData t) => CheckDataInstances t class (Typeable t, Data t, NFData t, Eq t) => CheckEqInstances t class (Typeable t, Data t, NFData t, Eq t, Ord t) => CheckOrdInstances t class (Typeable t, Data t, NFData t, Eq t, Ord t, Ix t, Enum t) => CheckEnumInstances t class (Typeable t, Data t, NFData t, Eq t, Ord t, Ix t, Enum t, Bounded t) => CheckBoundedInstances t instance CheckOrdInstances UTCTime instance CheckOrdInstances NominalDiffTime instance CheckEnumInstances Day instance CheckEnumInstances DayOfWeek instance CheckOrdInstances TimeOfDay instance CheckOrdInstances LocalTime instance CheckOrdInstances TimeZone instance CheckDataInstances ZonedTime instance CheckEqInstances CalendarDiffDays instance CheckEqInstances CalendarDiffTime instance CheckEnumInstances Month instance CheckEnumInstances Quarter instance CheckBoundedInstances QuarterOfYear instance CheckOrdInstances SystemTime instance CheckOrdInstances AbsoluteTime instance CheckOrdInstances UniversalTime time-compat-1.9.8/time-compat.cabal0000644000000000000000000001161207346545000015345 0ustar0000000000000000cabal-version: 1.12 name: time-compat version: 1.9.8 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 ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.4 || ==9.10.1 || ==9.12.1 source-repository head type: git location: https://github.com/haskellari/time-compat.git library default-language: Haskell2010 hs-source-dirs: src other-extensions: CPP default-extensions: Trustworthy build-depends: base >=4.12 && <4.22 , base-orphans >=0.9.2 && <0.10 , deepseq >=1.4.4.0 && <1.6 , hashable >=1.4.4.0 && <1.6 , template-haskell , time >=1.8.0.2 && <1.9 || >=1.9.2 && <1.9.4 || >=1.10 && <1.10.1 || >=1.11 && <1.11.2 || >=1.12 && <1.13 || >=1.14 && <1.15 default-extensions: BangPatterns DeriveDataTypeable DeriveGeneric DeriveLift PatternSynonyms StandaloneDeriving ViewPatterns 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 , hashable >=1.4.0.0 && <1.6 , HUnit >=1.3.1 && <1.3.2 || >=1.6.0.0 && <1.7 , template-haskell , 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 DerivingStrategies ExistentialQuantification FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses Rank2Types RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications UndecidableInstances ghc-options: -Wall -fwarn-tabs build-depends: base , deepseq , QuickCheck >=2.15.0.1 && <2.16 , random >=1.2.1.3 && <1.3 , tagged >=0.8.9 && <0.9 , tasty >=1.5 && <1.6 , tasty-hunit >=0.10 && <0.11 , tasty-quickcheck >=0.11 && <0.12 , template-haskell , time-compat if !impl(ghc >=8.0) build-depends: fail >=4.9.0.0 && <4.10 , semigroups >=0.18.5 && <0.21 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.DayPeriod Test.Calendar.Duration Test.Calendar.Easter Test.Calendar.EasterRef Test.Calendar.LongWeekYears Test.Calendar.LongWeekYearsRef Test.Calendar.MonthDay Test.Calendar.MonthDayRef Test.Calendar.MonthOfYear Test.Calendar.Valid Test.Calendar.Week Test.Calendar.Year Test.Clock.Conversion Test.Clock.Lift 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