time 1.15 → 1.16

raw patch · 29 files changed

+353/−64 lines, 29 filesdep +template-haskell-liftdep ~template-haskell

Dependencies added: template-haskell-lift

Dependency ranges changed: template-haskell

Files

• changelog.md +8/−0
• configure +9/−9
• configure.ac +1/−1
• lib/Data/Time/Calendar.hs +1/−0
• lib/Data/Time/Calendar/CalendarDiffDays.hs +6/−1
• lib/Data/Time/Calendar/Days.hs +15/−1
• lib/Data/Time/Calendar/Gregorian.hs +5/−1
• lib/Data/Time/Calendar/Month.hs +6/−1
• lib/Data/Time/Calendar/Quarter.hs +6/−1
• lib/Data/Time/Calendar/Week.hs +6/−1
• lib/Data/Time/Calendar/WeekDate.hs +6/−1
• lib/Data/Time/Clock/Internal/AbsoluteTime.hs +6/−1
• lib/Data/Time/Clock/Internal/DiffTime.hs +5/−1
• lib/Data/Time/Clock/Internal/NominalDiffTime.hs +5/−1
• lib/Data/Time/Clock/Internal/SystemTime.hs +5/−1
• lib/Data/Time/Clock/Internal/UTCTime.hs +6/−1
• lib/Data/Time/Clock/Internal/UniversalTime.hs +6/−1
• lib/Data/Time/LocalTime/Internal/CalendarDiffTime.hs +6/−1
• lib/Data/Time/LocalTime/Internal/LocalTime.hs +6/−1
• lib/Data/Time/LocalTime/Internal/TimeOfDay.hs +6/−1
• lib/Data/Time/LocalTime/Internal/TimeZone.hs +6/−1
• lib/Data/Time/LocalTime/Internal/ZonedTime.hs +6/−1
• test/main/Test/AddDiff.hs +20/−0
• test/main/Test/Arbitrary.hs +41/−1
• test/main/Test/Calendar/Duration.hs +18/−26
• test/main/Test/LocalTime/CalendarDiffTime.hs +87/−0
• test/template/Main.hs +9/−2
• test/template/Test/TastyWrapper.hs +20/−0
• time.cabal +26/−7

@@ -1,5 +1,12 @@ # Change Log +## [1.16] - 2026-05-03++- add periodIn+- use template-haskell-lift rather than template-haskell for Lift instances on GHC 9.14 and later+- support GHC 9.14+- improve documentation, test, build, CI+ ## [1.15] - 2025-08-04  - support compiler / GHC backends (with CI):@@ -18,6 +25,7 @@   - loosen up parsing time-zone modifiers - add Lift instances to all types (really this time) - hide Data.Time.Format.Internal+- add periodToDayClip - fix MonthDay and QuarterDay clipping  ## [1.14] - 2024-03-10

@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for Haskell time package 1.15.+# Generated by GNU Autoconf 2.71 for Haskell time package 1.16. # # Report bugs to <ashley@semantic.org>. #@@ -610,8 +610,8 @@ # Identity of this package. PACKAGE_NAME='Haskell time package' PACKAGE_TARNAME='time'-PACKAGE_VERSION='1.15'-PACKAGE_STRING='Haskell time package 1.15'+PACKAGE_VERSION='1.16'+PACKAGE_STRING='Haskell time package 1.16' PACKAGE_BUGREPORT='ashley@semantic.org' PACKAGE_URL='' @@ -1258,7 +1258,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures Haskell time package 1.15 to adapt to many kinds of systems.+\`configure' configures Haskell time package 1.16 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1320,7 +1320,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of Haskell time package 1.15:";;+     short | recursive ) echo "Configuration of Haskell time package 1.16:";;    esac   cat <<\_ACEOF @@ -1406,7 +1406,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-Haskell time package configure 1.15+Haskell time package configure 1.16 generated by GNU Autoconf 2.71  Copyright (C) 2021 Free Software Foundation, Inc.@@ -1736,7 +1736,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Haskell time package $as_me 1.15, which was+It was created by Haskell time package $as_me 1.16, which was generated by GNU Autoconf 2.71.  Invocation command line was    $ $0$ac_configure_args_raw@@ -4334,7 +4334,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by Haskell time package $as_me 1.15, which was+This file was extended by Haskell time package $as_me 1.16, which was generated by GNU Autoconf 2.71.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -4389,7 +4389,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-Haskell time package config.status 1.15+Haskell time package config.status 1.16 configured by $0, generated by GNU Autoconf 2.71,   with options \\"\$ac_cs_config\\" 

