time-compat 1.9.7 → 1.9.8
raw patch · 45 files changed
+2930/−1676 lines, 45 filesdep +randomdep +template-haskelldep ~QuickCheckdep ~basedep ~tagged
Dependencies added: random, template-haskell
Dependency ranges changed: QuickCheck, base, tagged, tasty-quickcheck, time
Files
- src/Data/Time/Calendar/Compat.hs +226/−18
- src/Data/Time/Calendar/Julian/Compat.hs +32/−17
- src/Data/Time/Calendar/Month/Compat.hs +3/−5
- src/Data/Time/Calendar/MonthDay/Compat.hs +12/−4
- src/Data/Time/Calendar/OrdinalDate/Compat.hs +0/−2
- src/Data/Time/Calendar/Quarter/Compat.hs +4/−5
- src/Data/Time/Calendar/Types.hs +30/−2
- src/Data/Time/Calendar/WeekDate/Compat.hs +5/−7
- src/Data/Time/Clock/Compat.hs +3/−1
- src/Data/Time/Clock/System/Compat.hs +0/−1
- src/Data/Time/Clock/TAI/Compat.hs +0/−1
- src/Data/Time/LocalTime/Compat.hs +9/−1
- src/Data/Time/Orphans.hs +83/−2
- test-instances/Test.hs +194/−1
- test/main/Main.hs +24/−17
- test/main/Test/Arbitrary.hs +49/−36
- test/main/Test/Calendar/AddDays.hs +12/−6
- test/main/Test/Calendar/CalendarProps.hs +6/−7
- test/main/Test/Calendar/Calendars.hs +6/−6
- test/main/Test/Calendar/ClipDates.hs +21/−17
- test/main/Test/Calendar/ClipDatesRef.hs +567/−567
- test/main/Test/Calendar/ConvertBack.hs +23/−21
- test/main/Test/Calendar/DayPeriod.hs +181/−0
- test/main/Test/Calendar/Duration.hs +99/−31
- test/main/Test/Calendar/Easter.hs +22/−21
- test/main/Test/Calendar/LongWeekYears.hs +13/−11
- test/main/Test/Calendar/MonthDay.hs +15/−10
- test/main/Test/Calendar/MonthOfYear.hs +26/−0
- test/main/Test/Calendar/Valid.hs +91/−79
- test/main/Test/Calendar/Week.hs +188/−78
- test/main/Test/Calendar/Year.hs +29/−0
- test/main/Test/Clock/Conversion.hs +18/−16
- test/main/Test/Clock/Lift.hs +18/−0
- test/main/Test/Clock/Resolution.hs +22/−22
- test/main/Test/Clock/TAI.hs +42/−40
- test/main/Test/Format/Compile.hs +14/−14
- test/main/Test/Format/Format.hs +48/−37
- test/main/Test/Format/ISO8601.hs +278/−191
- test/main/Test/Format/ParseTime.hs +336/−280
- test/main/Test/LocalTime/CalendarDiffTime.hs +30/−11
- test/main/Test/LocalTime/Time.hs +51/−44
- test/main/Test/LocalTime/TimeOfDay.hs +15/−11
- test/main/Test/LocalTime/TimeRef.hs +7/−6
- test/main/Test/Types.hs +41/−15
- time-compat.cabal +37/−15
src/Data/Time/Calendar/Compat.hs view
@@ -2,14 +2,43 @@ {-# 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, @@ -26,17 +55,24 @@ -- * Week DayOfWeek(..), dayOfWeek, dayOfWeekDiff, firstDayOfWeekOnAfter,+ weekAllDays,+ weekFirstDay,+ weekLastDay, -- * Type aliases- DayOfMonth, MonthOfYear, Year, pattern YearMonthDay,- ) where+) 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,11,0)+#if !MIN_VERSION_time(1,12,1) import Data.Time.Calendar.Types #endif @@ -44,10 +80,25 @@ 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@@ -63,7 +114,7 @@ data CalendarDiffDays = CalendarDiffDays { cdMonths :: Integer , cdDays :: Integer- } deriving (Eq, Data, Typeable)+ } deriving (Eq, Data, Typeable, Generic, TH.Lift) -- | Additive instance Semigroup CalendarDiffDays where@@ -98,6 +149,10 @@ #endif +-- TODO:+-- instance Read CalendarDiffDays where+-- readsPrec = error "TODO"+ ------------------------------------------------------------------------------- -- Gregorian -------------------------------------------------------------------------------@@ -126,23 +181,34 @@ 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.--- Same as 'diffGregorianDurationClip' for positive durations. diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays-diffGregorianDurationRollOver day2 day1 = let- (y1,m1,d1) = toGregorian day1- (y2,m2,d2) = toGregorian day2- ym1 = y1 * 12 + toInteger m1- ym2 = y2 * 12 + toInteger m2- ymdiff = ym2 - ym1- ymAllowed =- if day2 >= day1 then- if d2 >= d1 then ymdiff else ymdiff - 1- else if d2 <= d1 then ymdiff else ymdiff + 1- dayAllowed = addGregorianDurationRollOver (CalendarDiffDays ymAllowed 0) day1- in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed-+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)@@ -168,4 +234,146 @@ -- | 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
src/Data/Time/Calendar/Julian/Compat.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.Julian.Compat ( Year, MonthOfYear, DayOfMonth, DayOfYear, @@ -25,7 +23,12 @@ 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)@@ -57,22 +60,34 @@ dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1 in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed --- | Calendrical difference, with as many whole months as possible.--- Same as 'diffJulianDurationClip' for positive durations.-diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays-diffJulianDurationRollOver day2 day1 = let- (y1,m1,d1) = toJulian day1- (y2,m2,d2) = toJulian day2- ym1 = y1 * 12 + toInteger m1- ym2 = y2 * 12 + toInteger m2- ymdiff = ym2 - ym1- ymAllowed =- if day2 >= day1 then- if d2 >= d1 then ymdiff else ymdiff - 1- else if d2 <= d1 then ymdiff else ymdiff + 1- dayAllowed = addJulianDurationRollOver (CalendarDiffDays ymAllowed 0) day1- in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed+#endif +#if !MIN_VERSION_time(1,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)
src/Data/Time/Calendar/Month/Compat.hs view
@@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.Month.Compat ( Month(..), addMonths, diffMonths, pattern YearMonth,@@ -55,10 +52,11 @@ 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)+newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable, TH.Lift) instance NFData Month where rnf (MkMonth m) = rnf m@@ -160,7 +158,7 @@ -- | Part of 'MonthDay' pattern toMonthDay :: Day -> (Month,DayOfMonth)-toMonthDay d = case toGregorian d of +toMonthDay d = case toGregorian d of (y, my, dm) -> (fromYearMonth y my, dm) -- | Part of 'MonthDay' pattern
src/Data/Time/Calendar/MonthDay/Compat.hs view
@@ -1,8 +1,18 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternSynonyms #-} module Data.Time.Calendar.MonthDay.Compat ( MonthOfYear, DayOfMonth, DayOfYear,- -- patterns+ 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,@@ -17,7 +27,6 @@ import Data.Time.Calendar.Types #endif -{- #if !MIN_VERSION_time(1,12,0) pattern January :: MonthOfYear pattern January = 1@@ -58,4 +67,3 @@ {-# COMPLETE January, February, March, April, May, June, July, August, September, October, November, December #-} #endif--}
src/Data/Time/Calendar/OrdinalDate/Compat.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.OrdinalDate.Compat ( Day, Year, DayOfYear, WeekOfYear, toOrdinalDate,
src/Data/Time/Calendar/Quarter/Compat.hs view
@@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.Quarter.Compat ( QuarterOfYear(..), addQuarters, diffQuarters, Quarter(..),@@ -37,6 +34,8 @@ 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@@ -44,7 +43,7 @@ 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)+data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Data, Typeable, Read, Show, Ix, TH.Lift, Generic) instance NFData QuarterOfYear where rnf Q1 = ()@@ -74,7 +73,7 @@ -- | An absolute count of year quarters. -- Number is equal to @(year * 4) + (quarterOfYear - 1)@.-newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable)+newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable, Generic) instance NFData Quarter where rnf (MkQuarter m) = rnf m
src/Data/Time/Calendar/Types.hs view
@@ -1,20 +1,28 @@ {-# 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 -#else+#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 @@ -31,4 +39,24 @@ -- | 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
src/Data/Time/Calendar/WeekDate/Compat.hs view
@@ -1,15 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-} module Data.Time.Calendar.WeekDate.Compat ( Year, WeekOfYear, DayOfWeek(..), dayOfWeek, FirstWeekType (..), toWeekCalendar, fromWeekCalendar, fromWeekCalendarValid,- -- * ISO 8601 Week Date format toWeekDate,@@ -31,9 +26,12 @@ #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 (..))@@ -46,7 +44,7 @@ -- ^ 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)+ deriving (Eq, Typeable, TH.Lift) firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day firstDayOfWeekCalendar wt dow year = let@@ -124,7 +122,7 @@ | Friday | Saturday | Sunday- deriving (Eq, Ord, Show, Read, Typeable, Data)+ deriving (Eq, Ord, Show, Read, Typeable, Data, Ix, TH.Lift, Generic) instance NFData DayOfWeek where rnf !_ = ()
src/Data/Time/Clock/Compat.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-} module Data.Time.Clock.Compat ( -- * Universal Time -- | Time as measured by the Earth.@@ -22,7 +23,7 @@ -- * UTC differences addUTCTime, diffUTCTime,- + -- * Current time getCurrentTime, getTime_resolution,@@ -38,6 +39,7 @@ import Data.Time.Clock import Data.Fixed (Pico)+import Debug.Trace #if !MIN_VERSION_time(1,9,1)
src/Data/Time/Clock/System/Compat.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} module Data.Time.Clock.System.Compat ( systemEpochDay, SystemTime(..),
src/Data/Time/Clock/TAI/Compat.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-} module Data.Time.Clock.TAI.Compat ( -- * TAI arithmetic AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime,
src/Data/Time/LocalTime/Compat.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} module Data.Time.LocalTime.Compat ( -- * Time zones TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc,@@ -35,6 +35,7 @@ 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 (..))@@ -42,6 +43,7 @@ import Data.Semigroup (Semigroup (..)) import Control.DeepSeq (NFData (..))+import GHC.Generics (Generic) ------------------------------------------------------------------------------- -- TimeOfDay@@ -92,6 +94,7 @@ } deriving (Eq, Data ,Typeable+ , Generic ) -- | Additive@@ -108,6 +111,7 @@ 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 @@ -118,6 +122,10 @@ 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
src/Data/Time/Orphans.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# 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@@ -29,8 +29,15 @@ 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@@ -52,6 +59,8 @@ 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)@@ -116,6 +125,78 @@ 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 -------------------------------------------------------------------------------
test-instances/Test.hs view
@@ -1,15 +1,26 @@+{-# 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 ()@@ -33,6 +44,188 @@ -- 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)@@ -92,7 +285,7 @@ ] where test :: NFData t => t -> ()- test = rnf + test = rnf _EnumInstances :: [()] _EnumInstances =
test/main/Main.hs view
@@ -1,18 +1,21 @@ module Main where -import Test.Types() import Test.Calendar.AddDays import Test.Calendar.CalendarProps import Test.Calendar.Calendars import Test.Calendar.ClipDates import Test.Calendar.ConvertBack+import Test.Calendar.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 ()@@ -23,28 +26,32 @@ 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- , testMonthDay- , testEaster- , testValid- , testWeek- , testDuration- ]- , testGroup "Clock" [testClockConversion, testResolutions, testTAI]- , testGroup "Format" [testFormat, {- testParseTime, -} testISO8601]- , testGroup "LocalTime" [testTime, testTimeOfDay, testCalendarDiffTime]+ "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 ()
test/main/Test/Arbitrary.hs view
@@ -6,10 +6,11 @@ import Data.Fixed import Data.Ratio import Data.Time.Compat-import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat+import Data.Time.Calendar.WeekDate.Compat import Data.Time.Clock.POSIX.Compat+import System.Random import Test.Tasty.QuickCheck hiding (reason) instance Arbitrary DayOfWeek where@@ -31,25 +32,33 @@ 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 = liftM ModifiedJulianDay $ choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31- shrink day = let- (y, m, d) = toGregorian day- dayShrink =- if d > 1- then [fromGregorian y m (d - 1)]- else []- monthShrink =- if m > 1- then [fromGregorian y (m - 1) d]- else []- yearShrink =- if y > 2000- then [fromGregorian (y - 1) m d]- else if y < 2000- then [fromGregorian (y + 1) m d]- else []- in dayShrink ++ monthShrink ++ yearShrink+ 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@@ -90,28 +99,32 @@ 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+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+ 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]+ 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)
test/main/Test/Calendar/AddDays.hs view
@@ -1,8 +1,8 @@-module Test.Calendar.AddDays- ( addDaysTest- ) where+module Test.Calendar.AddDays (+ addDaysTest,+) where -import Data.Time.Calendar+import Data.Time.Calendar.Compat import Test.Calendar.AddDaysRef import Test.Tasty import Test.Tasty.HUnit@@ -36,8 +36,14 @@ increment <- increments day <- days return- ((showGregorian day) ++- " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day))+ ( (showGregorian day)+ ++ " + "+ ++ (show increment)+ ++ " * "+ ++ aname+ ++ " = "+ ++ showGregorian (adder increment day)+ ) addDaysTest :: TestTree addDaysTest = testCase "addDays" $ assertEqual "" addDaysRef $ unlines resultDays
test/main/Test/Calendar/CalendarProps.hs view
@@ -1,13 +1,12 @@-{-# LANGUAGE CPP #-}-module Test.Calendar.CalendarProps- ( testCalendarProps- ) where+module Test.Calendar.CalendarProps (+ testCalendarProps,+) where import Data.Time.Calendar.Month.Compat import Data.Time.Calendar.Quarter.Compat-import Test.TestUtil-import Test.Tasty import Test.Arbitrary ()+import Test.Tasty+import Test.TestUtil testYearMonth :: TestTree testYearMonth = nameTest "YearMonth" $ \m -> case m of@@ -22,4 +21,4 @@ YearQuarter y qy -> q == YearQuarter y qy testCalendarProps :: TestTree-testCalendarProps = nameTest "calender-props" [testYearMonth,testMonthDay,testYearQuarter]+testCalendarProps = nameTest "calender-props" [testYearMonth, testMonthDay, testYearQuarter]
test/main/Test/Calendar/Calendars.hs view
@@ -1,10 +1,10 @@-module Test.Calendar.Calendars- ( testCalendars- ) where+module Test.Calendar.Calendars (+ testCalendars,+) where -import Data.Time.Calendar-import Data.Time.Calendar.Julian-import Data.Time.Calendar.WeekDate+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
test/main/Test/Calendar/ClipDates.hs view
@@ -1,10 +1,10 @@-module Test.Calendar.ClipDates- ( clipDates- ) where+module Test.Calendar.ClipDates (+ clipDates,+) where -import Data.Time.Calendar-import Data.Time.Calendar.OrdinalDate-import Data.Time.Calendar.WeekDate+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@@ -20,24 +20,28 @@ -- tupleUp2 :: [a] -> [b] -> [(a, b)]-tupleUp2 l1 l2 = concatMap (\e -> map (e, ) l2) l1+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+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+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 $+ 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] ]
test/main/Test/Calendar/ClipDatesRef.hs view
@@ -2,570 +2,570 @@ 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"- ]+ [ "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"+ ]
test/main/Test/Calendar/ConvertBack.hs view
@@ -1,28 +1,30 @@-module Test.Calendar.ConvertBack- ( convertBack- ) where+module Test.Calendar.ConvertBack (+ convertBack,+) where -import Data.Time.Calendar-import Data.Time.Calendar.Julian-import Data.Time.Calendar.OrdinalDate-import Data.Time.Calendar.WeekDate+import 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+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 =
+ test/main/Test/Calendar/DayPeriod.hs view
@@ -0,0 +1,181 @@+module 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+ ]
test/main/Test/Calendar/Duration.hs view
@@ -1,6 +1,6 @@-module Test.Calendar.Duration- ( testDuration- ) where+module Test.Calendar.Duration (+ testDuration,+) where import Data.Time.Calendar.Compat import Data.Time.Calendar.Julian.Compat@@ -9,38 +9,106 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) -testAddDiff :: TestTree-testAddDiff =+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"- [ testProperty "add diff GregorianDurationClip" $ \day1 day2 ->- addGregorianDurationClip (diffGregorianDurationClip day2 day1) day1 == day2- , testProperty "add diff GregorianDurationRollOver" $ \day1 day2 ->- addGregorianDurationRollOver (diffGregorianDurationRollOver day2 day1) day1 == day2- , testProperty "add diff JulianDurationClip" $ \day1 day2 ->- addJulianDurationClip (diffJulianDurationClip day2 day1) day1 == day2- , testProperty "add diff JulianDurationRollOver" $ \day1 day2 ->- addJulianDurationRollOver (diffJulianDurationRollOver day2 day1) day1 == day2- ]+ "add-diff"+ $ fmap testAddDiff addDiffs -testClip :: (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree-testClip (y1, m1, d1) (y2, m2, d2) (em, ed) = let- day1 = fromGregorian y1 m1 d1- day2 = fromGregorian y2 m2 d2- expected = CalendarDiffDays em ed- found = diffGregorianDurationClip day1 day2- in testCase (show day1 ++ " - " ++ show day2) $ assertEqual "" expected found+newtype Smallish = MkSmallish Integer deriving (Eq, Ord) -testDiffs :: TestTree-testDiffs =+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- "diffs"- [ testClip (2017, 04, 07) (2017, 04, 07) (0, 0)- , testClip (2017, 04, 07) (2017, 04, 01) (0, 6)- , testClip (2017, 04, 01) (2017, 04, 07) (0, -6)- , testClip (2017, 04, 07) (2017, 02, 01) (2, 6)- , testClip (2017, 02, 01) (2017, 04, 07) (-2, -6)+ "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" [testAddDiff, testDiffs]+testDuration = testGroup "CalendarDiffDays" [testAddDiffs, testPositiveDiffs, testSpecifics]
test/main/Test/Calendar/Easter.hs view
@@ -1,11 +1,10 @@-module Test.Calendar.Easter- ( testEaster- ) where+module 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@@ -19,20 +18,22 @@ 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]+ 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]
test/main/Test/Calendar/LongWeekYears.hs view
@@ -1,9 +1,9 @@-module Test.Calendar.LongWeekYears- ( longWeekYears- ) where+module Test.Calendar.LongWeekYears (+ longWeekYears,+) where -import Data.Time.Calendar-import Data.Time.Calendar.WeekDate+import Data.Time.Calendar.Compat+import Data.Time.Calendar.WeekDate.Compat import Test.Calendar.LongWeekYearsRef import Test.Tasty import Test.Tasty.HUnit@@ -18,12 +18,14 @@ showLongYear year = unwords [ show year ++ ":"- , (if isLeapYear year- then "L"- else " ") ++- (if longYear year- then "*"- else " ")+ , ( if isLeapYear year+ then "L"+ else " "+ )+ ++ ( if longYear year+ then "*"+ else " "+ ) ] longWeekYears :: TestTree
test/main/Test/Calendar/MonthDay.hs view
@@ -1,8 +1,8 @@-module Test.Calendar.MonthDay- ( testMonthDay- ) where+module Test.Calendar.MonthDay (+ testMonthDay,+) where -import Data.Time.Calendar.MonthDay+import Data.Time.Calendar.MonthDay.Compat import Test.Calendar.MonthDayRef import Test.Tasty import Test.Tasty.HUnit@@ -15,7 +15,9 @@ testMonthDay :: TestTree testMonthDay = testCase "testMonthDay" $- assertEqual "" testMonthDayRef $ concat $ map (\isL -> unlines (leap isL : yearDays isL)) [False, True]+ assertEqual "" testMonthDayRef $+ concat $+ map (\isL -> unlines (leap isL : yearDays isL)) [False, True] where leap isLeap = if isLeap@@ -23,9 +25,12 @@ 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')+ ( \yd ->+ let+ (m, d) = dayOfYearToMonthAndDay isLeap yd+ yd' = monthAndDayToDayOfYear isLeap m d+ mdtext = show m ++ "-" ++ show d+ in+ showCompare yd mdtext yd'+ ) [-2 .. 369]
+ test/main/Test/Calendar/MonthOfYear.hs view
@@ -0,0 +1,26 @@+module 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
test/main/Test/Calendar/Valid.hs view
@@ -1,6 +1,6 @@-module Test.Calendar.Valid- ( testValid- ) where+module Test.Calendar.Valid (+ testValid,+) where import Data.Time.Compat import Data.Time.Calendar.Julian.Compat@@ -11,39 +11,47 @@ 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+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+ (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@@ -52,54 +60,58 @@ ] toSundayStartWeek :: Day -> (Integer, Int, Int)-toSundayStartWeek day = let- (y, _) = toOrdinalDate day- (w, d) = sundayStartWeek day- in (y, w, d)+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)+toMondayStartWeek day =+ let+ (y, _) = toOrdinalDate day+ (w, d) = mondayStartWeek day+ in+ (y, w, d) -newtype WYear =- MkWYear Year+newtype WYear+ = MkWYear Year deriving (Eq, Show) instance Arbitrary WYear where arbitrary = fmap MkWYear $ choose (-1000, 3000) -newtype WMonthOfYear =- MkWMonthOfYear MonthOfYear+newtype WMonthOfYear+ = MkWMonthOfYear MonthOfYear deriving (Eq, Show) instance Arbitrary WMonthOfYear where arbitrary = fmap MkWMonthOfYear $ choose (-5, 17) -newtype WDayOfMonth =- MkWDayOfMonth DayOfMonth+newtype WDayOfMonth+ = MkWDayOfMonth DayOfMonth deriving (Eq, Show) instance Arbitrary WDayOfMonth where arbitrary = fmap MkWDayOfMonth $ choose (-5, 35) -newtype WDayOfYear =- MkWDayOfYear DayOfYear+newtype WDayOfYear+ = MkWDayOfYear DayOfYear deriving (Eq, Show) instance Arbitrary WDayOfYear where arbitrary = fmap MkWDayOfYear $ choose (-20, 400) -newtype WWeekOfYear =- MkWWeekOfYear WeekOfYear+newtype WWeekOfYear+ = MkWWeekOfYear WeekOfYear deriving (Eq, Show) instance Arbitrary WWeekOfYear where arbitrary = fmap MkWWeekOfYear $ choose (-5, 60) -newtype WDayOfWeek =- MkWDayOfWeek Int+newtype WDayOfWeek+ = MkWDayOfWeek Int deriving (Eq, Show) instance Arbitrary WDayOfWeek where@@ -119,34 +131,34 @@ testGroup "testValid" [ validTest- "Gregorian"- fromYMD- toGregorian- (\(y, m, d) -> fromGregorian y m d)- (\(y, m, d) -> fromGregorianValid y m d)+ "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)+ "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)+ "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)+ "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)+ "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) ]
test/main/Test/Calendar/Week.hs view
@@ -1,19 +1,20 @@-module Test.Calendar.Week- ( testWeek- ) where+module Test.Calendar.Week (+ testWeek,+) where import Data.Time.Calendar.Compat import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.WeekDate.Compat-import Test.TestUtil+import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit-import Test.Arbitrary ()+import Test.TestUtil testDay :: TestTree testDay = nameTest "day" $ do- let day = fromGregorian 2018 1 9+ let+ day = fromGregorian 2018 1 9 assertEqual "" (ModifiedJulianDay 58127) day assertEqual "" (2018, 2, 2) $ toWeekDate day assertEqual "" Tuesday $ dayOfWeek day@@ -37,56 +38,56 @@ [ 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]+ 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 ..]+ 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 ..]+ 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]+ 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]+ assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday, Saturday .. Tuesday] ] testReadShow :: TestTree@@ -99,40 +100,149 @@ 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_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_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_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+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+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]+testWeek =+ nameTest+ "Week"+ [ testDay+ , testSucc+ , testPred+ , testSequences+ , testReadShow+ , testDiff+ , testWeekDays+ ]
+ test/main/Test/Calendar/Year.hs view
@@ -0,0 +1,29 @@+module 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+ ]
test/main/Test/Clock/Conversion.hs view
@@ -1,6 +1,6 @@-module Test.Clock.Conversion- ( testClockConversion- ) where+module Test.Clock.Conversion (+ testClockConversion,+) where import Data.Time.Clock.Compat import Data.Time.Clock.System.Compat@@ -9,17 +9,19 @@ 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+ 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) ]- 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)- ]
+ test/main/Test/Clock/Lift.hs view
@@ -0,0 +1,18 @@+{-# 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+ ]
test/main/Test/Clock/Resolution.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE CPP #-}-module Test.Clock.Resolution- ( testResolutions- ) where+module Test.Clock.Resolution (+ testResolutions,+) where import Control.Concurrent import Data.Fixed@@ -34,32 +33,33 @@ getTime times1 <- repeatN 100 $ -- 100us- do- threadDelay 1 -- 1us- getTime+ do+ threadDelay 1 -- 1us+ getTime times2 <- repeatN 100 $ -- 1ms- do- threadDelay 10 -- 10us- getTime+ do+ threadDelay 10 -- 10us+ getTime times3 <- repeatN 100 $ -- 10ms- do- threadDelay 100 -- 100us- getTime+ 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+ do+ threadDelay 1000 -- 1ms+ getTime+ let+ times = fmap (\t -> timeDiff t t0) $ times0 ++ times1 ++ times2 ++ times3 ++ times4 foundGrid = gcdAll times- assertBool ("resolution " ++ show (reportedRes, foundGrid)) (foundGrid <= reportedRes)+ 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 -> []+ [testResolution "getCurrentTime" diffUTCTime (realToFrac getTime_resolution, getCurrentTime)]+ ++ case taiClock of+ Just clock -> [testResolution "taiClock" diffAbsoluteTime clock]+ Nothing -> []
test/main/Test/Clock/TAI.hs view
@@ -1,6 +1,6 @@-module Test.Clock.TAI- ( testTAI- ) where+module Test.Clock.TAI (+ testTAI,+) where import Data.Time.Compat import Data.Time.Clock.TAI.Compat@@ -19,40 +19,42 @@ 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- ]- ]+ testGroup "leap second transition" $+ let+ dayA = fromGregorian 1972 6 30+ dayB = fromGregorian 1972 7 1+ utcTime1 = UTCTime dayA 86399+ utcTime2 = UTCTime dayA 86400+ utcTime3 = UTCTime dayB 0+ mAbsTime1 = utcToTAITime sampleLeapSecondMap utcTime1+ mAbsTime2 = utcToTAITime sampleLeapSecondMap utcTime2+ mAbsTime3 = utcToTAITime sampleLeapSecondMap utcTime3+ in+ [ testCase "mapping" $ do+ assertEqual "dayA" (Just 10) $ sampleLeapSecondMap dayA+ assertEqual "dayB" (Just 11) $ sampleLeapSecondMap dayB+ , testCase "day length" $ do+ assertEqual "dayA" (Just 86401) $ utcDayLength sampleLeapSecondMap dayA+ assertEqual "dayB" (Just 86400) $ utcDayLength sampleLeapSecondMap dayB+ , testCase "differences" $ do+ absTime1 <- assertJust mAbsTime1+ absTime2 <- assertJust mAbsTime2+ absTime3 <- assertJust mAbsTime3+ assertEqual "absTime2 - absTime1" 1 $ diffAbsoluteTime absTime2 absTime1+ assertEqual "absTime3 - absTime2" 1 $ diffAbsoluteTime absTime3 absTime2+ , testGroup+ "round-trip"+ [ testCase "1" $ do+ absTime <- assertJust mAbsTime1+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime1 utcTime+ , testCase "2" $ do+ absTime <- assertJust mAbsTime2+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime2 utcTime+ , testCase "3" $ do+ absTime <- assertJust mAbsTime3+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime+ assertEqual "round-trip" utcTime3 utcTime+ ]+ ]
test/main/Test/Format/Compile.hs view
@@ -1,18 +1,18 @@ -- Tests succeed if module compiles {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Test.Format.Compile- (- ) where+module Test.Format.Compile ( --- Doesn't work with old time--- --- import Data.Time.Compat--- --- newtype WrappedUTCTime =--- MkWrappedUTCTime UTCTime--- deriving (FormatTime, ParseTime)--- --- newtype Wrapped t =--- MkWrapped t--- deriving (FormatTime, ParseTime)+) where++{-+import Data.Time.Compat++newtype WrappedUTCTime+ = MkWrappedUTCTime UTCTime+ deriving (FormatTime, ParseTime)++newtype Wrapped t+ = MkWrapped t+ deriving (FormatTime, ParseTime)+-}
test/main/Test/Format/Format.hs view
@@ -1,6 +1,6 @@-module Test.Format.Format- ( testFormat- ) where+module Test.Format.Format (+ testFormat,+) where import Data.Proxy import Data.Time.Compat@@ -25,12 +25,13 @@ 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)+ ["%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"]@@ -61,11 +62,13 @@ 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+ 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 =@@ -118,17 +121,17 @@ , 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)+ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime) , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $- (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)+ (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)+ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime) , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $- (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime)+ (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)+ (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime) , testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $- (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)+ (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)@@ -148,15 +151,15 @@ , 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)+ (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)+ (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)+ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime) , testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $- (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)+ (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)@@ -188,26 +191,34 @@ [ 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+ CalendarDiffTime 64 $+ 23 * 86400 + 8528.21 , testAFormat "%bm %dd %hh %mm %Ess" "64m 23d 554h 33262m 1995728.21s" $- CalendarDiffTime 64 $ 23 * 86400 + 8528.21+ 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+ 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+ 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+ CalendarDiffTime (-64) $+ negate $+ 23 * 86400 + 8528.21 ] -} testFormat :: TestTree testFormat = testGroup "testFormat" $- [ -- testCheckParse- testDayOfWeek--- , testTimeZone- , testNominalDiffTime- , testDiffTime- , testCalenderDiffDays- , testCalenderDiffTime- ]+ [ testCheckParse+ , testDayOfWeek+ , testTimeZone+ , testNominalDiffTime+ , testDiffTime+ , testCalenderDiffDays+ , testCalenderDiffTime+ ]
test/main/Test/Format/ISO8601.hs view
@@ -1,12 +1,14 @@ {-# OPTIONS -fno-warn-orphans #-} -module Test.Format.ISO8601- ( testISO8601- ) where+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@@ -16,27 +18,49 @@ deriving instance Eq ZonedTime -readShowProperty :: (Eq a, Show a) => Format a -> a -> Property-readShowProperty fmt val =+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)}+ 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] -readShowProperties :: (Eq a, Show a, Arbitrary a) => (FormatExtension -> Format a) -> [TestTree]-readShowProperties fmts = readBoth $ \fe -> readShowProperty $ fmts fe+readShowTestsCheck :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (a -> Bool) -> (FormatExtension -> Format a) -> [TestTree]+readShowTestsCheck skip fmts = readBoth $ \fe -> readShowTestCheck skip $ fmts fe -newtype Durational t =- MkDurational t+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 @@ -47,201 +71,264 @@ 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+ 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" $ readShowProperties $ calendarFormat- , nameTest "yearMonthFormat" $ readShowProperty $ yearMonthFormat- , nameTest "yearFormat" $ readShowProperty $ yearFormat- , nameTest "centuryFormat" $ readShowProperty $ centuryFormat- , nameTest "expandedCalendarFormat" $ readShowProperties $ expandedCalendarFormat 6- , nameTest "expandedYearMonthFormat" $ readShowProperty $ expandedYearMonthFormat 6- , nameTest "expandedYearFormat" $ readShowProperty $ expandedYearFormat 6- , nameTest "expandedCenturyFormat" $ readShowProperty $ expandedCenturyFormat 4- , nameTest "ordinalDateFormat" $ readShowProperties $ ordinalDateFormat- , nameTest "expandedOrdinalDateFormat" $ readShowProperties $ expandedOrdinalDateFormat 6- , nameTest "weekDateFormat" $ readShowProperties $ weekDateFormat- , nameTest "yearWeekFormat" $ readShowProperties $ yearWeekFormat- , nameTest "expandedWeekDateFormat" $ readShowProperties $ expandedWeekDateFormat 6- , nameTest "expandedYearWeekFormat" $ readShowProperties $ expandedYearWeekFormat 6- , nameTest "timeOfDayFormat" $ readShowProperties $ timeOfDayFormat- -- https://github.com/haskellari/time-compat/issues/23- -- , nameTest "hourMinuteFormat" $ readShowProperties $ hourMinuteFormat- -- , nameTest "hourFormat" $ readShowProperty $ hourFormat- , nameTest "withTimeDesignator" $ readShowProperties $ \fe -> withTimeDesignator $ timeOfDayFormat fe- , nameTest "withUTCDesignator" $ readShowProperties $ \fe -> withUTCDesignator $ timeOfDayFormat fe- , nameTest "timeOffsetFormat" $ readShowProperties $ timeOffsetFormat- , nameTest "timeOfDayAndOffsetFormat" $ readShowProperties $ timeOfDayAndOffsetFormat+ []+ [ nameTest "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" $- readShowProperties $ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)+ readShowTests $+ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe) , nameTest "zonedTimeFormat" $- readShowProperties $ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe- , nameTest "utcTimeFormat" $ readShowProperties $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe)+ readShowTests $+ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe+ , nameTest "utcTimeFormat" $ readShowTests $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe) , nameTest "dayAndTimeFormat" $- readShowProperties $ \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe)- , nameTest "timeAndOffsetFormat" $ readShowProperties $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe- , nameTest "durationDaysFormat" $ readShowProperty $ durationDaysFormat- , nameTest "durationTimeFormat" $ readShowProperty $ durationTimeFormat+ 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 (MkDurational t) -> readShowProperty (alternativeDurationDaysFormat fe) t+ readBoth $+ \fe -> readShowTest (durationalFormat $ alternativeDurationDaysFormat fe) , nameTest "alternativeDurationTimeFormat" $- readBoth $ \fe (MkDurational t) -> readShowProperty (alternativeDurationTimeFormat fe) t+ readBoth $+ \fe -> readShowTest (durationalFormat $ alternativeDurationTimeFormat fe) , nameTest "intervalFormat" $- readShowProperties $ \fe ->- intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat+ readShowTests $ \fe ->+ intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat , nameTest "recurringIntervalFormat" $- readShowProperties $ \fe ->- recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat+ readShowTests $ \fe ->+ recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat ]+-} -testShowFormat :: String -> Format t -> String -> t -> TestTree-testShowFormat name fmt str t = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just str) $ formatShowM fmt t+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"- [ testShowFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0- , testShowFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0- , testShowFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0- , testShowFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5- , testShowFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81- , testShowFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0- , testShowFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0- , testShowFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0- , testShowFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay- , testShowFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay- , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200- , testShowFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180- , testShowFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12- , testShowFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634- , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634- , testShowFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $- CalendarDiffTime 0 $ 5 * nominalDay + 7278.77634- , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $- CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634- , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $- CalendarDiffTime 94 $ 7278.77634- , testShowFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634- , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $- CalendarDiffDays 12 0- , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $- CalendarDiffDays 27 29- , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $- CalendarDiffDays (561 * 12 + 8) 29- , testShowFormat- "alternativeDurationTimeFormat"- (alternativeDurationTimeFormat ExtendedFormat)- "P0000-00-01T00:00:00" $- CalendarDiffTime 0 86400- , testShowFormat- "alternativeDurationTimeFormat"- (alternativeDurationTimeFormat ExtendedFormat)- "P0007-10-05T02:01:18.77634" $- CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634- , testShowFormat- "alternativeDurationTimeFormat"- (alternativeDurationTimeFormat ExtendedFormat)- "P4271-10-05T02:01:18.77634" $- CalendarDiffTime (12 * 4271 + 10) $ 5 * nominalDay + 7278.77634- , testShowFormat "centuryFormat" centuryFormat "02" 2- , testShowFormat "centuryFormat" centuryFormat "21" 21- , testShowFormat- "intervalFormat etc."- (intervalFormat- (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))- durationTimeFormat)- "2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S"- ( LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)- , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34)- , testShowFormat- "recurringIntervalFormat etc."- (recurringIntervalFormat- (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))- durationTimeFormat)- "R74/2015-06-13T21:13:56/P1Y2M7DT5H33M2.34S"- ( 74- , LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)- , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34)- , testShowFormat- "recurringIntervalFormat etc."- (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat)- "R74/2015-06-13/P1Y2M7D"- (74, fromGregorian 2015 6 13, CalendarDiffDays 14 7)- , testShowFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390))- , testShowFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0)- , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0)- , testShowFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10)- , testShowFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10))- , testShowFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95)- , testShowFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95))- , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95)- , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95))- , testShowFormat- "timeOffsetFormat"- (timeOffsetFormat BasicFormat)- "-1100"- (minutesToTimeZone $ negate $ 11 * 60)- , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615)- , testShowFormat- "zonedTimeFormat"- iso8601Format- "2024-07-06T08:45:56.553-06:30"- (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-390)))- , testShowFormat- "zonedTimeFormat"- iso8601Format- "2024-07-06T08:45:56.553+06:30"- (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 390))- , testShowFormat- "utcTimeFormat"- iso8601Format- "2024-07-06T08:45:56.553Z"- (UTCTime (fromGregorian 2024 07 06) (timeOfDayToTime $ TimeOfDay 8 45 56.553))- , testShowFormat- "utcTimeFormat"- iso8601Format- "2028-12-31T23:59:60.9Z"- (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9))- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10)- , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10)- , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4)- , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4)- , testShowFormat- "weekDateFormat"- (expandedWeekDateFormat 6 ExtendedFormat)- "+001995-W05-6"- (fromGregorian 1995 2 4)- , testShowFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4)- , testShowFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23)- , testShowFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23)- , testShowFormat- "ordinalDateFormat"- (expandedOrdinalDateFormat 5 ExtendedFormat)- "+01846-235"- (fromGregorian 1846 8 23)- , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15)- , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24)- , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15)- , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24)- , testShowFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0)- , testShowFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0)- , testShowFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51)+ [ 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]
test/main/Test/Format/ParseTime.hs view
@@ -1,26 +1,25 @@ {-# OPTIONS -fno-warn-orphans #-} -module Test.Format.ParseTime- ( testParseTime- , test_parse_format- ) where+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.OrdinalDate.Compat-import Data.Time.Calendar.WeekDate.Compat import Data.Time.Calendar.Month.Compat+import Data.Time.Calendar.OrdinalDate.Compat import Data.Time.Calendar.Quarter.Compat-import Test.Arbitrary ()+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-import Text.Read format :: FormatTime t => String -> t -> String format f t = formatTime defaultTimeLocale f t@@ -40,15 +39,17 @@ } 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)+ 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@@ -65,22 +66,21 @@ minCodeWidth _ = 0 fcShrink :: FormatCode pf t -> [FormatCode pf t]-fcShrink fc = let- fc1 =- case fcWidth fc of+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+ | 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+ True -> [fc{fcAlt = False}]+ fc3 = case fcModifier fc of "" -> []- _ -> [fc {fcModifier = ""}]- in fc1 ++ fc2 ++ fc3+ _ -> [fc{fcModifier = ""}]+ in+ fc1 ++ fc2 ++ fc3 instance HasFormatCodes t => Arbitrary (FormatCode FormatOnly t) where arbitrary = do@@ -108,16 +108,19 @@ testParseTime = testGroup "testParseTime"- [ readOtherTypesTest- , readTests+ []+{-+ [ readsTests , simpleFormatTests , extests+ , spacingTests , particularParseTests , badParseTests , defaultTimeZoneTests , militaryTimeZoneTests , propertyTests ]+-} yearDays :: Integer -> [Day] yearDays y = [(fromGregorian y 1 1) .. (fromGregorian y 12 31)]@@ -129,69 +132,71 @@ 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)]))+ ( [ makeExhaustiveTest "parse %y" [0 .. 99] parseYY+ , makeExhaustiveTest "parse %-C %y 1900s" [0, 1, 50, 99] (parseCYY 19)+ , makeExhaustiveTest "parse %-C %y 2000s" [0, 1, 50, 99] (parseCYY 20)+ , makeExhaustiveTest "parse %-C %y 1400s" [0, 1, 50, 99] (parseCYY 14)+ , makeExhaustiveTest "parse %C %y 0700s" [0, 1, 50, 99] (parseCYY2 7)+ , makeExhaustiveTest "parse %-C %y 700s" [0, 1, 50, 99] (parseCYY 7)+ , makeExhaustiveTest "parse %-C %y -700s" [0, 1, 50, 99] (parseCYY (-7))+ , makeExhaustiveTest "parse %-C %y -70000s" [0, 1, 50, 99] (parseCYY (-70000))+ , makeExhaustiveTest "parse %-C %y 10000s" [0, 1, 50, 99] (parseCYY 100)+ , makeExhaustiveTest "parse %-C centuries" [20 .. 100] (parseCentury " ")+ , makeExhaustiveTest "parse %-C century X" [1, 10, 20, 100] (parseCentury "X")+ , makeExhaustiveTest "parse %-C century 2sp" [1, 10, 20, 100] (parseCentury " ")+ , makeExhaustiveTest "parse %-C century 5sp" [1, 10, 20, 100] (parseCentury " ")+ ]+ ++ ( concat $+ fmap+ ( \y ->+ [ {- (makeExhaustiveTest "parse %Y%m%d" (yearDays y) parseYMD)+ , -} (makeExhaustiveTest "parse %Y %m %d" (yearDays y) parseYearDayD)+ , (makeExhaustiveTest "parse %Y %-m %e" (yearDays y) parseYearDayE)+ ]+ )+ [1, 4, 20, 753, 2000, 2011, 10001, (-1166)]+ )+ ) -readTest :: (Eq a, Show a, Read a) => [(a, String)] -> String -> TestTree-readTest expected target = let- found = reads target- result = assertEqual "" expected found- name = show target- in Test.Tasty.HUnit.testCase name result+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 -readTestsParensSpaces ::- forall a. (Eq a, Show a, Read a)- => a- -> String- -> TestTree-readTestsParensSpaces expected target =+readsTestsParensSpaces ::+ forall a.+ (Eq a, Show a, Read a) =>+ a ->+ String ->+ TestTree+readsTestsParensSpaces expected target = testGroup target- [ readTest [(expected, "")] $ target- , readTest [(expected, "")] $ "(" ++ target ++ ")"- , readTest [(expected, "")] $ " (" ++ target ++ ")"- , readTest [(expected, " ")] $ " ( " ++ target ++ " ) "- , readTest [(expected, " ")] $ " (( " ++ target ++ " )) "- , readTest ([] :: [(a, String)]) $ "(" ++ target- , readTest [(expected, ")")] $ "" ++ target ++ ")"- , readTest [(expected, "")] $ "((" ++ target ++ "))"- , readTest [(expected, " ")] $ " ( ( " ++ target ++ " ) ) "+ [ 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 ++ " ) ) " ]- where --readOtherTypesTest :: TestTree-readOtherTypesTest =- testGroup "read other types" [readTestsParensSpaces (3 :: Integer) "3", readTestsParensSpaces "a" "\"a\""]--readTests :: TestTree-readTests =+readsTests :: TestTree+readsTests = testGroup- "read times"- [ readTestsParensSpaces testDay "1912-07-08"- --readTestsParensSpaces testDay "1912-7-8",- , readTestsParensSpaces testTimeOfDay "08:04:02"- --,readTestsParensSpaces testTimeOfDay "8:4:2"+ "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@@ -200,43 +205,45 @@ 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"- [ readsTest [(epoch, "")] "" ""- , readsTest [(epoch, " ")] "" " "- , readsTest [(epoch, "")] " " " "- , readsTest [(epoch, "")] " " " "- , readsTest [(epoch, "")] "%k" "0"- , readsTest [(epoch, "")] "%k" " 0"- , readsTest [(epoch, "")] "%m" "01"- , readsTest [(epoch, " ")] "%m" "01 "- , readsTest [(epoch, " ")] " %m" " 01 "- , readsTest [(epoch, "")] " %m" " 01"- -- https://ghc.haskell.org/trac/ghc/ticket/9150- , readsTest [(epoch, "")] " %M" " 00"- , readsTest [(epoch, "")] "%M " "00 "- , readsTest [(epoch, "")] "%Q" ""- , readsTest [(epoch, " ")] "%Q" " "- , readsTest [(epoch, "X")] "%Q" "X"- , readsTest [(epoch, " X")] "%Q" " X"- , readsTest [(epoch, "")] "%Q " " "- , readsTest [(epoch, "")] "%Q X" " X"- , readsTest [(epoch, "")] "%QX" "X"+ [ 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" ]- where- readsTest :: (Show a, Eq a, ParseTime a) => [(a, String)] -> String -> String -> TestTree- readsTest expected formatStr target = let- found = readSTime False defaultTimeLocale formatStr target- result = assertEqual "" expected found- name = (show formatStr) ++ " of " ++ (show target)- in Test.Tasty.HUnit.testCase name result -spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree-spacingTests expected formatStr target =+spacingForFormatTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree+spacingForFormatTests expected formatStr target = testGroup- "particular"+ formatStr [ parseTest False (Just expected) formatStr target , parseTest True (Just expected) formatStr target , parseTest False (Just expected) (formatStr ++ " ") (target ++ " ")@@ -247,42 +254,48 @@ , 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"- [ spacingTests epoch "%Q" ""- , spacingTests epoch "%Q" ".0"- , spacingTests epoch "%k" " 0"- , spacingTests epoch "%M" "00"- , spacingTests epoch "%m" "01"- , spacingTests (TimeZone 120 False "") "%z" "+0200"- , spacingTests (TimeZone 120 False "") "%Z" "+0200"- , spacingTests (TimeZone (-480) False "PST") "%Z" "PST"+ [ 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))+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))+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))+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 | i >= 69 = 1900 + i expectedYear i = 2000 + i show2 :: (Show n, Integral n) => n -> String@@ -301,33 +314,29 @@ parseCentury int c = parseTest False (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00") -parseTest :: (Show t, Eq t, ParseTime t) => Bool -> Maybe t -> String -> String -> TestTree-parseTest sp expected formatStr target = let- found = parse sp formatStr target- result = assertEqual "" expected found- name =- (show formatStr) ++- " of " ++- (show target) ++- (if sp- then " allowing spaces"- else "")- in Test.Tasty.HUnit.testCase name result+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 -{--readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> TestTree-readsTest (Just e) = readsTest' [(e,"")]-readsTest Nothing = readsTest' ([] :: [(t,String)])--}-enumAdd :: (Enum a) => Int -> a -> a+enumAdd :: 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 | h < 0 = enumAdd (negate h) 'M'+getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A' getMilZoneLetter h = enumAdd (h - 10) 'K' getMilZone :: Int -> TimeZone@@ -337,7 +346,7 @@ testParseTimeZone tz = parseTest False (Just tz) "%Z" (timeZoneName tz) defaultTimeZoneTests :: TestTree-defaultTimeZoneTests = testGroup "default time zones" [] -- (fmap testParseTimeZone (knownTimeZones defaultTimeLocale))+defaultTimeZoneTests = testGroup "default time zones" (fmap testParseTimeZone (knownTimeZones defaultTimeLocale)) militaryTimeZoneTests :: TestTree militaryTimeZoneTests = testGroup "military time zones" (fmap (testParseTimeZone . getMilZone) [-12 .. 12])@@ -349,41 +358,56 @@ 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}+ | 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+ 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)+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 (Just t) (readMaybe (show t))+prop_read_show t = compareResult (reads_expect t) (reads (show t)) prop_read_show_ZonedUTC :: ZonedTime -> Result-prop_read_show_ZonedUTC t = compareResult (Just $ zonedTimeToUTC t) (readMaybe (show t))+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 (Just $ localTimeToUTC utc t) (readMaybe (show t))+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)@@ -395,19 +419,25 @@ 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_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)+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@@ -431,18 +461,21 @@ -- 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+ 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"]@@ -458,8 +491,9 @@ instance HasFormatCodes ZonedTime where allFormatCodes _ =- [(False, s) | s <- "cs"] ++- allFormatCodes (Proxy :: Proxy LocalTime) ++ allFormatCodes (Proxy :: Proxy TimeZone)+ [(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)@@ -469,10 +503,12 @@ allFormatCodes _ = allFormatCodes (Proxy :: Proxy LocalTime) --+ -- * crashes in parse+ ---newtype Input =- Input String+newtype Input+ = Input String instance Show Input where show (Input s) = s@@ -489,15 +525,15 @@ 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+ case parse False f s of+ Nothing -> True+ Just t -> t == t `asTypeOf` formatType fs -- -- ---newtype FormatString a =- FormatString String+newtype FormatString a+ = FormatString String formatType :: FormatString t -> t formatType _ = undefined@@ -514,10 +550,10 @@ , nameTest "TimeZone" $ tgroup timeZoneFormats prop , nameTest "ZonedTime" $ tgroup zonedTimeFormats prop , nameTest "ZonedTime" $- tgroup zonedTimeAlmostFormats $ \fmt t -> (todSec $ localTimeOfDay $ zonedTimeToLocalTime t) < 60 ==> prop fmt t+ tgroup zonedTimeAlmostFormats $+ \fmt t -> (todSec $ localTimeOfDay $ zonedTimeToLocalTime t) < 60 ==> prop fmt t , nameTest "UTCTime" $ tgroup utcTimeAlmostFormats $ \fmt t -> utctDayTime t < 86400 ==> prop fmt t , nameTest "UniversalTime" $ tgroup universalTimeFormats prop- -- time-compat doesn't have instances -- , nameTest "CalendarDiffDays" $ tgroup calendarDiffDaysFormats prop -- , nameTest "CalenderDiffTime" $ tgroup calendarDiffTimeFormats prop -- , nameTest "DiffTime" $ tgroup diffTimeFormats prop@@ -525,8 +561,8 @@ ] allTypes ::- (forall t. (Eq t, Show t, Arbitrary t, FormatTime t, ParseTime t, HasFormatCodes t) => String -> Proxy t -> r)- -> [r]+ (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)@@ -538,30 +574,32 @@ ] 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+ (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- ]+ [ f "TimeOfDay" lsTimeOfDay+ , f "LocalTime" lsLocalTime+ , f "ZonedTime" lsZonedTime+ , f "UTCTime" lsUTCTime+ ] parseEmptyTest ::- forall t. ParseTime t- => Proxy t- -> Assertion+ forall t.+ ParseTime t =>+ Proxy t ->+ Assertion parseEmptyTest _ = case parse False "" "" :: Maybe t of Just _ -> return ()@@ -571,12 +609,19 @@ parseEmptyTests = nameTest "parse empty" $ allTypes $ \name p -> nameTest name $ parseEmptyTest p formatParseFormatTests :: TestTree-formatParseFormatTests = nameTest "format_parse_format"- [- localOption (QuickCheckTests 50000) $- nameTest "general" $ allTypes $ \name p -> nameTest name $ prop_format_parse_format p,- nameTest "leapsecond" $ allLeapSecondTypes $ \name t -> nameTest name $ \fc -> prop_format_parse_format Proxy fc t- ]+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 =@@ -587,10 +632,10 @@ , 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+ 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+ tgroup (universalTimeFormats ++ partialUniversalTimeFormats) prop_no_crash_bad_input ] readShowTests :: TestTree@@ -608,11 +653,12 @@ , 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)+ -- , nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result)+ -- , nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> Result) ] parseShowTests :: TestTree@@ -627,24 +673,25 @@ 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- ]+ 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+ map+ FormatString+ -- numeric year, month, day [ "%Y-%m-%d" , "%Y%m%d" , "%C%y%m%d"@@ -654,18 +701,18 @@ , "%Y/%d/%m" , "%D %C" , "%F"- -- month names- , "%Y-%B-%d"+ , -- 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"+ , -- ordinal dates+ "%Y-%j" , "%C-%y-%j"- -- ISO week dates- , "%G-%V-%u"+ , -- ISO week dates+ "%G-%V-%u" , "%G-%V-%a" , "%G-%V-%A" , "%G-%V-%w"@@ -679,8 +726,8 @@ , "%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"+ , -- monday and sunday week dates+ "%Y-w%U-%A" , "%Y-w%W-%A" , "%Y-%A-w%U" , "%Y-%A-w%W"@@ -690,8 +737,9 @@ monthFormats :: [FormatString Month] monthFormats =- map FormatString- -- numeric year, month+ map+ FormatString+ -- numeric year, month [ "%Y-%m" , "%Y%m" , "%C%y%m"@@ -700,8 +748,8 @@ , "%m/%Y" , "%Y/%m" , "%C %y %m"- -- month names- , "%Y-%B"+ , -- month names+ "%Y-%B" , "%Y-%b" , "%Y-%h" , "%C-%y-%B"@@ -711,8 +759,9 @@ timeOfDayFormats :: [FormatString TimeOfDay] timeOfDayFormats =- map FormatString- -- 24 h formats+ map+ FormatString+ -- 24 h formats [ "%H:%M:%S.%q" , "%k:%M:%S.%q" , "%H%M%S.%q"@@ -725,8 +774,8 @@ , "%T%Q" , "%X%Q" , "%R:%S%Q"- -- 12 h formats- , "%I:%M:%S.%q %p"+ , -- 12 h formats+ "%I:%M:%S.%q %p" , "%I:%M:%S.%q %P" , "%l:%M:%S.%q %p" , "%r %q"@@ -744,7 +793,8 @@ zonedTimeFormats :: [FormatString ZonedTime] zonedTimeFormats =- map FormatString+ 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"@@ -765,7 +815,8 @@ calendarDiffTimeFormats :: [FormatString CalendarDiffTime] calendarDiffTimeFormats =- map FormatString+ map+ FormatString [ "%yy%Bm%ww%Dd%Hh%Mm%ESs" , "%bm%ww%Dd%Hh%Mm%ESs" , "%bm%dd%Hh%Mm%ESs"@@ -785,7 +836,9 @@ 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 []@@ -798,21 +851,23 @@ partialZonedTimeFormats :: [FormatString ZonedTime] partialZonedTimeFormats =- map FormatString- -- %s does not include second decimals+ map+ FormatString+ -- %s does not include second decimals [ "%s %z"- -- %S does not include second decimals- , "%c"+ , -- %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+ map+ FormatString+ -- %s does not include second decimals [ "%s"- -- %c does not include second decimals- , "%c"+ , -- %c does not include second decimals+ "%c" ] partialUniversalTimeFormats :: [FormatString UniversalTime]@@ -820,8 +875,9 @@ 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.+ 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"]
test/main/Test/LocalTime/CalendarDiffTime.hs view
@@ -1,17 +1,36 @@-module Test.LocalTime.CalendarDiffTime- ( testCalendarDiffTime- ) where+module Test.LocalTime.CalendarDiffTime (+ testCalendarDiffTime,+) where ---import Data.Time.LocalTime+import Data.Time.Compat import Test.Arbitrary () import Test.Tasty+import Test.Tasty.HUnit+import Test.TestUtil ---import Test.Tasty.QuickCheck hiding (reason)---testReadShow :: TestTree---testReadShow = testProperty "read . show" $ \(t :: CalendarDiffTime) -> read (show t) == t+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+testCalendarDiffTime = testGroup "CalendarDiffTime" []+{-+ nameTest "CalendarDiffTime"- --testReadShow- []+ [ 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+ ]+-}
test/main/Test/LocalTime/Time.hs view
@@ -1,53 +1,55 @@-module Test.LocalTime.Time- ( testTime- ) where+module Test.LocalTime.Time (+ testTime,+) where -import Data.Time-import Data.Time.Calendar.OrdinalDate-import Data.Time.Calendar.WeekDate+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') ++ "!"- ]+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]+ , -- 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+ , -- 1900 not a leap year+ showCal 15078 , showCal 15079- -- 1980 is a leap year- , showCal 44297+ , -- 1980 is a leap year+ showCal 44297 , showCal 44298 , showCal 44299- -- 1990 not a leap year- , showCal 47950+ , -- 1990 not a leap year+ showCal 47950 , showCal 47951- -- 2000 is a leap year- , showCal 51602+ , -- 2000 is a leap year+ showCal 51602 , showCal 51603 , showCal 51604- -- years 2000 and 2001, plus some slop- , concatMap showCal [51540 .. 52280]+ , -- years 2000 and 2001, plus some slop+ concatMap showCal [51540 .. 52280] ] showUTCTime :: UTCTime -> String@@ -63,10 +65,12 @@ 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]+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@@ -86,17 +90,20 @@ ] 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- ]+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]+ assertEqual "times" testTimeRef $+ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction]
test/main/Test/LocalTime/TimeOfDay.hs view
@@ -1,6 +1,6 @@-module Test.LocalTime.TimeOfDay- ( testTimeOfDay- ) where+module Test.LocalTime.TimeOfDay (+ testTimeOfDay,+) where import Data.Time.LocalTime.Compat import Test.Arbitrary ()@@ -11,12 +11,16 @@ 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+ [ 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 ]
test/main/Test/LocalTime/TimeRef.hs view
@@ -6,9 +6,10 @@ 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"+ else+ if toInteger (maxBound :: Int) == toInteger (maxBound :: Int64)+ then True+ else error "unrecognised Int size" testTimeRef :: String testTimeRef =@@ -888,8 +889,8 @@ , "12:34:56.789123" , "12:34:56.789123456" , "12:34:56.789123456789"- -- , if is64Bit- -- then "-9223372036854775808:00:00"- -- else "-2147483648:00:00"+ , if is64Bit+ then "-9223372036854775808:00:00"+ else "-2147483648:00:00" , "" ]
test/main/Test/Types.hs view
@@ -1,26 +1,52 @@-module Test.Types(CheckInstances) where+module 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) => CheckDataInstances t-class (Typeable t, Data t, Eq t) => CheckInstances t+class (Typeable t, Data t, NFData t) => CheckDataInstances t -instance CheckInstances UTCTime-instance CheckInstances NominalDiffTime+class (Typeable t, Data t, NFData t, Eq t) => CheckEqInstances t -instance CheckInstances Day-instance CheckInstances DayOfWeek-instance CheckInstances TimeOfDay-instance CheckInstances LocalTime-instance CheckInstances TimeZone+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 CheckInstances CalendarDiffDays-instance CheckInstances CalendarDiffTime -instance CheckInstances SystemTime+instance CheckEqInstances CalendarDiffDays -instance CheckInstances AbsoluteTime-instance CheckInstances UniversalTime+instance CheckEqInstances CalendarDiffTime++instance CheckEnumInstances Month++instance CheckEnumInstances Quarter++instance CheckBoundedInstances QuarterOfYear++instance CheckOrdInstances SystemTime++instance CheckOrdInstances AbsoluteTime++instance CheckOrdInstances UniversalTime
time-compat.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: time-compat-version: 1.9.7+version: 1.9.8 synopsis: Compatibility package for time description: This packages tries to compat as much of @time@ features as possible.@@ -29,9 +29,10 @@ || ==9.0.2 || ==9.2.8 || ==9.4.8- || ==9.6.5- || ==9.8.2+ || ==9.6.6+ || ==9.8.4 || ==9.10.1+ || ==9.12.1 source-repository head type: git@@ -43,12 +44,22 @@ other-extensions: CPP default-extensions: Trustworthy build-depends:- base >=4.12 && <4.21- , base-orphans >=0.9.2 && <0.10- , deepseq >=1.4.4.0 && <1.6- , hashable >=1.4.4.0 && <1.5- , 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+ 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@@ -81,8 +92,9 @@ build-depends: base , deepseq- , hashable >=1.4.0.0 && <1.5- , HUnit >=1.3.1 && <1.3.2 || >=1.6.0.0 && <1.7+ , 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@@ -103,24 +115,30 @@ 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.13 && <2.16- , tagged >=0.8.6 && <0.9- , tasty >=1.5 && <1.6- , tasty-hunit >=0.10 && <0.11- , tasty-quickcheck >=0.10 && <0.11+ , 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)@@ -140,6 +158,7 @@ Test.Calendar.ClipDates Test.Calendar.ClipDatesRef Test.Calendar.ConvertBack+ Test.Calendar.DayPeriod Test.Calendar.Duration Test.Calendar.Easter Test.Calendar.EasterRef@@ -147,9 +166,12 @@ 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