@@ -1,4 +1,4 @@-AC_INIT([Haskell time package],[1.15],[ashley@semantic.org],[time])+AC_INIT([Haskell time package],[1.16],[ashley@semantic.org],[time])  # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h])

@@ -9,6 +9,7 @@     -- * DayPeriod     DayPeriod (..),     periodAllDays,+    periodIn,     periodLength,     periodFromDay,     periodToDay,

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.Calendar.CalendarDiffDays where@@ -5,7 +6,11 @@ import Control.DeepSeq import Data.Data import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  data CalendarDiffDays = CalendarDiffDays     { cdMonths :: Integer

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.Calendar.Days where@@ -7,7 +8,11 @@ import Data.Ix import Data.Time.Calendar.Private import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17. newtype Day = ModifiedJulianDay@@ -60,6 +65,12 @@ periodAllDays :: DayPeriod p => p -> [Day] periodAllDays p = [periodFirstDay p .. periodLastDay p] +-- | Test whether a day is in a given period.+--+-- @since 1.16+periodIn :: DayPeriod p => p -> Day -> Bool+periodIn p d = (d >= periodFirstDay p) && (d <= periodLastDay p)+ -- | The number of days in this period. -- -- @since 1.12.1@@ -85,6 +96,9 @@ periodToDay :: DayPeriod p => p -> Int -> Day periodToDay p i = addDays (toInteger $ pred i) $ periodFirstDay p +-- | Inverse of 'periodFromDay', clipping the day number to the period.+--+-- @since 1.15 periodToDayClip :: DayPeriod p => p -> Int -> Day periodToDayClip p i = periodToDay p $ clip 1 (periodLength p) i 

@@ -90,7 +90,9 @@ addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day addGregorianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addGregorianMonthsRollOver m day --- | Calendrical difference, with as many whole months as possible+-- | Calendrical difference, with as many whole months as possible.+-- Has the property @addGregorianDurationClip (diffGregorianDurationClip d2 d1) d1 = d2@.+-- For example, 2027-03-01 - 2027-01-31 = 1 month and 1 day. diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays diffGregorianDurationClip day2 day1 =     let@@ -114,6 +116,8 @@         CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed  -- | Calendrical difference, with as many whole months as possible.+-- Has the property @addGregorianDurationRollOver (diffGregorianDurationRollOver d2 d1) d1 = d2@.+-- For example, 2027-03-01 - 2027-01-31 = 29 days. diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays diffGregorianDurationRollOver day2 day1 =     let

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  -- | An absolute count of common calendar months.@@ -20,7 +21,11 @@ import Data.Time.Calendar.Private import Data.Time.Calendar.Types import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif import Text.ParserCombinators.ReadP import Text.Read 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  -- | Year quarters.@@ -23,7 +24,11 @@ import Data.Time.Calendar.Private import Data.Time.Calendar.Types import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif import Text.ParserCombinators.ReadP import Text.Read 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.Calendar.Week where@@ -8,7 +9,11 @@ import Data.Ix import Data.Time.Calendar.Days import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  data DayOfWeek     = Monday

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  -- | Week-based calendars@@ -23,7 +24,11 @@ import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private import Data.Time.Calendar.Week-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  data FirstWeekType     = -- | first week is the first whole week of the year

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  -- | TAI and leap-second maps for converting to UTC: most people won't need this module.@@ -7,7 +8,11 @@ import Data.Data import Data.Time.Calendar.Days import Data.Time.Clock.Internal.DiffTime-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | AbsoluteTime is TAI, time as measured by a clock. newtype AbsoluteTime

@@ -9,7 +9,11 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Read #endif-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif import Text.ParserCombinators.ReadP import Text.Read 

@@ -10,7 +10,11 @@ import GHC.Read #endif import Data.Time.Clock.Internal.DiffTime-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadPrec 

@@ -23,7 +23,11 @@ import Data.Time.Clock.Internal.DiffTime import Data.Word import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  #ifdef mingw32_HOST_OS import qualified System.Win32.Time as Win32

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.Clock.Internal.UTCTime where@@ -7,7 +8,11 @@ import Data.Time.Calendar.Days import Data.Time.Clock.Internal.DiffTime import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | This is the simplest representation of UTC. -- It consists of the day number, and a time offset from midnight.

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.Clock.Internal.UniversalTime where@@ -5,7 +6,11 @@ import Control.DeepSeq import Data.Data import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | The Modified Julian Date is the day with the fraction of the day, measured from UT midnight. -- It's used to represent UT1, which is time as measured by the earth's rotation, adjusted for various wobbles.

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.LocalTime.Internal.CalendarDiffTime where@@ -10,7 +11,11 @@ import Data.Time.Clock.Internal.UTCDiff import Data.Time.Clock.Internal.UTCTime import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  data CalendarDiffTime = CalendarDiffTime     { ctMonths :: Integer

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  {-# OPTIONS -fno-warn-orphans #-}@@ -16,7 +17,11 @@ import Data.Time.LocalTime.Internal.TimeOfDay import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | A simple day and time aggregate, where the day is of the specified parameter, -- and the time is a TimeOfDay.

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.LocalTime.Internal.TimeOfDay where@@ -10,7 +11,11 @@ import Data.Time.Clock.Internal.NominalDiffTime import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. --

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  module Data.Time.LocalTime.Internal.TimeZone (@@ -15,7 +16,11 @@ import Data.Data import Data.Time.Calendar.Private import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag. data TimeZone = TimeZone

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-}  {-# OPTIONS -fno-warn-orphans #-}@@ -12,7 +13,11 @@ import Data.Time.LocalTime.Internal.LocalTime import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif  -- | A local time together with a time zone. --

@@ -0,0 +1,20 @@+module Test.AddDiff (+    AddDiff (..),+    testAddDiff,+) where++import Test.Arbitrary+import Test.Tasty+import Test.Tasty.QuickCheck hiding (reason)++data AddDiff duration time = MkAddDiff+    { adName :: String+    , adAdd :: duration -> time -> time+    , adDifference :: time -> time -> duration+    }++testAddDiff :: (Arbitrary (NoLeapSeconds time), Eq time, Show time) => AddDiff duration time -> TestTree+testAddDiff MkAddDiff{..} =+    testProperty adName $+        \(MkNoLeapSeconds time1) (MkNoLeapSeconds time2) ->+            adAdd (adDifference time2 time1) time1 == time2

@@ -1,6 +1,9 @@ {-# OPTIONS -fno-warn-orphans #-} -module Test.Arbitrary (supportedDayRange) where+module Test.Arbitrary (+    supportedDayRange,+    NoLeapSeconds (..),+) where  import Control.Monad import Data.Fixed@@ -96,6 +99,16 @@ instance Arbitrary CalendarDiffDays where     arbitrary = liftM2 CalendarDiffDays arbitrary arbitrary +newtype NoLeapSeconds a = MkNoLeapSeconds {unNoLeapSeconds :: a}+    deriving newtype (Eq, Ord, Show)++arbitraryNoLeapSeconds :: Arbitrary (NoLeapSeconds a) => Gen a+arbitraryNoLeapSeconds = fmap unNoLeapSeconds arbitrary++instance {-# OVERLAPPABLE #-} Arbitrary t => Arbitrary (NoLeapSeconds t) where+    arbitrary = fmap MkNoLeapSeconds arbitrary+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t+ instance Arbitrary DiffTime where     arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second       where@@ -109,6 +122,17 @@ instance CoArbitrary DiffTime where     coarbitrary t = coarbitrary (fromEnum t) +instance Arbitrary (NoLeapSeconds DiffTime) where+    arbitrary = fmap MkNoLeapSeconds $ oneof [intSecs, fracSecs] -- no leap second+      where+        intSecs = liftM secondsToDiffTime' $ choose (0, 86399)+        fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86399 * 10 ^ (12 :: Int))+        secondsToDiffTime' :: Integer -> DiffTime+        secondsToDiffTime' = fromInteger+        picosecondsToDiffTime' :: Integer -> DiffTime+        picosecondsToDiffTime' x = fromRational (x % 10 ^ (12 :: Int))+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t+ instance Arbitrary NominalDiffTime where     arbitrary = oneof [intSecs, fracSecs]       where@@ -156,6 +180,10 @@                 ++ [TimeOfDay h m' s | m' <- shrinkInt m]                 ++ [TimeOfDay h m s' | s' <- shrinkPico s] +instance Arbitrary (NoLeapSeconds TimeOfDay) where+    arbitrary = fmap (MkNoLeapSeconds . timeToTimeOfDay) arbitraryNoLeapSeconds+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t+ instance CoArbitrary TimeOfDay where     coarbitrary t = coarbitrary (timeOfDayToTime t) @@ -166,6 +194,10 @@ instance CoArbitrary LocalTime where     coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer) +instance Arbitrary (NoLeapSeconds LocalTime) where+    arbitrary = fmap MkNoLeapSeconds $ liftM2 LocalTime arbitraryNoLeapSeconds arbitraryNoLeapSeconds+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t+ instance Arbitrary TimeZone where     arbitrary = liftM minutesToTimeZone $ choose (-720, 720)     shrink (TimeZone 0 _ _) = []@@ -181,12 +213,20 @@ instance CoArbitrary ZonedTime where     coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) +instance Arbitrary (NoLeapSeconds ZonedTime) where+    arbitrary = fmap MkNoLeapSeconds $ liftM2 ZonedTime arbitraryNoLeapSeconds arbitraryNoLeapSeconds+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t+ instance Arbitrary UTCTime where     arbitrary = liftM2 UTCTime arbitrary arbitrary     shrink t = fmap (localTimeToUTC utc) $ shrink $ utcToLocalTime utc t  instance CoArbitrary UTCTime where     coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds t) :: Integer)++instance Arbitrary (NoLeapSeconds UTCTime) where+    arbitrary = fmap MkNoLeapSeconds $ liftM2 UTCTime arbitraryNoLeapSeconds arbitraryNoLeapSeconds+    shrink (MkNoLeapSeconds t) = fmap MkNoLeapSeconds $ shrink t  instance Arbitrary UniversalTime where     arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) -- 1000-01-1 to 9999-12-31

@@ -4,31 +4,27 @@  import Data.Time.Calendar import Data.Time.Calendar.Julian+import Test.AddDiff import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding (reason) -data AddDiff = MkAddDiff-    { adName :: String-    , adAdd :: CalendarDiffDays -> Day -> Day-    , adDifference :: Day -> Day -> CalendarDiffDays-    , adFromYMD :: Integer -> Int -> Int -> Day-    }+type CalendarAddDiff = (AddDiff CalendarDiffDays Day, Integer -> Int -> Int -> Day) -gregorianClip :: AddDiff-gregorianClip = MkAddDiff "gregorianClip" addGregorianDurationClip diffGregorianDurationClip fromGregorian+gregorianClip :: CalendarAddDiff+gregorianClip = (MkAddDiff "gregorianClip" addGregorianDurationClip diffGregorianDurationClip, fromGregorian) -gregorianRollOver :: AddDiff-gregorianRollOver = MkAddDiff "gregorianRollOver" addGregorianDurationRollOver diffGregorianDurationRollOver fromGregorian+gregorianRollOver :: CalendarAddDiff+gregorianRollOver = (MkAddDiff "gregorianRollOver" addGregorianDurationRollOver diffGregorianDurationRollOver, fromGregorian) -julianClip :: AddDiff-julianClip = MkAddDiff "julianClip" addJulianDurationClip diffJulianDurationClip fromJulian+julianClip :: CalendarAddDiff+julianClip = (MkAddDiff "julianClip" addJulianDurationClip diffJulianDurationClip, fromJulian) -julianRollOver :: AddDiff-julianRollOver = MkAddDiff "julianRollOver" addJulianDurationRollOver diffJulianDurationRollOver fromJulian+julianRollOver :: CalendarAddDiff+julianRollOver = (MkAddDiff "julianRollOver" addJulianDurationRollOver diffJulianDurationRollOver, fromJulian) -addDiffs :: [AddDiff]+addDiffs :: [CalendarAddDiff] addDiffs =     [ gregorianClip     , gregorianRollOver@@ -36,15 +32,11 @@     , julianRollOver     ] -testAddDiff :: AddDiff -> TestTree-testAddDiff MkAddDiff{..} = testProperty adName $ \day1 day2 ->-    adAdd (adDifference day2 day1) day1 == day2- testAddDiffs :: TestTree testAddDiffs =     testGroup         "add-diff"-        $ fmap testAddDiff addDiffs+        $ fmap (testAddDiff . fst) addDiffs  newtype Smallish = MkSmallish Integer deriving (Eq, Ord) @@ -56,8 +48,8 @@         n <- if b then choose (0, 60) else return 30         return $ MkSmallish n -testPositiveDiff :: AddDiff -> TestTree-testPositiveDiff MkAddDiff{..} = testProperty adName $ \day1 (MkSmallish i) ->+testPositiveDiff :: CalendarAddDiff -> TestTree+testPositiveDiff (MkAddDiff{..}, _) = testProperty adName $ \day1 (MkSmallish i) ->     let         day2 = addDays i day1         r = adDifference day2 day1@@ -70,11 +62,11 @@         "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) =+testSpecific :: CalendarAddDiff -> (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree+testSpecific (MkAddDiff{..}, fromYMD) (y2, m2, d2) (y1, m1, d1) (em, ed) =     let-        day1 = adFromYMD y1 m1 d1-        day2 = adFromYMD y2 m2 d2+        day1 = fromYMD y1 m1 d1+        day2 = fromYMD y2 m2 d2         expected = CalendarDiffDays em ed         found = adDifference day2 day1     in

@@ -2,12 +2,97 @@     testCalendarDiffTime, ) where +import Data.Fixed import Data.Time+import Test.AddDiff import Test.Arbitrary () import Test.Tasty import Test.Tasty.HUnit import Test.TestUtil +utcClip :: AddDiff CalendarDiffTime UTCTime+utcClip = MkAddDiff "utcClip" addUTCDurationClip diffUTCDurationClip++utcRollOver :: AddDiff CalendarDiffTime UTCTime+utcRollOver = MkAddDiff "utcRollOver" addUTCDurationRollOver diffUTCDurationRollOver++localClip :: AddDiff CalendarDiffTime LocalTime+localClip = MkAddDiff "localClip" addLocalDurationClip diffLocalDurationClip++localRollOver :: AddDiff CalendarDiffTime LocalTime+localRollOver = MkAddDiff "localRollOver" addLocalDurationRollOver diffLocalDurationRollOver++testAddDiffs :: TestTree+testAddDiffs =+    testGroup+        "add-diff"+        [ testGroup "UTC" $ fmap testAddDiff [utcClip, utcRollOver]+        , testGroup "LocalTime" $ fmap testAddDiff [localClip, localRollOver]+        ]++utcTime :: Integer -> Int -> Int -> DiffTime -> UTCTime+utcTime y m d = UTCTime (YearMonthDay y m d)++localTime :: Integer -> Int -> Int -> Int -> Int -> Pico -> LocalTime+localTime y m d h minute s = LocalTime (YearMonthDay y m d) $ TimeOfDay h minute s++testSpecifics :: TestTree+testSpecifics =+    testGroup+        "specific"+        [ testGroup+            "add"+            [ testCase "UTC clip" $+                assertEqual+                    "Jan 31 + 1 month clips to Feb 28"+                    (utcTime 2001 2 28 0)+                    (addUTCDurationClip (CalendarDiffTime 1 0) $ utcTime 2001 1 31 0)+            , testCase "UTC rollover" $+                assertEqual+                    "Jan 31 + 1 month rolls over to Mar 3"+                    (utcTime 2001 3 3 0)+                    (addUTCDurationRollOver (CalendarDiffTime 1 0) $ utcTime 2001 1 31 0)+            , testCase "LocalTime clip" $+                assertEqual+                    "Jan 31 + 1 month clips to Feb 28"+                    (localTime 2001 2 28 0 0 0)+                    (addLocalDurationClip (CalendarDiffTime 1 0) $ localTime 2001 1 31 0 0 0)+            , testCase "LocalTime rollover" $+                assertEqual+                    "Jan 31 + 1 month rolls over to Mar 3"+                    (localTime 2001 3 3 0 0 0)+                    (addLocalDurationRollOver (CalendarDiffTime 1 0) $ localTime 2001 1 31 0 0 0)+            , testCase "time part" $+                assertEqual+                    "the time part can carry into the next day"+                    (localTime 2001 2 1 0 0 1)+                    (addLocalDurationClip (CalendarDiffTime 0 2) $ localTime 2001 1 31 23 59 59)+            ]+        , testGroup+            "diff"+            [ testCase "UTC clip" $+                assertEqual+                    "Mar 1 - Jan 30 clips as 1 month and 1 day"+                    (CalendarDiffTime 1 nominalDay)+                    (diffUTCDurationClip (utcTime 2001 3 1 0) $ utcTime 2001 1 30 0)+            , testCase "UTC rollover" $+                assertEqual+                    "Mar 1 - Jan 30 rolls over as 30 days"+                    (CalendarDiffTime 0 $ 30 * nominalDay)+                    (diffUTCDurationRollOver (utcTime 2001 3 1 0) $ utcTime 2001 1 30 0)+            , testCase "LocalTime clip" $+                assertEqual+                    "Mar 1 - Jan 30 clips as 1 month and 1 day"+                    (CalendarDiffTime 1 nominalDay)+                    (diffLocalDurationClip (localTime 2001 3 1 0 0 0) $ localTime 2001 1 30 0 0 0)+            , testCase "LocalTime rollover" $+                assertEqual+                    "Mar 1 - Jan 30 rolls over as 30 days"+                    (CalendarDiffTime 0 $ 30 * nominalDay)+                    (diffLocalDurationRollOver (localTime 2001 3 1 0 0 0) $ localTime 2001 1 30 0 0 0)+            ]+        ]+ testReadShowExact :: (Read a, Show a, Eq a) => String -> a -> TestTree testReadShowExact t v =     nameTest@@ -31,4 +116,6 @@         , 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+        , testAddDiffs+        , testSpecifics         ]

@@ -1,9 +1,16 @@+{-# LANGUAGE CPP #-}+ module Main (main) where  import Data.Time.Clock-import Language.Haskell.TH.Syntax qualified as TH+#if __GLASGOW_HASKELL__ >= 914+import qualified Language.Haskell.TH.Lift as TH+#else+import qualified Language.Haskell.TH.Syntax as TH+#endif import Test.Tasty import Test.Tasty.HUnit+import Test.TastyWrapper  testLift :: TestTree testLift =@@ -21,4 +28,4 @@         ]  main :: IO ()-main = defaultMain tests+main = tastyWrapper $ defaultMain tests

@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}++module Test.TastyWrapper where++#if defined(javascript_HOST_ARCH)+import GHC.IO.Handle (hDuplicateTo)+import System.IO (IOMode (ReadMode), stdin, withFile)+#endif++tastyWrapper :: IO a -> IO a+#if defined(javascript_HOST_ARCH)+-- Tasty's console reporter queries terminal width through ansi-terminal, which+-- trips h$fdReady in the JS RTS when this test runs attached to a TTY.+tastyWrapper action =+    withFile "/dev/null" ReadMode $ \devNull -> do+        hDuplicateTo devNull stdin+        action+#else+tastyWrapper = id+#endif

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           time-version:        1.15+version:        1.16 stability:      stable license:        BSD-2-Clause license-file:   LICENSE@@ -14,8 +14,9 @@ build-type:     Configure tested-with:     GHC == 9.8.4,-    GHC == 9.10.2,-    GHC == 9.12.2+    GHC == 9.10.3,+    GHC == 9.12.4,+    GHC == 9.14.1 x-follows-version-policy:  extra-source-files:@@ -54,8 +55,13 @@     build-depends:         base >= 4.19 && < 5,         deepseq >= 1.1,-    if impl(ghc)-        build-depends: template-haskell >= 2.17,+    -- template-haskell-lift was added as a boot library in GHC-9.14+    -- once we no longer wish to backport releases to older major releases,+    -- this conditional can be dropped+    if impl(ghc < 9.14)+        build-depends: template-haskell+    elif impl(ghc)+        build-depends: template-haskell-lift >= 0.1 && <0.2     if os(windows)         build-depends: Win32     exposed-modules:@@ -175,9 +181,13 @@         tasty,         tasty-hunit,         tasty-quickcheck,-        template-haskell+    if impl(ghc < 9.14)+        build-depends: template-haskell+    elif impl(ghc)+        build-depends: template-haskell-lift >= 0.1 && <0.2     main-is: Main.hs     other-modules:+        Test.AddDiff         Test.Types         Test.TestUtil         Test.Arbitrary@@ -235,8 +245,13 @@         tasty,         tasty-hunit,         tasty-quickcheck,-        template-haskell+    if impl(ghc < 9.14)+        build-depends: template-haskell+    elif impl(ghc)+        build-depends: template-haskell-lift >= 0.1 && <0.2     main-is: Main.hs+    other-modules:+        Test.TastyWrapper  test-suite test-unix     if os(windows) || arch (javascript) || arch (wasm32)@@ -275,4 +290,8 @@         deepseq,         time,         criterion+    if impl(ghc < 9.14)+        build-depends: template-haskell+    elif impl(ghc)+        build-depends: template-haskell-lift >= 0.1 && <0.2     main-is: Main.hs