time 1.14 → 1.16
raw patch · 60 files changed
Files
- changelog.md +28/−0
- configure +9/−9
- configure.ac +1/−1
- lib/Data/Format.hs +33/−17
- lib/Data/Time/Calendar.hs +67/−3
- lib/Data/Time/Calendar/CalendarDiffDays.hs +7/−15
- lib/Data/Time/Calendar/Days.hs +20/−15
- lib/Data/Time/Calendar/Gregorian.hs +6/−43
- lib/Data/Time/Calendar/Julian.hs +2/−0
- lib/Data/Time/Calendar/JulianYearDay.hs +1/−4
- lib/Data/Time/Calendar/Month.hs +9/−3
- lib/Data/Time/Calendar/Quarter.hs +9/−4
- lib/Data/Time/Calendar/Week.hs +7/−11
- lib/Data/Time/Calendar/WeekDate.hs +6/−1
- lib/Data/Time/Clock.hs +31/−4
- lib/Data/Time/Clock/Internal/AbsoluteTime.hs +7/−9
- lib/Data/Time/Clock/Internal/CTimespec.hsc +26/−17
- lib/Data/Time/Clock/Internal/CTimeval.hs +1/−1
- lib/Data/Time/Clock/Internal/DiffTime.hs +35/−16
- lib/Data/Time/Clock/Internal/NominalDiffTime.hs +20/−17
- lib/Data/Time/Clock/Internal/SystemTime.hs +9/−3
- lib/Data/Time/Clock/Internal/UTCTime.hs +7/−23
- lib/Data/Time/Clock/Internal/UniversalTime.hs +7/−7
- lib/Data/Time/Clock/TAI.hs +12/−4
- lib/Data/Time/Format.hs +16/−1
- lib/Data/Time/Format/Format/Class.hs +19/−4
- lib/Data/Time/Format/Format/Instances.hs +15/−5
- lib/Data/Time/Format/ISO8601.hs +5/−3
- lib/Data/Time/Format/Locale.hs +1/−6
- lib/Data/Time/Format/Parse.hs +1/−12
- lib/Data/Time/Format/Parse/Class.hs +2/−1
- lib/Data/Time/Format/Parse/Instances.hs +364/−179
- lib/Data/Time/LocalTime.hs +42/−3
- lib/Data/Time/LocalTime/Internal/CalendarDiffTime.hs +33/−12
- lib/Data/Time/LocalTime/Internal/Foreign.hs +119/−0
- lib/Data/Time/LocalTime/Internal/LocalTime.hs +31/−12
- lib/Data/Time/LocalTime/Internal/TimeOfDay.hs +12/−19
- lib/Data/Time/LocalTime/Internal/TimeZone.hs +7/−88
- lib/Data/Time/LocalTime/Internal/ZonedTime.hs +9/−8
- lib/cbits/HsTime.c +1/−1
- lib/include/HsTime.h +1/−1
- test/ForeignCalls.hs +50/−0
- test/main/Main.hs +2/−2
- test/main/Test/AddDiff.hs +20/−0
- test/main/Test/Arbitrary.hs +81/−11
- test/main/Test/Calendar/CalendarProps.hs +1/−1
- test/main/Test/Calendar/Duration.hs +18/−26
- test/main/Test/Calendar/MonthDay.hs +19/−4
- test/main/Test/Clock/Lift.hs +0/−18
- test/main/Test/Clock/Pattern.hs +32/−0
- test/main/Test/Format/Compile.hs +0/−2
- test/main/Test/Format/Format.hs +10/−10
- test/main/Test/Format/ISO8601.hs +89/−60
- test/main/Test/Format/ParseTime.hs +115/−1
- test/main/Test/LocalTime/CalendarDiffTime.hs +87/−0
- test/main/Test/TestUtil.hs +3/−0
- test/template/Main.hs +31/−0
- test/template/Test/TastyWrapper.hs +20/−0
- test/unix/Test/Format/Format.hs +6/−1
- time.cabal +90/−41
changelog.md view
@@ -1,5 +1,33 @@ # 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):+ - JavaScript+ - WebAssembly+ - MicroHs+- add diffTimeOfDay+- add \[add/diff\]\[UTC/Local\]Duration\[Clip/Rollover\]+- add patterns for DiffTime & NominalDiffTime+- UNIXish formatting/parsing:+ - add instance ParseTime DayOfWeek+ - make use of %s specifiers in parsing various types+ - instances for Quarter and QuarterOfYear+ - %v specifier for quarter-of-year+- ISO8601 formatting/parsing:+ - 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 - add Lift instances to all types - add Generic instances to all types that have exposed constructors
configure view
@@ -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.14.+# 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.14'-PACKAGE_STRING='Haskell time package 1.14'+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.14 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.14:";;+ 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.14+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.14, 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.14, 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.14+Haskell time package config.status 1.16 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\"
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell time package],[1.14],[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])
lib/Data/Format.hs view
@@ -15,6 +15,7 @@ literalFormat, specialCaseShowFormat, specialCaseFormat,+ specialCaseReadFormat, optionalFormat, casesFormat, optionalSignFormat,@@ -177,6 +178,13 @@ in MkFormat s' r' +specialCaseReadFormat :: (a, String) -> Format a -> Format a+specialCaseReadFormat (val, str) (MkFormat s r) =+ let+ r' = r <++ (string str >> return val)+ in+ MkFormat s r'+ optionalFormat :: Eq a => a -> Format a -> Format a optionalFormat val = specialCaseFormat (val, "") @@ -222,36 +230,44 @@ return $ '.' : dd return $ sign $ read $ digits ++ moredigits -zeroPad :: Maybe Int -> String -> String-zeroPad Nothing s = s-zeroPad (Just i) s = replicate (i - length s) '0' ++ s+zeroPad :: Maybe Int -> String -> Maybe String+zeroPad Nothing s = Just s+zeroPad (Just i) s =+ let+ padCount = i - length s+ in+ if padCount >= 0+ then Just $ replicate padCount '0' ++ s+ else Nothing trimTrailing :: String -> String-trimTrailing "" = ""-trimTrailing "." = ""-trimTrailing s- | last s == '0' = trimTrailing $ init s-trimTrailing s = s+trimTrailing =+ (\s -> if s == "." then "" else s)+ . reverse+ . dropWhile (== '0')+ . reverse showNumber :: Show t => SignOption -> Maybe Int -> t -> Maybe String showNumber signOpt mdigitcount t = let- showIt str =+ showIt str = do let (intPart, decPart) = break ((==) '.') str- in- (zeroPad mdigitcount intPart) ++ trimTrailing decPart+ paddedIntPart <- zeroPad mdigitcount intPart+ return $ paddedIntPart ++ trimTrailing decPart in case show t of ('-' : str) -> case signOpt of NoSign -> Nothing- _ -> Just $ '-' : showIt str- str ->- Just $- case signOpt of- PosNegSign -> '+' : showIt str- _ -> showIt str+ _ -> do+ s <- showIt str+ return $ '-' : s+ str -> do+ s <- showIt str+ return $ case signOpt of+ PosNegSign -> '+' : s+ _ -> s integerFormat :: (Show t, Read t, Num t) => SignOption -> Maybe Int -> Format t integerFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readNumber signOpt mdigitcount False)
lib/Data/Time/Calendar.hs view
@@ -1,14 +1,78 @@ {-# LANGUAGE Safe #-} module Data.Time.Calendar (- module Data.Time.Calendar.Days,+ -- * Days+ Day (..),+ addDays,+ diffDays,++ -- * DayPeriod+ DayPeriod (..),+ periodAllDays,+ periodIn,+ periodLength,+ periodFromDay,+ periodToDay,+ periodToDayClip,+ periodToDayValid,++ -- * Calendar Duration module Data.Time.Calendar.CalendarDiffDays,- module Data.Time.Calendar.Gregorian,- module Data.Time.Calendar.Week,++ -- * 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,+ pattern YearMonthDay,+ fromGregorianValid,+ showGregorian,+ gregorianMonthLength,+ -- calendrical arithmetic+ -- e.g. "one month after March 31st"+ addGregorianMonthsClip,+ addGregorianMonthsRollOver,+ addGregorianYearsClip,+ addGregorianYearsRollOver,+ addGregorianDurationClip,+ addGregorianDurationRollOver,+ diffGregorianDurationClip,+ diffGregorianDurationRollOver,+ -- re-exported from OrdinalDate+ isLeapYear,++ -- * Week+ DayOfWeek (..),+ dayOfWeek,+ dayOfWeekDiff,+ firstDayOfWeekOnAfter,+ weekAllDays,+ weekFirstDay,+ weekLastDay, ) where import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian+import Data.Time.Calendar.MonthDay+import Data.Time.Calendar.OrdinalDate+import Data.Time.Calendar.Types import Data.Time.Calendar.Week import Data.Time.Format ()
lib/Data/Time/Calendar/CalendarDiffDays.hs view
@@ -1,30 +1,22 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.Calendar.CalendarDiffDays (- -- * Calendar Duration- module Data.Time.Calendar.CalendarDiffDays,-) where+module Data.Time.Calendar.CalendarDiffDays where import Control.DeepSeq import Data.Data import GHC.Generics+#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 , cdDays :: Integer }- deriving- ( Eq- , -- | @since 1.9.2- Data- , -- | @since 1.9.2- Typeable- , -- | @since 1.14- TH.Lift- , -- | @since 1.14- Generic- )+ deriving (Eq, Typeable, Data, Generic, TH.Lift) instance NFData CalendarDiffDays where rnf (CalendarDiffDays m d) = rnf m `seq` rnf d `seq` ()
lib/Data/Time/Calendar/Days.hs view
@@ -1,31 +1,24 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.Calendar.Days (- -- * Days- Day (..),- addDays,- diffDays,-- -- * DayPeriod- DayPeriod (..),- periodAllDays,- periodLength,- periodFromDay,- periodToDay,- periodToDayValid,-) where+module Data.Time.Calendar.Days where import Control.DeepSeq import Data.Data import Data.Ix+import Data.Time.Calendar.Private import GHC.Generics+#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 { toModifiedJulianDay :: Integer }- deriving (Eq, Ord, Data, Typeable, TH.Lift, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData Day where rnf (ModifiedJulianDay a) = rnf a@@ -72,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@@ -96,6 +95,12 @@ -- @since 1.12.1 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 -- | Validating inverse of 'periodFromDay'. --
lib/Data/Time/Calendar/Gregorian.hs view
@@ -1,55 +1,14 @@ {-# LANGUAGE Safe #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS -fno-warn-orphans #-} -module Data.Time.Calendar.Gregorian (- -- * 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,- pattern YearMonthDay,- fromGregorianValid,- showGregorian,- gregorianMonthLength,- -- calendrical arithmetic- -- e.g. "one month after March 31st"- addGregorianMonthsClip,- addGregorianMonthsRollOver,- addGregorianYearsClip,- addGregorianYearsRollOver,- addGregorianDurationClip,- addGregorianDurationRollOver,- diffGregorianDurationClip,- diffGregorianDurationRollOver,- -- re-exported from OrdinalDate- isLeapYear,-) where+module Data.Time.Calendar.Gregorian where import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days import Data.Time.Calendar.MonthDay import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private-import Data.Time.Calendar.Types -- | Convert to proleptic Gregorian calendar. toGregorian :: Day -> (Year, MonthOfYear, DayOfMonth)@@ -131,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@@ -155,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
lib/Data/Time/Calendar/Julian.hs view
@@ -17,6 +17,8 @@ pattern December, DayOfMonth, DayOfYear,++ -- * Year and day format module Data.Time.Calendar.JulianYearDay, toJulian, fromJulian,
lib/Data/Time/Calendar/JulianYearDay.hs view
@@ -1,9 +1,6 @@ {-# LANGUAGE Safe #-} -module Data.Time.Calendar.JulianYearDay (- -- * Year and day format- module Data.Time.Calendar.JulianYearDay,-) where+module Data.Time.Calendar.JulianYearDay where import Data.Time.Calendar.Days import Data.Time.Calendar.Private
lib/Data/Time/Calendar/Month.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | An absolute count of common calendar months.@@ -18,14 +19,19 @@ import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.Private+import Data.Time.Calendar.Types import GHC.Generics+#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 -- | An absolute count of common calendar months. -- Number is equal to @(year * 12) + (monthOfYear - 1)@.-newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable, TH.Lift, Generic)+newtype Month = MkMonth Integer deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData Month where rnf (MkMonth m) = rnf m@@ -74,7 +80,7 @@ -- Invalid months of year will be clipped to the correct range. pattern YearMonth :: Year -> MonthOfYear -> Month pattern YearMonth y my <-- MkMonth ((\m -> divMod' m 12) -> (y, succ . fromInteger -> my))+ MkMonth ((\m -> divMod' m 12) -> (y, (succ . fromInteger -> my))) where YearMonth y my = MkMonth $ (y * 12) + toInteger (pred $ clip 1 12 my) @@ -91,7 +97,7 @@ pattern MonthDay m dm <- (periodFromDay -> (m, dm)) where- MonthDay = periodToDay+ MonthDay = periodToDayClip fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day fromMonthDayValid = periodToDayValid
lib/Data/Time/Calendar/Quarter.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | Year quarters.@@ -23,12 +24,16 @@ import Data.Time.Calendar.Private import Data.Time.Calendar.Types import GHC.Generics+#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 -- | Quarters of each year. Each quarter corresponds to three months.-data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Data, Typeable, Read, Show, Ix, TH.Lift, Generic)+data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Read, Show, Ix, Typeable, Data, Generic, TH.Lift) -- | maps Q1..Q4 to 1..4 instance Enum QuarterOfYear where@@ -55,7 +60,7 @@ -- | An absolute count of year quarters. -- Number is equal to @(year * 4) + (quarterOfYear - 1)@.-newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable, Generic)+newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData Quarter where rnf (MkQuarter m) = rnf m@@ -113,7 +118,7 @@ -- | Bidirectional abstract constructor. pattern YearQuarter :: Year -> QuarterOfYear -> Quarter pattern YearQuarter y qy <-- MkQuarter ((\q -> divMod' q 4) -> (y, toEnum . succ . fromInteger -> qy))+ MkQuarter ((\q -> divMod' q 4) -> (y, (toEnum . succ . fromInteger -> qy))) where YearQuarter y qy = MkQuarter $ (y * 4) + toInteger (pred $ fromEnum qy) @@ -142,6 +147,6 @@ pattern QuarterDay q dq <- (periodFromDay -> (q, dq)) where- QuarterDay = periodToDay+ QuarterDay = periodToDayClip {-# COMPLETE QuarterDay #-}
lib/Data/Time/Calendar/Week.hs view
@@ -1,15 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.Calendar.Week (- -- * Week- DayOfWeek (..),- dayOfWeek,- dayOfWeekDiff,- firstDayOfWeekOnAfter,- weekAllDays,- weekFirstDay,- weekLastDay,-) where+module Data.Time.Calendar.Week where import Control.DeepSeq import Data.Data@@ -17,7 +9,11 @@ import Data.Ix import Data.Time.Calendar.Days import GHC.Generics+#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@@ -27,7 +23,7 @@ | Friday | Saturday | Sunday- deriving (Eq, Show, Read, Data, Typeable, Ord, Ix, TH.Lift, Generic)+ deriving (Eq, Ord, Ix, Show, Read, Typeable, Data, Generic, TH.Lift) instance NFData DayOfWeek where rnf Monday = ()
lib/Data/Time/Calendar/WeekDate.hs view
@@ -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+#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@@ -124,7 +129,7 @@ -- Invalid week values will be clipped to the correct range. pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day pattern YearWeekDay y wy dw <-- (toWeekDate -> (y, wy, toEnum -> dw))+ (toWeekDate -> (y, wy, (toEnum -> dw))) where YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw)
lib/Data/Time/Clock.hs view
@@ -2,10 +2,37 @@ -- | Types and functions for UTC and UT1 module Data.Time.Clock (- module Data.Time.Clock.Internal.UniversalTime,- module Data.Time.Clock.Internal.DiffTime,- module Data.Time.Clock.Internal.UTCTime,- module Data.Time.Clock.Internal.NominalDiffTime,+ -- * Universal Time++ -- | Time as measured by the Earth.+ UniversalTime (..),++ -- * Absolute intervals+ DiffTime,+ pattern Picoseconds,+ pattern Seconds,+ pattern Minutes,+ pattern Hours,+ secondsToDiffTime,+ picosecondsToDiffTime,+ diffTimeToPicoseconds,++ -- * UTC++ -- | UTC is time as measured by a clock, corrected to keep pace with the earth by adding or removing+ -- occasional seconds, known as \"leap seconds\".+ -- These corrections are not predictable and are announced with six month's notice.+ -- No table of these corrections is provided, as any program compiled with it would become+ -- out of date in six months.+ --+ -- If you don't care about leap seconds, use 'UTCTime' and 'NominalDiffTime' for your clock calculations,+ -- and you'll be fine.+ UTCTime (..),+ NominalDiffTime,+ pattern Nominal,+ secondsToNominalDiffTime,+ nominalDiffTimeToSeconds,+ nominalDay, module Data.Time.Clock.Internal.UTCDiff, getCurrentTime, getTime_resolution,
lib/Data/Time/Clock/Internal/AbsoluteTime.hs view
@@ -1,25 +1,23 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -- | TAI and leap-second maps for converting to UTC: most people won't need this module.-module Data.Time.Clock.Internal.AbsoluteTime (- -- TAI arithmetic- AbsoluteTime,- taiEpoch,- addAbsoluteTime,- diffAbsoluteTime,- taiNominalDayStart,-) where+module Data.Time.Clock.Internal.AbsoluteTime where import Control.DeepSeq import Data.Data import Data.Time.Calendar.Days import Data.Time.Clock.Internal.DiffTime+#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 = MkAbsoluteTime DiffTime- deriving (Eq, Ord, Data, Typeable, TH.Lift)+ deriving (Eq, Ord, Typeable, Data, TH.Lift) instance NFData AbsoluteTime where rnf (MkAbsoluteTime a) = rnf a
lib/Data/Time/Clock/Internal/CTimespec.hsc view
@@ -6,7 +6,7 @@ #include "HsTimeConfig.h" -#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME+#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME && !defined(__MHS__) import Foreign import Foreign.C@@ -34,18 +34,31 @@ foreign import ccall unsafe "time.h clock_gettime" clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt-foreign import ccall unsafe "time.h clock_getres"- clock_getres :: ClockID -> Ptr CTimespec -> IO CInt -#else+#else /* defined(javascript_HOST_ARCH) */ foreign import capi unsafe "time.h clock_gettime" clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt++#endif /* defined(javascript_HOST_ARCH) */++-- | Get the current time from the given clock.+clockGetTime :: ClockID -> IO CTimespec+clockGetTime clockid = alloca (\ptspec -> do+ throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime clockid ptspec+ peek ptspec+ )++#if defined(javascript_HOST_ARCH)++clockGetRes :: ClockID -> IO (Either Errno CTimespec)+clockGetRes _ = return $ Right $ MkCTimespec 0 0++#else /* defined(javascript_HOST_ARCH) */+ foreign import capi unsafe "time.h clock_getres" clock_getres :: ClockID -> Ptr CTimespec -> IO CInt -#endif- -- | Get the resolution of the given clock. clockGetRes :: ClockID -> IO (Either Errno CTimespec) clockGetRes clockid = alloca $ \ptspec -> do@@ -58,28 +71,23 @@ errno <- getErrno return $ Left errno --- | Get the current time from the given clock.-clockGetTime :: ClockID -> IO CTimespec-clockGetTime clockid = alloca (\ptspec -> do- throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime clockid ptspec- peek ptspec- )+#endif /* defined(javascript_HOST_ARCH) */ #if defined(javascript_HOST_ARCH) -- JS backend doesn't support foreign imports with capi convention clock_REALTIME :: ClockID clock_REALTIME = #{const CLOCK_REALTIME}-#else+#else /* defined(javascript_HOST_ARCH) */ foreign import capi unsafe "HsTime.h value HS_CLOCK_REALTIME" clock_REALTIME :: ClockID-#endif+#endif /* defined(javascript_HOST_ARCH) */ clock_TAI :: Maybe ClockID clock_TAI = #if defined(CLOCK_TAI) Just #{const CLOCK_TAI}-#else+#else /* defined(CLOCK_TAI) */ Nothing-#endif+#endif /* defined(CLOCK_TAI) */ realtimeRes :: CTimespec realtimeRes = unsafePerformIO $ do@@ -95,4 +103,5 @@ Left _ -> return Nothing Right res -> return $ Just res -#endif+#endif /* !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME */+
lib/Data/Time/Clock/Internal/CTimeval.hs view
@@ -26,7 +26,7 @@ pokeElemOff (castPtr p) 0 s pokeElemOff (castPtr p) 1 mus -#if defined(javascript_HOST_ARCH)+#if defined(javascript_HOST_ARCH) || defined(__MHS__) foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt
lib/Data/Time/Clock/Internal/DiffTime.hs view
@@ -1,23 +1,21 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -module Data.Time.Clock.Internal.DiffTime (- -- * Absolute intervals- DiffTime,- secondsToDiffTime,- picosecondsToDiffTime,- diffTimeToPicoseconds,-) where+module Data.Time.Clock.Internal.DiffTime where import Control.DeepSeq import Data.Data import Data.Fixed+#ifdef __GLASGOW_HASKELL__ import GHC.Read+#endif+#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+import Text.Read -- | This is a length of time, as measured by a clock. -- Conversion functions such as 'fromInteger' and 'realToFrac' will treat it as seconds.@@ -26,7 +24,7 @@ -- It has a precision of one picosecond (= 10^-12 s). Enumeration functions will treat it as picoseconds. newtype DiffTime = MkDiffTime Pico- deriving (Eq, Ord, Data, Typeable)+ deriving (Eq, Ord, Typeable, Data, TH.Lift) instance NFData DiffTime where rnf (MkDiffTime t) = rnf t@@ -78,10 +76,31 @@ ceiling (MkDiffTime a) = ceiling a floor (MkDiffTime a) = floor a --- Let GHC derive the instances when 'Fixed' has 'TH.Lift' instance.-instance TH.Lift DiffTime where- liftTyped :: TH.Quote m => DiffTime -> TH.Code m DiffTime- liftTyped (MkDiffTime (MkFixed a)) = [||MkDiffTime (MkFixed $$(TH.liftTyped a))||]+pattern Picoseconds :: Integer -> DiffTime+pattern Picoseconds a <- (diffTimeToPicoseconds -> a)+ where+ Picoseconds a = picosecondsToDiffTime a++{-# COMPLETE Picoseconds #-}++pattern Seconds :: Pico -> DiffTime+pattern Seconds a = MkDiffTime a++{-# COMPLETE Seconds #-}++pattern Minutes :: Pico -> DiffTime+pattern Minutes a <- Seconds ((/ 60) -> a)+ where+ Minutes a = Seconds $ a * 60++{-# COMPLETE Minutes #-}++pattern Hours :: Pico -> DiffTime+pattern Hours a <- Minutes ((/ 60) -> a)+ where+ Hours a = Minutes $ a * 60++{-# COMPLETE Hours #-} -- | Create a 'DiffTime' which represents an integral number of seconds. secondsToDiffTime :: Integer -> DiffTime
lib/Data/Time/Clock/Internal/NominalDiffTime.hs view
@@ -1,38 +1,46 @@-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -module Data.Time.Clock.Internal.NominalDiffTime (- NominalDiffTime,- secondsToNominalDiffTime,- nominalDiffTimeToSeconds,- nominalDay,-) where+module Data.Time.Clock.Internal.NominalDiffTime where import Control.DeepSeq import Data.Data import Data.Fixed+#ifdef __GLASGOW_HASKELL__ import GHC.Read+#endif+import Data.Time.Clock.Internal.DiffTime+#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 -- | This is a length of time, as measured by UTC.--- It has a precision of 10^-12 s.+-- It has a precision of one picosecond (10^-12 s). -- -- Conversion functions such as 'fromInteger' and 'realToFrac' will treat it as seconds. -- For example, @(0.010 :: NominalDiffTime)@ corresponds to 10 milliseconds. ----- It has a precision of one picosecond (= 10^-12 s). Enumeration functions will treat it as picoseconds.+-- Enumeration functions will treat it as picoseconds. -- -- It ignores leap-seconds, so it's not necessarily a fixed amount of clock time. -- For instance, 23:00 UTC + 2 hours of NominalDiffTime = 01:00 UTC (+ 1 day), -- regardless of whether a leap-second intervened. newtype NominalDiffTime = MkNominalDiffTime Pico- deriving (Eq, Ord, Data, Typeable)+ deriving (Eq, Ord, Typeable, Data, TH.Lift) +-- | convert from DiffTime+pattern Nominal :: DiffTime -> NominalDiffTime+pattern Nominal dt <- MkNominalDiffTime (realToFrac -> dt)+ where+ Nominal dt = MkNominalDiffTime $ realToFrac dt++{-# COMPLETE Nominal #-}+ -- | Create a 'NominalDiffTime' from a number of seconds. -- -- @since 1.9.1@@ -44,11 +52,6 @@ -- @since 1.9.1 nominalDiffTimeToSeconds :: NominalDiffTime -> Pico nominalDiffTimeToSeconds (MkNominalDiffTime t) = t---- Let GHC derive the instances when 'Fixed' has 'TH.Lift' instance.-instance TH.Lift NominalDiffTime where- liftTyped :: TH.Quote m => NominalDiffTime -> TH.Code m NominalDiffTime- liftTyped (MkNominalDiffTime (MkFixed a)) = [||MkNominalDiffTime (MkFixed $$(TH.liftTyped a))||] instance NFData NominalDiffTime where rnf (MkNominalDiffTime t) = rnf t
lib/Data/Time/Clock/Internal/SystemTime.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} +#if !defined(__MHS__) #include "HsTimeConfig.h"+#endif #if defined(mingw32_HOST_OS) || !defined(HAVE_CLOCK_GETTIME) {-# LANGUAGE Safe #-}@@ -21,11 +23,15 @@ import Data.Time.Clock.Internal.DiffTime import Data.Word import GHC.Generics+#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-#elif defined(HAVE_CLOCK_GETTIME)+#elif defined(HAVE_CLOCK_GETTIME) && !defined(__MHS__) import Data.Time.Clock.Internal.CTimespec import Foreign.C.Types (CLong(..), CTime(..)) #else@@ -41,7 +47,7 @@ { systemSeconds :: {-# UNPACK #-} !Int64 , systemNanoseconds :: {-# UNPACK #-} !Word32 }- deriving (Eq, Ord, Show, Data, Typeable, TH.Lift, Generic)+ deriving (Eq, Ord, Show, Typeable, Data, Generic, TH.Lift) instance NFData SystemTime where rnf a = a `seq` ()@@ -74,7 +80,7 @@ getTime_resolution = 100E-9 -- 100ns getTAISystemTime = Nothing-#elif defined(HAVE_CLOCK_GETTIME)+#elif defined(HAVE_CLOCK_GETTIME) && !defined(__MHS__) -- Use hi-res clock_gettime timespecToSystemTime :: CTimespec -> SystemTime timespecToSystemTime (MkCTimespec (CTime s) (CLong ns)) = (MkSystemTime (fromIntegral s) (fromIntegral ns))
lib/Data/Time/Clock/Internal/UTCTime.hs view
@@ -1,25 +1,18 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.Clock.Internal.UTCTime (- -- * UTC-- -- | UTC is time as measured by a clock, corrected to keep pace with the earth by adding or removing- -- occasional seconds, known as \"leap seconds\".- -- These corrections are not predictable and are announced with six month's notice.- -- No table of these corrections is provided, as any program compiled with it would become- -- out of date in six months.- --- -- If you don't care about leap seconds, use 'UTCTime' and 'NominalDiffTime' for your clock calculations,- -- and you'll be fine.- UTCTime (..),-) where+module Data.Time.Clock.Internal.UTCTime where import Control.DeepSeq import Data.Data import Data.Time.Calendar.Days import Data.Time.Clock.Internal.DiffTime import GHC.Generics+#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.@@ -30,16 +23,7 @@ , utctDayTime :: DiffTime -- ^ the time from midnight, 0 <= t < 86401s (because of leap-seconds) }- deriving (Data, Typeable, TH.Lift, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData UTCTime where rnf (UTCTime d t) = rnf d `seq` rnf t `seq` ()--instance Eq UTCTime where- (UTCTime da ta) == (UTCTime db tb) = (da == db) && (ta == tb)--instance Ord UTCTime where- compare (UTCTime da ta) (UTCTime db tb) =- case (compare da db) of- EQ -> compare ta tb- cmp -> cmp
lib/Data/Time/Clock/Internal/UniversalTime.hs view
@@ -1,23 +1,23 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.Clock.Internal.UniversalTime (- -- * Universal Time-- -- | Time as measured by the Earth.- UniversalTime (..),-) where+module Data.Time.Clock.Internal.UniversalTime where import Control.DeepSeq import Data.Data import GHC.Generics+#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. newtype UniversalTime = ModJulianDate { getModJulianDate :: Rational }- deriving (Eq, Ord, Data, Typeable, TH.Lift, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData UniversalTime where rnf (ModJulianDate a) = rnf a
lib/Data/Time/Clock/TAI.hs view
@@ -1,14 +1,19 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS -fno-warn-orphans #-} -- | TAI and leap-second maps for converting to UTC: most people won't need this module. module Data.Time.Clock.TAI (- -- TAI arithmetic- module Data.Time.Clock.Internal.AbsoluteTime,- -- leap-second map type+ -- * Absolute Time+ AbsoluteTime,+ taiEpoch,+ addAbsoluteTime,+ diffAbsoluteTime,+ taiNominalDayStart,++ -- * Leap-Second Map LeapSecondMap,- -- conversion between UTC and TAI with map utcDayLength, utcToTAITime, taiToUTCTime,@@ -23,6 +28,9 @@ import Data.Time.Clock.Internal.SystemTime import Data.Time.Clock.System import Data.Time.LocalTime+#ifdef __MHS__+import Data.Tuple.Instances+#endif instance Show AbsoluteTime where show t = show (utcToLocalTime utc (fromJust (taiToUTCTime (const (Just 0)) t))) ++ " TAI" -- ugly, but standard apparently
lib/Data/Time/Format.hs view
@@ -4,10 +4,25 @@ -- * UNIX-style formatting FormatTime (), formatTime,- module Data.Time.Format.Parse,++ -- * UNIX-style parsing+ parseTimeM,+ parseTimeMultipleM,+ parseTimeOrError,+ readSTime,+ readPTime,+ ParseTime (),++ -- * Locale+ TimeLocale (..),+ defaultTimeLocale,+ iso8601DateFormat,+ rfc822DateFormat, ) where import Data.Time.Format.Format.Class import Data.Time.Format.Format.Instances () import Data.Time.Format.ISO8601 ()+import Data.Time.Format.Locale import Data.Time.Format.Parse+import Data.Time.Format.Parse.Class
lib/Data/Time/Format/Format/Class.hs view
@@ -211,15 +211,26 @@ -- -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@ ----- === 'Month'--- For 'Month' (and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):+-- === 'QuarterOfYear'+-- For 'QuarterOfYear' (and 'Quarter' and 'Month' and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): --+-- [@%v@] quarter number, @1@ - @4@+--+-- === 'Quarter'+-- For 'Quarter' (and 'Month' and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):+-- -- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars -- -- [@%y@] year of century, 0-padded to two chars, @00@ - @99@ -- -- [@%C@] century, no padding. Note @%0C@ and @%_C@ pad to two chars --+-- [@%v@] quarter number, @1@ - @4@+--+--+-- === 'Month'+-- For 'Month' (and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):+-- -- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@ -- -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@@@ -241,9 +252,13 @@ -- -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@ ----- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars+-- [@%G@] year for ISO 8601 Week Date format. Note @%0G@ and @%_G@ pad to four chars ----- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@+-- [@%g@] year of century for ISO 8601 Week Date format, 0-padded to two chars, @00@ - @99@+--+-- [@%f@] century for ISO 8601 Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars+--+-- [@%V@] week of year for ISO 8601 Week Date format, 0-padded to two chars, @01@ - @53@ -- -- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@ --
lib/Data/Time/Format/Format/Instances.hs view
@@ -15,6 +15,7 @@ import Data.Time.Calendar.Month import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private+import Data.Time.Calendar.Quarter import Data.Time.Calendar.Week import Data.Time.Calendar.WeekDate import Data.Time.Clock.Internal.DiffTime@@ -110,11 +111,20 @@ formatCharacter _ 'A' = Just $ formatString $ \locale wd -> fst $ (wDays locale) !! (mod (fromEnum wd) 7) formatCharacter _ _ = Nothing -instance FormatTime Month where+instance FormatTime QuarterOfYear where+ -- Quarter of Year+ formatCharacter _ 'v' = Just $ formatNumber False 1 '0' fromEnum+ formatCharacter _ _ = Nothing++instance FormatTime Quarter where -- Year Count- formatCharacter _ 'Y' = Just $ formatNumber False 4 '0' $ \(YearMonth y _) -> y- formatCharacter _ 'y' = Just $ formatNumber True 2 '0' $ \(YearMonth y _) -> mod100 y- formatCharacter _ 'C' = Just $ formatNumber False 2 '0' $ \(YearMonth y _) -> div100 y+ formatCharacter _ 'Y' = Just $ formatNumber False 4 '0' $ \(YearQuarter y _) -> y+ formatCharacter _ 'y' = Just $ formatNumber True 2 '0' $ \(YearQuarter y _) -> mod100 y+ formatCharacter _ 'C' = Just $ formatNumber False 2 '0' $ \(YearQuarter y _) -> div100 y+ -- Default+ formatCharacter alt c = mapFormatCharacter (\(YearQuarter _ q) -> q) $ formatCharacter alt c++instance FormatTime Month where -- Month of Year formatCharacter _ 'B' = Just $ formatString $ \locale (YearMonth _ my) -> fst $ (months locale) !! (my - 1)@@ -124,7 +134,7 @@ Just $ formatString $ \locale (YearMonth _ my) -> snd $ (months locale) !! (my - 1) formatCharacter _ 'm' = Just $ formatNumber True 2 '0' $ \(YearMonth _ m) -> m -- Default- formatCharacter _ _ = Nothing+ formatCharacter alt c = mapFormatCharacter monthQuarter $ formatCharacter alt c instance FormatTime Day where -- Aggregate
lib/Data/Time/Format/ISO8601.hs view
@@ -276,7 +276,7 @@ -- | @xZ@ [ISO 8601:2004(E) sec. 4.2.4] withUTCDesignator :: Format t -> Format t-withUTCDesignator f = f <** literalFormat "Z"+withUTCDesignator f = f <** specialCaseReadFormat ((), "") (literalFormat "Z") -- | @±hh:mm@ (extended), @±hhmm@ (basic) [ISO 8601:2004(E) sec. 4.2.5.1] timeOffsetFormat :: FormatExtension -> Format TimeZone@@ -295,8 +295,10 @@ (signum mm, Right (h, m)) digits2 = integerFormat NoSign (Just 2) in- isoMap toTimeZone fromTimeZone $- mandatorySignFormat <**> (digits2 <++> extColonFormat fe digits2 digits2)+ specialCaseReadFormat (utc, "") $+ specialCaseReadFormat (utc, "Z") $+ isoMap toTimeZone fromTimeZone $+ mandatorySignFormat <**> (digits2 <++> extColonFormat fe digits2 digits2) -- | @hh:mm:ss±hh:mm@ (extended), @hhmmss±hhmm@ (basic) [ISO 8601:2004(E) sec. 4.2.5.2] timeOfDayAndOffsetFormat :: FormatExtension -> Format (TimeOfDay, TimeZone)
lib/Data/Time/Format/Locale.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE Safe #-} -- Note: this file derives from old-locale:System.Locale.hs, which is copyright (c) The University of Glasgow 2001-module Data.Time.Format.Locale (- TimeLocale (..),- defaultTimeLocale,- iso8601DateFormat,- rfc822DateFormat,-) where+module Data.Time.Format.Locale where import Data.Time.LocalTime.Internal.TimeZone
lib/Data/Time/Format/Parse.hs view
@@ -2,18 +2,7 @@ {-# OPTIONS -fno-warn-orphans #-} -module Data.Time.Format.Parse (- -- * UNIX-style parsing- parseTimeM,- parseTimeMultipleM,- parseTimeOrError,- readSTime,- readPTime,- ParseTime (),-- -- * Locale- module Data.Time.Format.Locale,-) where+module Data.Time.Format.Parse where import Control.Monad.Fail import Data.Char
lib/Data/Time/Format/Parse/Class.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE Safe #-} module Data.Time.Format.Parse.Class (- -- * Parsing ParseNumericPadding (..), ParseTime (..), parseSpecifiers,@@ -194,6 +193,8 @@ -- year of century 'y' -> parseDigitsUsual ZeroPadding 2 'g' -> parseDigitsUsual ZeroPadding 2+ -- quarter of year+ 'v' -> parseDigitsUsual ZeroPadding 1 -- month of year 'B' -> oneOf (map fst (months l)) 'b' -> oneOf (map snd (months l))
lib/Data/Time/Format/Parse/Instances.hs view
@@ -10,6 +10,7 @@ import Data.Char import Data.Fixed import Data.List (elemIndex, find)+import Data.Maybe import Data.Ratio import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days@@ -17,6 +18,8 @@ import Data.Time.Calendar.Month import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private (clipValid)+import Data.Time.Calendar.Quarter+import Data.Time.Calendar.Types import Data.Time.Calendar.WeekDate import Data.Time.Clock.Internal.DiffTime import Data.Time.Clock.Internal.NominalDiffTime@@ -33,24 +36,98 @@ import Data.Traversable import Text.Read (readMaybe) -data DayComponent- = DCCentury Integer -- century of all years- | DCCenturyYear Integer -- 0-99, last two digits of both real years and week years- | DCYearMonth MonthOfYear -- 1-12- | DCMonthDay DayOfMonth -- 1-31- | DCYearDay DayOfYear -- 1-366- | DCWeekDay Int -- 1-7 (mon-sun)- | DCYearWeek- WeekType- WeekOfYear -- 1-53 or 0-53- data WeekType = ISOWeek | SundayWeek | MondayWeek+ deriving Eq -makeDayComponent :: TimeLocale -> Char -> String -> Maybe [DayComponent]-makeDayComponent l c x =+mkDayFromWeekType :: WeekType -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day+mkDayFromWeekType wt y woy dow =+ case wt of+ ISOWeek -> fromWeekDateValid y woy $ fromEnum dow+ SundayWeek -> fromSundayStartWeekValid y woy $ mod (fromEnum dow) 7+ MondayWeek -> fromMondayStartWeekValid y woy $ fromEnum dow++data DayFact+ = CenturyDayFact Integer -- century of all years+ | YearOfCenturyDayFact Integer -- 0-99, last two digits of both real years and week years+ | QuarterOfYearDayFact QuarterOfYear+ | MonthOfYearDayFact MonthOfYear -- 1-12+ | DayOfMonthDayFact DayOfMonth -- 1-31+ | DayOfYearDayFact DayOfYear -- 1-366+ | DayOfWeekDayFact DayOfWeek+ | WeekOfYearDayFact+ WeekType+ WeekOfYear -- 1-53 or 0-53+ | UTCTimeDayFact UTCTime+ | TimeZoneDayFact TimeZone++lastMatch :: (a -> Maybe b) -> [a] -> Maybe b+lastMatch f aa = listToMaybe $ reverse $ catMaybes $ fmap f aa++dayFactGetCentury :: [DayFact] -> Maybe Integer+dayFactGetCentury = lastMatch $ \case+ CenturyDayFact x -> Just x+ _ -> Nothing++dayFactGetYearOfCentury :: [DayFact] -> Maybe Integer+dayFactGetYearOfCentury = lastMatch $ \case+ YearOfCenturyDayFact x -> Just x+ _ -> Nothing++dayFactGetQuarterOfYear :: [DayFact] -> Maybe QuarterOfYear+dayFactGetQuarterOfYear = lastMatch $ \case+ QuarterOfYearDayFact x -> Just x+ _ -> Nothing++dayFactGetMonthOfYear :: [DayFact] -> Maybe MonthOfYear+dayFactGetMonthOfYear = lastMatch $ \case+ MonthOfYearDayFact x -> Just x+ _ -> Nothing++dayFactGetDayOfMonth :: [DayFact] -> Maybe DayOfMonth+dayFactGetDayOfMonth = lastMatch $ \case+ DayOfMonthDayFact x -> Just x+ _ -> Nothing++dayFactGetDayOfYear :: [DayFact] -> Maybe DayOfYear+dayFactGetDayOfYear = lastMatch $ \case+ DayOfYearDayFact x -> Just x+ _ -> Nothing++dayFactGetDayOfWeek :: [DayFact] -> Maybe DayOfWeek+dayFactGetDayOfWeek = lastMatch $ \case+ DayOfWeekDayFact x -> Just x+ _ -> Nothing++dayFactGetWeekOfYear :: [DayFact] -> Maybe (WeekType, WeekOfYear)+dayFactGetWeekOfYear = lastMatch $ \case+ WeekOfYearDayFact wt x -> Just (wt, x)+ _ -> Nothing++dayFactGetUTCTime :: [DayFact] -> Maybe UTCTime+dayFactGetUTCTime = lastMatch $ \case+ UTCTimeDayFact x -> Just x+ _ -> Nothing++dayFactGetTimeZone :: [DayFact] -> Maybe TimeZone+dayFactGetTimeZone = lastMatch $ \case+ TimeZoneDayFact x -> Just x+ _ -> Nothing++readSpec_z :: String -> Maybe Int+readSpec_z = readTzOffset++readSpec_Z :: TimeLocale -> String -> Maybe TimeZone+readSpec_Z _ str | Just offset <- readTzOffset str = Just $ TimeZone offset False ""+readSpec_Z l str | Just zone <- getKnownTimeZone l str = Just zone+readSpec_Z _ "UTC" = Just utc+readSpec_Z _ [c] | Just zone <- getMilZone c = Just zone+readSpec_Z _ _ = Nothing++makeDayFact :: TimeLocale -> Char -> String -> Maybe [DayFact]+makeDayFact l c x = let ra :: Read a => Maybe a ra = readMaybe x@@ -65,177 +142,214 @@ -- %C: century (all but the last two digits of the year), 00 - 99 'C' -> do a <- ra- return [DCCentury a]+ return [CenturyDayFact a] -- %f century (all but the last two digits of the year), 00 - 99 'f' -> do a <- ra- return [DCCentury a]+ return [CenturyDayFact a] -- %Y: year 'Y' -> do a <- ra- return [DCCentury (a `div` 100), DCCenturyYear (a `mod` 100)]+ return [CenturyDayFact (a `div` 100), YearOfCenturyDayFact (a `mod` 100)] -- %G: year for Week Date format 'G' -> do a <- ra- return [DCCentury (a `div` 100), DCCenturyYear (a `mod` 100)]+ return [CenturyDayFact (a `div` 100), YearOfCenturyDayFact (a `mod` 100)] -- %y: last two digits of year, 00 - 99 'y' -> do a <- ra- return [DCCenturyYear a]+ return [YearOfCenturyDayFact a] -- %g: last two digits of year for Week Date format, 00 - 99 'g' -> do a <- ra- return [DCCenturyYear a]+ return [YearOfCenturyDayFact a]+ -- %v: quarter of year, 1 - 4+ 'v' -> do+ raw <- ra+ a <- clipValid 1 4 raw+ return [QuarterOfYearDayFact $ toEnum a] -- %B: month name, long form (fst from months locale), January - December 'B' -> do a <- oneBasedListIndex $ fmap fst $ months l- return [DCYearMonth a]+ return [MonthOfYearDayFact a] -- %b: month name, short form (snd from months locale), Jan - Dec 'b' -> do a <- oneBasedListIndex $ fmap snd $ months l- return [DCYearMonth a]+ return [MonthOfYearDayFact a] -- %m: month of year, leading 0 as needed, 01 - 12 'm' -> do raw <- ra a <- clipValid 1 12 raw- return [DCYearMonth a]+ return [MonthOfYearDayFact a] -- %d: day of month, leading 0 as needed, 01 - 31 'd' -> do raw <- ra a <- clipValid 1 31 raw- return [DCMonthDay a]+ return [DayOfMonthDayFact a] -- %e: day of month, leading space as needed, 1 - 31 'e' -> do raw <- ra a <- clipValid 1 31 raw- return [DCMonthDay a]+ return [DayOfMonthDayFact a] -- %V: week for Week Date format, 01 - 53 'V' -> do raw <- ra a <- clipValid 1 53 raw- return [DCYearWeek ISOWeek a]+ return [WeekOfYearDayFact ISOWeek a] -- %U: week number of year, where weeks start on Sunday (as sundayStartWeek), 00 - 53 'U' -> do raw <- ra a <- clipValid 0 53 raw- return [DCYearWeek SundayWeek a]+ return [WeekOfYearDayFact SundayWeek a] -- %W: week number of year, where weeks start on Monday (as mondayStartWeek), 00 - 53 'W' -> do raw <- ra a <- clipValid 0 53 raw- return [DCYearWeek MondayWeek a]+ return [WeekOfYearDayFact MondayWeek a] -- %u: day for Week Date format, 1 - 7 'u' -> do raw <- ra a <- clipValid 1 7 raw- return [DCWeekDay a]+ return [DayOfWeekDayFact $ toEnum a] -- %a: day of week, short form (snd from wDays locale), Sun - Sat 'a' -> do- a' <- zeroBasedListIndex $ fmap snd $ wDays l- let- a =- if a' == 0- then 7- else a'- return [DCWeekDay a]+ a <- zeroBasedListIndex $ fmap snd $ wDays l+ return [DayOfWeekDayFact $ toEnum a] -- %A: day of week, long form (fst from wDays locale), Sunday - Saturday 'A' -> do- a' <- zeroBasedListIndex $ fmap fst $ wDays l- let- a =- if a' == 0- then 7- else a'- return [DCWeekDay a]+ a <- zeroBasedListIndex $ fmap fst $ wDays l+ return [DayOfWeekDayFact $ toEnum a] -- %w: day of week number, 0 (= Sunday) - 6 (= Saturday) 'w' -> do raw <- ra- a' <- clipValid 0 6 raw- let- a =- if a' == 0- then 7- else a'- return [DCWeekDay a]+ a <- clipValid 0 6 raw+ return [DayOfWeekDayFact $ toEnum a] -- %j: day of year for Ordinal Date format, 001 - 366 'j' -> do raw <- ra a <- clipValid 1 366 raw- return [DCYearDay a]+ return [DayOfYearDayFact a]+ -- %s: number of whole seconds since the Unix epoch.+ 's' -> do+ raw <- ra+ return [UTCTimeDayFact $ posixSecondsToUTCTime $ fromInteger raw]+ 'z' -> do+ a <- readSpec_z x+ return [TimeZoneDayFact $ TimeZone a False ""]+ 'Z' -> do+ a <- readSpec_Z l x+ return [TimeZoneDayFact a] -- unrecognised, pass on to other parsers _ -> return [] -makeDayComponents :: TimeLocale -> [(Char, String)] -> Maybe [DayComponent]-makeDayComponents l pairs = do- components <- for pairs $ \(c, x) -> makeDayComponent l c x- return $ concat components+makeDayFacts :: TimeLocale -> [(Char, String)] -> Maybe [DayFact]+makeDayFacts l pairs = do+ factss <- for pairs $ \(c, x) -> makeDayFact l c x+ return $ mconcat factss -safeLast :: a -> [a] -> a-safeLast x xs = last (x : xs)+dayFactYear :: [DayFact] -> Integer+dayFactYear facts =+ let+ d = fromMaybe 70 $ dayFactGetYearOfCentury facts+ c =+ fromMaybe+ ( if d >= 69+ then 19+ else 20+ )+ $ dayFactGetCentury facts+ in+ 100 * c + d -instance ParseTime Day where- substituteTimeSpecifier _ = timeSubstituteTimeSpecifier- parseTimeSpecifier _ = timeParseTimeSpecifier- buildTime l pairs = do- cs <- makeDayComponents l pairs- -- 'Nothing' indicates a parse failure,- -- while 'Just []' means no information- let- y =+dayFactDay :: [DayFact] -> Maybe Day+dayFactDay facts =+ case dayFactYear facts of+ y | Just doy <- dayFactGetDayOfYear facts -> fromOrdinalDateValid y doy+ y+ | Just moy <- dayFactGetMonthOfYear facts -> let- d = safeLast 70 [x | DCCenturyYear x <- cs]- c =- safeLast- ( if d >= 69- then 19- else 20- )- [x | DCCentury x <- cs]+ dom = fromMaybe 1 $ dayFactGetDayOfMonth facts in- 100 * c + d- rest (DCYearMonth m : _) =+ fromGregorianValid y moy dom+ y+ | Just (wt, woy) <- dayFactGetWeekOfYear facts -> let- d = safeLast 1 [x | DCMonthDay x <- cs]+ dow = fromMaybe Thursday $ dayFactGetDayOfWeek facts in- fromGregorianValid y m d- rest (DCYearDay d : _) = fromOrdinalDateValid y d- rest (DCYearWeek wt w : _) =+ mkDayFromWeekType wt y woy dow+ y+ | Just qoy <- dayFactGetQuarterOfYear facts -> let- d = safeLast 4 [x | DCWeekDay x <- cs]+ moy = case qoy of+ Q1 -> 1+ Q2 -> 4+ Q3 -> 7+ Q4 -> 10+ dom = fromMaybe 1 $ dayFactGetDayOfMonth facts in- case wt of- ISOWeek -> fromWeekDateValid y w d- SundayWeek -> fromSundayStartWeekValid y w (d `mod` 7)- MondayWeek -> fromMondayStartWeekValid y w d- rest (_ : xs) = rest xs- rest [] = rest [DCYearMonth 1]- rest cs+ fromGregorianValid y moy dom+ _+ | Just ut <- dayFactGetUTCTime facts ->+ let+ tz = fromMaybe utc $ dayFactGetTimeZone facts+ in+ Just $ localDay $ utcToLocalTime tz ut+ y | Just dom <- dayFactGetDayOfMonth facts -> fromGregorianValid y 1 dom+ y | Just dow <- dayFactGetDayOfWeek facts -> fromWeekDateValid y 1 $ fromEnum dow+ y -> fromOrdinalDateValid y 1 +instance ParseTime Day where+ substituteTimeSpecifier _ = timeSubstituteTimeSpecifier+ parseTimeSpecifier _ = timeParseTimeSpecifier+ buildTime l pairs = do+ facts <- makeDayFacts l pairs+ dayFactDay facts++instance ParseTime DayOfWeek where+ substituteTimeSpecifier _ = timeSubstituteTimeSpecifier+ parseTimeSpecifier _ = timeParseTimeSpecifier+ buildTime l pairs = do+ facts <- makeDayFacts l pairs+ dayFactGetDayOfWeek facts+ <|> (fmap dayOfWeek $ dayFactDay facts)+ instance ParseTime Month where substituteTimeSpecifier _ = timeSubstituteTimeSpecifier parseTimeSpecifier _ = timeParseTimeSpecifier buildTime l pairs = do- cs <- makeDayComponents l pairs- -- 'Nothing' indicates a parse failure,- -- while 'Just []' means no information- let- y =+ facts <- makeDayFacts l pairs+ case dayFactGetMonthOfYear facts of+ Just moy -> let- d = safeLast 70 [x | DCCenturyYear x <- cs]- c =- safeLast- ( if d >= 69- then 19- else 20- )- [x | DCCentury x <- cs]+ y = dayFactYear facts in- 100 * c + d- rest (DCYearMonth m : _) = fromYearMonthValid y m- rest (_ : xs) = rest xs- rest [] = fromYearMonthValid y 1- rest cs+ Just $ YearMonth y moy+ Nothing -> fmap dayPeriod $ dayFactDay facts +instance ParseTime QuarterOfYear where+ substituteTimeSpecifier _ = timeSubstituteTimeSpecifier+ parseTimeSpecifier _ = timeParseTimeSpecifier+ buildTime l pairs = do+ facts <- makeDayFacts l pairs+ case dayFactGetQuarterOfYear facts of+ Just qoy -> Just qoy+ Nothing -> do+ QuarterDay (YearQuarter _ qoy) _ <- dayFactDay facts+ return qoy++instance ParseTime Quarter where+ substituteTimeSpecifier _ = timeSubstituteTimeSpecifier+ parseTimeSpecifier _ = timeParseTimeSpecifier+ buildTime l pairs = do+ facts <- makeDayFacts l pairs+ case dayFactGetQuarterOfYear facts of+ Just qoy ->+ let+ y = dayFactYear facts+ in+ Just $ YearQuarter y qoy+ Nothing -> fmap dayPeriod $ dayFactDay facts+ mfoldl :: Monad m => (a -> b -> m a) -> m a -> [b] -> m a mfoldl f = let@@ -245,74 +359,150 @@ in foldl mf +data AMPM = AM | PM++data TimeFact+ = AMAPMTimeFact AMPM+ | HourTimeFact Int+ | MinuteTimeFact Int+ | WholeSecondTimeFact Int+ | FractSecondTimeFact Pico+ | UTCTimeFact UTCTime+ | ZoneTimeFact TimeZone++timeFactGetAMPM :: [TimeFact] -> Maybe AMPM+timeFactGetAMPM = lastMatch $ \case+ AMAPMTimeFact x -> Just x+ _ -> Nothing++timeFactGetHour :: [TimeFact] -> Maybe Int+timeFactGetHour = lastMatch $ \case+ HourTimeFact x -> Just x+ _ -> Nothing++timeFactGetMinute :: [TimeFact] -> Maybe Int+timeFactGetMinute = lastMatch $ \case+ MinuteTimeFact x -> Just x+ _ -> Nothing++timeFactGetWholeSecond :: [TimeFact] -> Maybe Int+timeFactGetWholeSecond = lastMatch $ \case+ WholeSecondTimeFact x -> Just x+ _ -> Nothing++timeFactGetFractSecond :: [TimeFact] -> Maybe Pico+timeFactGetFractSecond = lastMatch $ \case+ FractSecondTimeFact x -> Just x+ _ -> Nothing++timeFactGetUTC :: [TimeFact] -> Maybe UTCTime+timeFactGetUTC = lastMatch $ \case+ UTCTimeFact x -> Just x+ _ -> Nothing++timeFactGetZone :: [TimeFact] -> Maybe TimeZone+timeFactGetZone = lastMatch $ \case+ ZoneTimeFact x -> Just x+ _ -> Nothing++makeTimeFact :: TimeLocale -> Char -> String -> Maybe [TimeFact]+makeTimeFact l c x =+ let+ ra :: Read a => Maybe a+ ra = readMaybe x+ getAmPm =+ let+ upx = map toUpper x+ (amStr, pmStr) = amPm l+ in+ if upx == amStr+ then Just [AMAPMTimeFact AM]+ else+ if upx == pmStr+ then Just [AMAPMTimeFact PM]+ else Nothing+ in+ case c of+ 'P' -> getAmPm+ 'p' -> getAmPm+ 'H' -> do+ raw <- ra+ a <- clipValid 0 23 raw+ return [HourTimeFact a]+ 'I' -> do+ raw <- ra+ a <- clipValid 1 12 raw+ return [HourTimeFact a]+ 'k' -> do+ raw <- ra+ a <- clipValid 0 23 raw+ return [HourTimeFact a]+ 'l' -> do+ raw <- ra+ a <- clipValid 1 12 raw+ return [HourTimeFact a]+ 'M' -> do+ raw <- ra+ a <- clipValid 0 59 raw+ return [MinuteTimeFact a]+ 'S' -> do+ raw <- ra+ a <- clipValid 0 60 raw+ return [WholeSecondTimeFact $ fromInteger a]+ 'q' -> do+ ps <- (readMaybe $ take 12 $ rpad 12 '0' x) <|> return 0+ return [FractSecondTimeFact $ mkPico 0 ps]+ 'Q' ->+ if null x+ then return []+ else do+ ps <- (readMaybe $ take 12 $ rpad 12 '0' x) <|> return 0+ return [FractSecondTimeFact $ mkPico 0 ps]+ 's' -> do+ raw <- ra+ return [UTCTimeFact $ posixSecondsToUTCTime $ fromInteger raw]+ 'z' -> do+ a <- readSpec_z x+ return [ZoneTimeFact $ TimeZone a False ""]+ 'Z' -> do+ a <- readSpec_Z l x+ return [ZoneTimeFact a]+ _ -> return []++makeTimeFacts :: TimeLocale -> [(Char, String)] -> Maybe [TimeFact]+makeTimeFacts l pairs = do+ factss <- for pairs $ \(c, x) -> makeTimeFact l c x+ return $ mconcat factss+ instance ParseTime TimeOfDay where substituteTimeSpecifier _ = timeSubstituteTimeSpecifier parseTimeSpecifier _ = timeParseTimeSpecifier- buildTime l =- let- f t@(TimeOfDay h m s) (c, x) =+ buildTime l pairs = do+ facts <- makeTimeFacts l pairs+ -- 'Nothing' indicates a parse failure,+ -- while 'Just []' means no information+ case timeFactGetUTC facts of+ Just t -> let- ra :: Read a => Maybe a- ra = readMaybe x- getAmPm =- let- upx = map toUpper x- (amStr, pmStr) = amPm l- in- if upx == amStr- then Just $ TimeOfDay (h `mod` 12) m s- else- if upx == pmStr- then- Just $- TimeOfDay- ( if h < 12- then h + 12- else h- )- m- s- else Nothing+ zone = fromMaybe utc $ timeFactGetZone facts+ sf = fromMaybe 0 $ timeFactGetFractSecond facts+ TimeOfDay h m s = localTimeOfDay $ utcToLocalTime zone t in- case c of- 'P' -> getAmPm- 'p' -> getAmPm- 'H' -> do- raw <- ra- a <- clipValid 0 23 raw- return $ TimeOfDay a m s- 'I' -> do- raw <- ra- a <- clipValid 1 12 raw- return $ TimeOfDay a m s- 'k' -> do- raw <- ra- a <- clipValid 0 23 raw- return $ TimeOfDay a m s- 'l' -> do- raw <- ra- a <- clipValid 1 12 raw- return $ TimeOfDay a m s- 'M' -> do- raw <- ra- a <- clipValid 0 59 raw- return $ TimeOfDay h a s- 'S' -> do- raw <- ra- a <- clipValid 0 60 raw- return $ TimeOfDay h m (fromInteger a)- 'q' -> do- ps <- (readMaybe $ take 12 $ rpad 12 '0' x) <|> return 0- return $ TimeOfDay h m (mkPico (floor s) ps)- 'Q' ->- if null x- then Just t- else do- ps <- (readMaybe $ take 12 $ rpad 12 '0' x) <|> return 0- return $ TimeOfDay h m (mkPico (floor s) ps)- _ -> Just t- in- mfoldl f (Just midnight)+ return $ TimeOfDay h m $ s + sf+ Nothing ->+ let+ h = fromMaybe 0 $ timeFactGetHour facts+ m = fromMaybe 0 $ timeFactGetMinute facts+ si = fromMaybe 0 $ timeFactGetWholeSecond facts+ sf = fromMaybe 0 $ timeFactGetFractSecond facts+ s :: Pico+ s = fromIntegral si + sf+ h' = case timeFactGetAMPM facts of+ Nothing -> h+ Just AM -> mod h 12+ Just PM -> if h < 12 then h + 12 else h+ in+ return $ TimeOfDay h' m s rpad :: Int -> a -> [a] -> [a] rpad n c xs = xs ++ replicate (n - length xs) c@@ -359,17 +549,10 @@ buildTime l = let f :: Char -> String -> TimeZone -> Maybe TimeZone- f 'z' str (TimeZone _ dst name)- | Just offset <- readTzOffset str = Just $ TimeZone offset dst name- f 'z' _ _ = Nothing- f 'Z' str _- | Just offset <- readTzOffset str = Just $ TimeZone offset False ""- f 'Z' str _- | Just zone <- getKnownTimeZone l str = Just zone- f 'Z' "UTC" _ = Just utc- f 'Z' [c] _- | Just zone <- getMilZone c = Just zone- f 'Z' _ _ = Nothing+ f 'z' str (TimeZone _ dst name) = do+ offset <- readSpec_z str+ return $ TimeZone offset dst name+ f 'Z' str _ = readSpec_Z l str f _ _ tz = Just tz in foldl (\mt (c, s) -> mt >>= f c s) (Just $ minutesToTimeZone 0)@@ -416,6 +599,8 @@ substituteTimeSpecifier _ = timeSubstituteTimeSpecifier parseTimeSpecifier _ = timeParseTimeSpecifier buildTime l xs = localTimeToUT1 0 <$> buildTime l xs++--- Duration buildTimeMonths :: [(Char, String)] -> Maybe Integer buildTimeMonths xs = do
lib/Data/Time/LocalTime.hs view
@@ -11,14 +11,53 @@ -- getting the locale time zone getTimeZone, getCurrentTimeZone,- module Data.Time.LocalTime.Internal.TimeOfDay,++ -- * Time of day+ TimeOfDay (..),+ midnight,+ midday,+ makeTimeOfDayValid,+ timeToDaysAndTimeOfDay,+ daysAndTimeOfDayToTime,+ utcToLocalTimeOfDay,+ localToUTCTimeOfDay,+ timeToTimeOfDay,+ pastMidnight,+ timeOfDayToTime,+ sinceMidnight,+ diffTimeOfDay,+ dayFractionToTimeOfDay,+ timeOfDayToDayFraction,++ -- * Calendar Duration module Data.Time.LocalTime.Internal.CalendarDiffTime,- module Data.Time.LocalTime.Internal.LocalTime,- module Data.Time.LocalTime.Internal.ZonedTime,++ -- * Local Time+ LocalTime (..),+ addLocalTime,+ diffLocalTime,+ -- converting UTC and UT1 times to LocalTime+ utcToLocalTime,+ localTimeToUTC,+ ut1ToLocalTime,+ localTimeToUT1,+ -- using CalendarDiffTime+ addLocalDurationClip,+ addLocalDurationRollOver,+ diffLocalDurationClip,+ diffLocalDurationRollOver,++ -- * Zoned Time+ ZonedTime (..),+ utcToZonedTime,+ zonedTimeToUTC,+ getZonedTime,+ utcToLocalZonedTime, ) where import Data.Time.Format () import Data.Time.LocalTime.Internal.CalendarDiffTime+import Data.Time.LocalTime.Internal.Foreign import Data.Time.LocalTime.Internal.LocalTime import Data.Time.LocalTime.Internal.TimeOfDay import Data.Time.LocalTime.Internal.TimeZone hiding (timeZoneOffsetString'')
lib/Data/Time/LocalTime/Internal/CalendarDiffTime.hs view
@@ -1,28 +1,27 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.LocalTime.Internal.CalendarDiffTime (- -- * Calendar Duration- module Data.Time.LocalTime.Internal.CalendarDiffTime,-) where+module Data.Time.LocalTime.Internal.CalendarDiffTime where import Control.DeepSeq import Data.Data import Data.Time.Calendar.CalendarDiffDays+import Data.Time.Calendar.Gregorian import Data.Time.Clock.Internal.NominalDiffTime+import Data.Time.Clock.Internal.UTCDiff+import Data.Time.Clock.Internal.UTCTime import GHC.Generics+#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 , ctTime :: NominalDiffTime }- deriving- ( Eq- , -- | @since 1.9.2- Data- , -- | @since 1.9.2- Typeable- , Generic- )+ deriving (Eq, Typeable, Data, Generic, TH.Lift) instance NFData CalendarDiffTime where rnf (CalendarDiffTime m t) = rnf m `seq` rnf t `seq` ()@@ -45,3 +44,25 @@ -- | Scale by a factor. Note that @scaleCalendarDiffTime (-1)@ will not perfectly invert a duration, due to variable month lengths. scaleCalendarDiffTime :: Integer -> CalendarDiffTime -> CalendarDiffTime scaleCalendarDiffTime k (CalendarDiffTime m d) = CalendarDiffTime (k * m) (fromInteger k * d)++addUTCDurationClip :: CalendarDiffTime -> UTCTime -> UTCTime+addUTCDurationClip (CalendarDiffTime m d) (UTCTime day t) =+ addUTCTime d $ UTCTime (addGregorianMonthsClip m day) t++addUTCDurationRollOver :: CalendarDiffTime -> UTCTime -> UTCTime+addUTCDurationRollOver (CalendarDiffTime m d) (UTCTime day t) =+ addUTCTime d $ UTCTime (addGregorianMonthsRollOver m day) t++diffUTCDurationClip :: UTCTime -> UTCTime -> CalendarDiffTime+diffUTCDurationClip (UTCTime day1 t1) (UTCTime day2 t2) =+ let+ CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationClip day1 day2+ in+ CalendarDiffTime m $ t + realToFrac (t1 - t2)++diffUTCDurationRollOver :: UTCTime -> UTCTime -> CalendarDiffTime+diffUTCDurationRollOver (UTCTime day1 t1) (UTCTime day2 t2) =+ let+ CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationRollOver day1 day2+ in+ CalendarDiffTime m $ t + realToFrac (t1 - t2)
+ lib/Data/Time/LocalTime/Internal/Foreign.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE Safe #-}++module Data.Time.LocalTime.Internal.Foreign (+ getTimeZone,+ getCurrentTimeZone,+) where++import Data.Time.Clock.Internal.UTCTime+import Data.Time.Clock.POSIX+import Data.Time.Clock.System+import Data.Time.LocalTime.Internal.TimeZone+import Foreign+import Foreign.C+#if defined(javascript_HOST_ARCH)+import Data.Time.Calendar.Gregorian+import Data.Time.Clock.Internal.NominalDiffTime+import Data.Time.LocalTime.Internal.LocalTime+import Data.Time.LocalTime.Internal.TimeOfDay+#endif++#if defined(javascript_HOST_ARCH)++foreign import javascript "((dy,dm,dd,th,tm,ts) => { return new Date(dy,dm,dd,th,tm,ts).getTimezoneOffset(); })"+ js_get_timezone_minutes :: Int -> Int -> Int -> Int -> Int -> Int -> IO Int++get_timezone_minutes :: UTCTime -> IO Int+get_timezone_minutes ut = let+ lt :: LocalTime+ lt = utcToLocalTime utc ut+ in case lt of+ LocalTime (YearMonthDay dy dm dd) (TimeOfDay th tm ts) ->+ js_get_timezone_minutes (fromInteger dy) (pred dm) dd th tm (floor ts)++getTimeZoneCTime :: CTime -> IO TimeZone+getTimeZoneCTime ct = do+ let+ ut :: UTCTime+ ut = posixSecondsToUTCTime $ secondsToNominalDiffTime $ fromIntegral $ fromCTime ct+ mins <- get_timezone_minutes ut+ return $ TimeZone mins False ""++fromCTime :: CTime -> Int64+fromCTime (CTime tt) = fromIntegral tt++#else+{-# CFILES cbits/HsTime.c #-}+foreign import ccall unsafe "HsTime.h get_current_timezone_seconds"+ get_current_timezone_seconds ::+ CTime -> Ptr CInt -> Ptr CString -> IO CLong++getTimeZoneCTime :: CTime -> IO TimeZone+getTimeZoneCTime ctime =+ with 0 $ \pdst ->+ with nullPtr $ \pcname -> do+ secs <- get_current_timezone_seconds ctime pdst pcname+ case secs of+ 0x80000000 -> fail "localtime_r failed"+ _ -> do+ dst <- peek pdst+ cname <- peek pcname+ name <- peekCString cname+ return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name)+#endif++-- there's no instance Bounded CTime, so this is the easiest way to check for overflow+toCTime :: Int64 -> IO CTime+toCTime t =+ let+ tt = fromIntegral t+ t' = fromIntegral tt+ in+ if t' == t+ then return $ CTime tt+ else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"++-- | Get the configured time-zone for a given time (varying as per summertime adjustments).+getTimeZoneSystem :: SystemTime -> IO TimeZone+getTimeZoneSystem t = do+ ctime <- toCTime $ systemSeconds t+ getTimeZoneCTime ctime++-- | Get the configured time-zone for a given time (varying as per summertime adjustments).+--+-- On Unix systems the output of this function depends on:+--+-- 1. The value of @TZ@ environment variable (if set)+--+-- 2. The system time zone (usually configured by @\/etc\/localtime@ symlink)+--+-- For details see tzset(3) and localtime(3).+--+-- Example:+--+-- @+-- > let t = `UTCTime` (`Data.Time.Calendar.fromGregorian` 2021 7 1) 0+-- > `getTimeZone` t+-- CEST+-- > `System.Environment.setEnv` \"TZ\" \"America/New_York\" >> `getTimeZone` t+-- EDT+-- > `System.Environment.setEnv` \"TZ\" \"Europe/Berlin\" >> `getTimeZone` t+-- CEST+-- @+--+-- On Windows systems the output of this function depends on:+--+-- 1. The value of @TZ@ environment variable (if set).+-- See [here](https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/tzset) for how Windows interprets this variable.+--+-- 2. The system time zone, configured in Settings+getTimeZone :: UTCTime -> IO TimeZone+getTimeZone t = do+ ctime <- toCTime $ floor $ utcTimeToPOSIXSeconds t+ getTimeZoneCTime ctime++-- | Get the configured time-zone for the current time.+getCurrentTimeZone :: IO TimeZone+getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem
lib/Data/Time/LocalTime/Internal/LocalTime.hs view
@@ -1,18 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS -fno-warn-orphans #-} -module Data.Time.LocalTime.Internal.LocalTime (- -- * Local Time- LocalTime (..),- addLocalTime,- diffLocalTime,- -- converting UTC and UT1 times to LocalTime- utcToLocalTime,- localTimeToUTC,- ut1ToLocalTime,- localTimeToUT1,-) where+module Data.Time.LocalTime.Internal.LocalTime where import Control.DeepSeq import Data.Data@@ -22,9 +13,15 @@ import Data.Time.Clock.Internal.UTCDiff import Data.Time.Clock.Internal.UTCTime import Data.Time.Clock.Internal.UniversalTime+import Data.Time.LocalTime.Internal.CalendarDiffTime import Data.Time.LocalTime.Internal.TimeOfDay import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics+#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.@@ -34,7 +31,7 @@ { localDay :: Day , localTimeOfDay :: TimeOfDay }- deriving (Eq, Ord, Data, Typeable, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData LocalTime where rnf (LocalTime d t) = rnf d `seq` rnf t `seq` ()@@ -79,3 +76,25 @@ -- orphan instance instance Show UniversalTime where show t = show (ut1ToLocalTime 0 t)++addLocalDurationClip :: CalendarDiffTime -> LocalTime -> LocalTime+addLocalDurationClip (CalendarDiffTime m d) (LocalTime day t) =+ addLocalTime d $ LocalTime (addGregorianMonthsClip m day) t++addLocalDurationRollOver :: CalendarDiffTime -> LocalTime -> LocalTime+addLocalDurationRollOver (CalendarDiffTime m d) (LocalTime day t) =+ addLocalTime d $ LocalTime (addGregorianMonthsRollOver m day) t++diffLocalDurationClip :: LocalTime -> LocalTime -> CalendarDiffTime+diffLocalDurationClip (LocalTime day1 t1) (LocalTime day2 t2) =+ let+ CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationClip day1 day2+ in+ CalendarDiffTime m $ t + diffTimeOfDay t1 t2++diffLocalDurationRollOver :: LocalTime -> LocalTime -> CalendarDiffTime+diffLocalDurationRollOver (LocalTime day1 t1) (LocalTime day2 t2) =+ let+ CalendarDiffTime m t = calendarTimeDays $ diffGregorianDurationRollOver day1 day2+ in+ CalendarDiffTime m $ t + diffTimeOfDay t1 t2
lib/Data/Time/LocalTime/Internal/TimeOfDay.hs view
@@ -1,22 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} -module Data.Time.LocalTime.Internal.TimeOfDay (- -- * Time of day- TimeOfDay (..),- midnight,- midday,- makeTimeOfDayValid,- timeToDaysAndTimeOfDay,- daysAndTimeOfDayToTime,- utcToLocalTimeOfDay,- localToUTCTimeOfDay,- timeToTimeOfDay,- pastMidnight,- timeOfDayToTime,- sinceMidnight,- dayFractionToTimeOfDay,- timeOfDayToDayFraction,-) where+module Data.Time.LocalTime.Internal.TimeOfDay where import Control.DeepSeq import Data.Data@@ -26,6 +11,11 @@ import Data.Time.Clock.Internal.NominalDiffTime import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics+#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. --@@ -37,10 +27,10 @@ , todMin :: Int -- ^ range 0 - 59 , todSec :: Pico- -- ^ Note that 0 <= 'todSec' < 61, accomodating leap seconds.+ -- ^ Note that 0 <= 'todSec' < 61, accommodating leap seconds. -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously }- deriving (Eq, Ord, Data, Typeable, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData TimeOfDay where rnf (TimeOfDay h m s) = rnf h `seq` rnf m `seq` rnf s `seq` ()@@ -126,3 +116,6 @@ -- | Get the fraction of a day since midnight given a time of day. timeOfDayToDayFraction :: TimeOfDay -> Rational timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod) / realToFrac posixDayLength++diffTimeOfDay :: TimeOfDay -> TimeOfDay -> NominalDiffTime+diffTimeOfDay t1 t2 = realToFrac $ daysAndTimeOfDayToTime 0 t1 - daysAndTimeOfDayToTime 0 t2
lib/Data/Time/LocalTime/Internal/TimeZone.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module Data.Time.LocalTime.Internal.TimeZone (@@ -10,20 +10,17 @@ minutesToTimeZone, hoursToTimeZone, utc,- -- getting the locale time zone- getTimeZone,- getCurrentTimeZone, ) where import Control.DeepSeq import Data.Data import Data.Time.Calendar.Private-import Data.Time.Clock.Internal.UTCTime-import Data.Time.Clock.POSIX-import Data.Time.Clock.System-import Foreign-import Foreign.C import GHC.Generics+#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@@ -34,7 +31,7 @@ , timeZoneName :: String -- ^ The name of the zone, typically a three- or four-letter acronym. }- deriving (Eq, Ord, Data, Typeable, Generic)+ deriving (Eq, Ord, Typeable, Data, Generic, TH.Lift) instance NFData TimeZone where rnf (TimeZone m so n) = rnf m `seq` rnf so `seq` rnf n `seq` ()@@ -79,81 +76,3 @@ -- | The UTC time zone. utc :: TimeZone utc = TimeZone 0 False "UTC"--{-# CFILES cbits/HsTime.c #-}-foreign import ccall unsafe "HsTime.h get_current_timezone_seconds"- get_current_timezone_seconds ::- CTime -> Ptr CInt -> Ptr CString -> IO CLong--getTimeZoneCTime :: CTime -> IO TimeZone-getTimeZoneCTime ctime =- with- 0- ( \pdst ->- with- nullPtr- ( \pcname -> do- secs <- get_current_timezone_seconds ctime pdst pcname- case secs of- 0x80000000 -> fail "localtime_r failed"- _ -> do- dst <- peek pdst- cname <- peek pcname- name <- peekCString cname- return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name)- )- )---- there's no instance Bounded CTime, so this is the easiest way to check for overflow-toCTime :: Int64 -> IO CTime-toCTime t =- let- tt = fromIntegral t- t' = fromIntegral tt- in- if t' == t- then return $ CTime tt- else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"---- | Get the configured time-zone for a given time (varying as per summertime adjustments).-getTimeZoneSystem :: SystemTime -> IO TimeZone-getTimeZoneSystem t = do- ctime <- toCTime $ systemSeconds t- getTimeZoneCTime ctime---- | Get the configured time-zone for a given time (varying as per summertime adjustments).------ On Unix systems the output of this function depends on:------ 1. The value of @TZ@ environment variable (if set)------ 2. The system time zone (usually configured by @\/etc\/localtime@ symlink)------ For details see tzset(3) and localtime(3).------ Example:------ @--- > let t = `UTCTime` (`Data.Time.Calendar.fromGregorian` 2021 7 1) 0--- > `getTimeZone` t--- CEST--- > `System.Environment.setEnv` \"TZ\" \"America/New_York\" >> `getTimeZone` t--- EDT--- > `System.Environment.setEnv` \"TZ\" \"Europe/Berlin\" >> `getTimeZone` t--- CEST--- @------ On Windows systems the output of this function depends on:------ 1. The value of @TZ@ environment variable (if set).--- See [here](https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/tzset) for how Windows interprets this variable.------ 2. The system time zone, configured in Settings-getTimeZone :: UTCTime -> IO TimeZone-getTimeZone t = do- ctime <- toCTime $ floor $ utcTimeToPOSIXSeconds t- getTimeZoneCTime ctime---- | Get the configured time-zone for the current time.-getCurrentTimeZone :: IO TimeZone-getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem
lib/Data/Time/LocalTime/Internal/ZonedTime.hs view
@@ -1,22 +1,23 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} {-# OPTIONS -fno-warn-orphans #-} -module Data.Time.LocalTime.Internal.ZonedTime (- ZonedTime (..),- utcToZonedTime,- zonedTimeToUTC,- getZonedTime,- utcToLocalZonedTime,-) where+module Data.Time.LocalTime.Internal.ZonedTime where import Control.DeepSeq import Data.Data import Data.Time.Clock.Internal.UTCTime import Data.Time.Clock.POSIX+import Data.Time.LocalTime.Internal.Foreign import Data.Time.LocalTime.Internal.LocalTime import Data.Time.LocalTime.Internal.TimeZone import GHC.Generics+#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. --@@ -27,7 +28,7 @@ { zonedTimeToLocalTime :: LocalTime , zonedTimeZone :: TimeZone }- deriving (Data, Typeable, Generic)+ deriving (Typeable, Data, Generic, TH.Lift) instance NFData ZonedTime where rnf (ZonedTime lt z) = rnf lt `seq` rnf z `seq` ()
lib/cbits/HsTime.c view
@@ -35,7 +35,7 @@ *pname = dst ? _tzname[1] : _tzname[0]; return - (dst ? _timezone - 3600 : _timezone); #else-# if HAVE_TZNAME+# if HAVE_TZNAME || defined(__MHS__) *pname = *tzname; # else # error "Don't know how to get timezone name on your OS"
lib/include/HsTime.h view
@@ -1,7 +1,7 @@ #ifndef __HSTIME_H__ #define __HSTIME_H__ -#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) || defined(__MHS__) #define HAVE_TIME_H 1 #else
+ test/ForeignCalls.hs view
@@ -0,0 +1,50 @@+module Main (main) where++import Control.Exception+import Control.Monad+import Data.Foldable+import Data.Monoid+import Data.Time+import Data.Time.Clock.POSIX+import Data.Time.Clock.System+import Data.Time.Clock.TAI+import Data.Traversable+import System.Exit+import System.IO++data Test = MkTest String (IO ())++tests :: [Test]+tests =+ [ MkTest "getCurrentTime" $ void $ getCurrentTime+ , MkTest "getZonedTime" $ void $ getZonedTime+ , MkTest "getCurrentTimeZone" $ void $ getCurrentTimeZone+ , MkTest "getTimeZone" $ void $ getCurrentTime >>= getTimeZone+ , MkTest "getPOSIXTime" $ void $ getPOSIXTime+ , MkTest "getSystemTime" $ void $ getSystemTime+ , MkTest "getTime_resolution" $ void $ evaluate getTime_resolution+ , MkTest "taiClock time" $ for_ taiClock $ \(_, getTime) -> void $ getTime+ , MkTest "taiClock resolution" $ for_ taiClock $ \(res, _) -> void $ evaluate res+ ]++runTest :: Test -> IO Bool+runTest (MkTest name action) = do+ hPutStr stderr $ name <> ": "+ result <- try action+ case result of+ Left err -> do+ hPutStrLn stderr $ "FAILED: " <> show (err :: SomeException)+ return False+ Right () -> do+ hPutStrLn stderr "PASSED"+ return True++main :: IO ()+main = do+ results <- for tests $ \test -> do+ passed <- runTest test+ return (Sum $ if passed then 1 else 0 :: Int, Sum 1)+ let+ (Sum i, Sum n) = mconcat results+ hPutStrLn stderr $ show i <> " out of " <> show n <> " tests passed"+ exitWith $ if i == n then ExitSuccess else ExitFailure 1
test/main/Main.hs view
@@ -15,7 +15,7 @@ import Test.Calendar.Week import Test.Calendar.Year import Test.Clock.Conversion-import Test.Clock.Lift (testLift)+import Test.Clock.Pattern import Test.Clock.Resolution import Test.Clock.TAI import Test.Format.Compile ()@@ -49,7 +49,7 @@ , testYear , testDuration ]- , testGroup "Clock" [testClockConversion, testResolutions, testTAI, testLift]+ , testGroup "Clock" [testClockPatterns, testClockConversion, testResolutions, testTAI] , testGroup "Format" [testFormat, testParseTime, testISO8601] , testGroup "LocalTime" [testTime, testTimeOfDay, testCalendarDiffTime] ]
+ test/main/Test/AddDiff.hs view
@@ -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
test/main/Test/Arbitrary.hs view
@@ -1,6 +1,9 @@ {-# OPTIONS -fno-warn-orphans #-} -module Test.Arbitrary where+module Test.Arbitrary (+ supportedDayRange,+ NoLeapSeconds (..),+) where import Control.Monad import Data.Fixed@@ -23,14 +26,51 @@ deriving instance Show FirstWeekType +deriving instance Random Month++supportedMonthRange :: (Month, Month)+supportedMonthRange = (YearMonth (-9899) 1, YearMonth 9999 12)++shrinkYear :: Integer -> [Integer]+shrinkYear y =+ let+ yearShrink =+ if y > 2000+ then [pred y]+ else+ if y < 2000+ then [succ y]+ else []+ year10Shrink =+ if y > 2010+ then fmap (\i -> y - i) [1 .. 10]+ else+ if y < 1990+ then fmap (\i -> y + i) [1 .. 10]+ else []+ year100Shrink =+ if y > 2100+ then [y - 100]+ else+ if y < 1900+ then [y + 100]+ else []+ in+ year100Shrink <> year10Shrink <> yearShrink+ instance Arbitrary Month where- arbitrary = liftM MkMonth $ choose (-30000, 200000)+ arbitrary = choose supportedMonthRange instance Arbitrary Quarter where- arbitrary = liftM MkQuarter $ choose (-30000, 200000)+ arbitrary = fmap monthQuarter arbitrary+ shrink (YearQuarter y qoy) =+ fmap (\y' -> YearQuarter y' qoy) (shrinkYear y)+ <> fmap (YearQuarter y) (shrink qoy) instance Arbitrary QuarterOfYear where arbitrary = liftM toEnum $ choose (1, 4)+ shrink Q1 = []+ shrink _ = [Q1] deriving instance Random Day @@ -50,15 +90,8 @@ 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+ dayShrink <> monthShrink <> fmap (\y' -> fromGregorian y' m d) (shrinkYear y) instance CoArbitrary Day where coarbitrary (ModifiedJulianDay d) = coarbitrary d@@ -66,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@@ -79,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@@ -126,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) @@ -136,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 _ _) = []@@ -151,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
test/main/Test/Calendar/CalendarProps.hs view
@@ -21,4 +21,4 @@ YearQuarter y qy -> q == YearQuarter y qy testCalendarProps :: TestTree-testCalendarProps = nameTest "calender-props" [testYearMonth, testMonthDay, testYearQuarter]+testCalendarProps = nameTest "calendar-props" [testYearMonth, testMonthDay, testYearQuarter]
test/main/Test/Calendar/Duration.hs view
@@ -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
test/main/Test/Calendar/MonthDay.hs view
@@ -2,6 +2,8 @@ testMonthDay, ) where +import Data.Time.Calendar+import Data.Time.Calendar.Month import Data.Time.Calendar.MonthDay import Test.Calendar.MonthDayRef import Test.Tasty@@ -14,10 +16,23 @@ testMonthDay :: TestTree testMonthDay =- testCase "testMonthDay" $- assertEqual "" testMonthDayRef $- concat $- map (\isL -> unlines (leap isL : yearDays isL)) [False, True]+ testGroup+ "MonthDay"+ [ testCase "good" $+ assertEqual "" testMonthDayRef $+ concat $+ map (\isL -> unlines (leap isL : yearDays isL)) [False, True]+ , testGroup+ "clip"+ [ testCase "12" $ assertEqual "" (YearMonthDay 2005 05 12) (MonthDay (MkMonth 24064) 12)+ , testCase "1" $ assertEqual "" (YearMonthDay 2005 05 1) (MonthDay (MkMonth 24064) 1)+ , testCase "0" $ assertEqual "" (YearMonthDay 2005 05 1) (MonthDay (MkMonth 24064) 0)+ , testCase "-1" $ assertEqual "" (YearMonthDay 2005 05 1) (MonthDay (MkMonth 24064) (-1))+ , testCase "31" $ assertEqual "" (YearMonthDay 2005 05 31) (MonthDay (MkMonth 24064) 31)+ , testCase "32" $ assertEqual "" (YearMonthDay 2005 05 31) (MonthDay (MkMonth 24064) 32)+ , testCase "33" $ assertEqual "" (YearMonthDay 2005 05 31) (MonthDay (MkMonth 24064) 33)+ ]+ ] where leap isLeap = if isLeap
− test/main/Test/Clock/Lift.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Test.Clock.Lift (- testLift,-) where--import Data.Time.Clock-import qualified Language.Haskell.TH.Syntax as TH-import Test.Tasty-import Test.Tasty.HUnit--testLift :: TestTree-testLift =- testGroup- "Lift instances"- [ testCase "DiffTime" $ $$(TH.liftTyped (secondsToDiffTime 100)) @?= secondsToDiffTime 100- , testCase "NominalDiffTime" $ $$(TH.liftTyped (secondsToNominalDiffTime 100)) @?= secondsToNominalDiffTime 100- ]
+ test/main/Test/Clock/Pattern.hs view
@@ -0,0 +1,32 @@+module Test.Clock.Pattern (+ testClockPatterns,+) where++import Data.Time.Clock+import Test.Tasty+import Test.Tasty.HUnit++testClockPatterns :: TestTree+testClockPatterns =+ let+ testSame :: forall a. (Eq a, Show a) => TestName -> a -> a -> TestTree+ testSame name expected found = testCase name $ assertEqual "" expected found+ in+ testGroup "pattern" $+ [ testGroup+ "construct"+ [ testSame "Seconds" 52.4 (Seconds 52.4)+ , testSame "Seconds-Picoseconds" (Picoseconds 7_276_000_000_000) (Seconds 7.276)+ , testSame "Minutes-Seconds" (Seconds 210) (Minutes 3.5)+ , testSame "Hours-Minutes" (Minutes 120) (Hours 2)+ , testSame "Nominal" 37.4 (Nominal 37.4)+ ]+ , testGroup+ "deconstruct"+ [ testSame "Seconds" 52.4 ((\(Seconds x) -> x) 52.4)+ , testSame "Seconds-Picoseconds" 7.276 ((\(Seconds x) -> x) $ Picoseconds 7_276_000_000_000)+ , testSame "Minutes-Seconds" 3.5 ((\(Minutes x) -> x) $ Seconds 210)+ , testSame "Hours-Minutes" 2 ((\(Hours x) -> x) $ Minutes 120)+ , testSame "Nominal" 37.4 ((\(Nominal x) -> x) 37.4)+ ]+ ]
test/main/Test/Format/Compile.hs view
@@ -1,6 +1,4 @@ -- Tests succeed if module compiles-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- module Test.Format.Compile ( ) where
test/main/Test/Format/Format.hs view
@@ -9,12 +9,12 @@ import Test.TestUtil -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html--- plus FgGklz+-- plus FgGklvz -- f not supported -- P not always supported -- s time-zone dependent chars :: [Char]-chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%"+chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUvVwWxXyYzZ%" -- as found in "man strftime" on a glibc system. '#' is different, though modifiers :: [Char]@@ -163,20 +163,20 @@ , testAFormat "%3ES" "01.245" (61.24582 :: DiffTime) ] -testCalenderDiffDays :: TestTree-testCalenderDiffDays =+testCalendarDiffDays :: TestTree+testCalendarDiffDays = testGroup- "CalenderDiffDays"+ "CalendarDiffDays" [ testAFormat "%yy%Bm%ww%Dd" "5y4m3w2d" $ CalendarDiffDays 64 23 , testAFormat "%bm %dd" "64m 23d" $ CalendarDiffDays 64 23 , testAFormat "%yy%Bm%ww%Dd" "-5y-4m-3w-2d" $ CalendarDiffDays (-64) (-23) , testAFormat "%bm %dd" "-64m -23d" $ CalendarDiffDays (-64) (-23) ] -testCalenderDiffTime :: TestTree-testCalenderDiffTime =+testCalendarDiffTime :: TestTree+testCalendarDiffTime = testGroup- "CalenderDiffTime"+ "CalendarDiffTime" [ 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" $@@ -207,6 +207,6 @@ , testTimeZone , testNominalDiffTime , testDiffTime- , testCalenderDiffDays- , testCalenderDiffTime+ , testCalendarDiffDays+ , testCalendarDiffTime ]
test/main/Test/Format/ISO8601.hs view
@@ -4,10 +4,10 @@ testISO8601, ) where +import Data.Coerce import Data.Ratio import Data.Time import Data.Time.Format.ISO8601-import Data.Time.Format.Internal import Test.Arbitrary () import Test.QuickCheck.Property import Test.Tasty@@ -33,32 +33,45 @@ else failed{reason = show str ++ ": expected " ++ (show expected) ++ ", found " ++ (show found)} class SpecialTestValues a where+ testGen :: Gen a+ default testGen :: Arbitrary a => Gen a+ testGen = arbitrary+ -- | values that should always be tested specialTestValues :: [a]--instance {-# OVERLAPPABLE #-} SpecialTestValues a where specialTestValues = [] +instance {-# OVERLAPPABLE #-} Arbitrary a => SpecialTestValues a+ 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]+instance SpecialTestValues (Integer, Int) where+ testGen = do+ Small y <- arbitrary+ woy <- choose (-10, 120)+ pure (y, woy) -readShowTest :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => Format a -> [TestTree]+readShowTestCheck :: (Eq a, Show a, SpecialTestValues a) => (a -> Bool) -> Format a -> [TestTree]+readShowTestCheck skip fmt =+ [ nameTest "random" $ fmap (readShowProperty skip fmt) testGen+ , nameTest "special" $ fmap (\a -> nameTest (show a) $ readShowProperty skip fmt a) $ filter (not . skip) specialTestValues+ ]++readShowTest :: (Eq a, Show a, SpecialTestValues a) => Format a -> [TestTree] readShowTest = readShowTestCheck $ \_ -> False readBoth :: NameTest t => (FormatExtension -> t) -> [TestTree] readBoth fmts = [nameTest "extended" $ fmts ExtendedFormat, nameTest "basic" $ fmts BasicFormat] -readShowTestsCheck :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (a -> Bool) -> (FormatExtension -> Format a) -> [TestTree]+readShowTestsCheck :: (Eq a, Show a, SpecialTestValues a) => (a -> Bool) -> (FormatExtension -> Format a) -> [TestTree] readShowTestsCheck skip fmts = readBoth $ \fe -> readShowTestCheck skip $ fmts fe -readShowTests :: (Eq a, Show a, Arbitrary a, SpecialTestValues a) => (FormatExtension -> Format a) -> [TestTree]+readShowTests :: (Eq a, Show a, SpecialTestValues a) => (FormatExtension -> Format a) -> [TestTree] readShowTests = readShowTestsCheck $ \_ -> False -newtype Durational t = MkDurational {unDurational :: t}- deriving (Eq)+newtype Durational t = MkDurational t+ deriving Eq instance Show t => Show (Durational t) where show (MkDurational t) = show t@@ -81,59 +94,60 @@ return $ MkDurational $ CalendarDiffTime mm $ fromRational $ ss % picofactor durationalFormat :: Format a -> Format (Durational a)-durationalFormat (MkFormat sa ra) = MkFormat (\b -> sa $ unDurational b) (fmap MkDurational ra)+durationalFormat = coerce testReadShowFormat :: TestTree testReadShowFormat =- nameTest- "read-show format"- [ nameTest "calendarFormat" $ readShowTests $ calendarFormat- , nameTest "yearMonthFormat" $ readShowTest $ yearMonthFormat- , nameTest "yearFormat" $ readShowTest $ yearFormat- , nameTest "centuryFormat" $ readShowTest $ centuryFormat- , nameTest "expandedCalendarFormat" $ readShowTests $ expandedCalendarFormat 6- , nameTest "expandedYearMonthFormat" $ readShowTest $ expandedYearMonthFormat 6- , nameTest "expandedYearFormat" $ readShowTest $ expandedYearFormat 6- , nameTest "expandedCenturyFormat" $ readShowTest $ expandedCenturyFormat 4- , nameTest "ordinalDateFormat" $ readShowTests $ ordinalDateFormat- , nameTest "expandedOrdinalDateFormat" $ readShowTests $ expandedOrdinalDateFormat 6- , nameTest "weekDateFormat" $ readShowTests $ weekDateFormat- , nameTest "yearWeekFormat" $ readShowTests $ yearWeekFormat- , nameTest "expandedWeekDateFormat" $ readShowTests $ expandedWeekDateFormat 6- , nameTest "expandedYearWeekFormat" $ readShowTests $ expandedYearWeekFormat 6- , nameTest "timeOfDayFormat" $ readShowTests $ timeOfDayFormat- , nameTest "hourMinuteFormat" $ readShowTestsCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourMinuteFormat- , nameTest "hourFormat" $ readShowTestCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourFormat- , nameTest "withTimeDesignator" $ readShowTests $ \fe -> withTimeDesignator $ timeOfDayFormat fe- , nameTest "withUTCDesignator" $ readShowTests $ \fe -> withUTCDesignator $ timeOfDayFormat fe- , nameTest "timeOffsetFormat" $ readShowTests $ timeOffsetFormat- , nameTest "timeOfDayAndOffsetFormat" $ readShowTests $ timeOfDayAndOffsetFormat- , nameTest "localTimeFormat" $- readShowTests $- \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)- , nameTest "zonedTimeFormat" $- readShowTests $- \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe- , nameTest "utcTimeFormat" $ readShowTests $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe)- , nameTest "dayAndTimeFormat" $- readShowTests $- \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe)- , nameTest "timeAndOffsetFormat" $ readShowTests $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe- , nameTest "durationDaysFormat" $ readShowTest $ durationDaysFormat- , nameTest "durationTimeFormat" $ readShowTest $ durationTimeFormat- , nameTest "alternativeDurationDaysFormat" $- readBoth $- \fe -> readShowTest (durationalFormat $ alternativeDurationDaysFormat fe)- , nameTest "alternativeDurationTimeFormat" $- readBoth $- \fe -> readShowTest (durationalFormat $ alternativeDurationTimeFormat fe)- , nameTest "intervalFormat" $- readShowTests $ \fe ->- intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat- , nameTest "recurringIntervalFormat" $- readShowTests $ \fe ->- recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat- ]+ localOption (QuickCheckTests 1000) $+ nameTest+ "read-show format"+ [ nameTest "calendarFormat" $ readShowTests $ calendarFormat+ , nameTest "yearMonthFormat" $ readShowTest $ yearMonthFormat+ , nameTest "yearFormat" $ readShowTest $ yearFormat+ , nameTest "centuryFormat" $ readShowTest $ centuryFormat+ , nameTest "expandedCalendarFormat" $ readShowTests $ expandedCalendarFormat 6+ , nameTest "expandedYearMonthFormat" $ readShowTest $ expandedYearMonthFormat 6+ , nameTest "expandedYearFormat" $ readShowTest $ expandedYearFormat 6+ , nameTest "expandedCenturyFormat" $ readShowTest $ expandedCenturyFormat 4+ , nameTest "ordinalDateFormat" $ readShowTests $ ordinalDateFormat+ , nameTest "expandedOrdinalDateFormat" $ readShowTests $ expandedOrdinalDateFormat 6+ , nameTest "weekDateFormat" $ readShowTests $ weekDateFormat+ , nameTest "yearWeekFormat" $ readShowTests $ yearWeekFormat+ , nameTest "expandedWeekDateFormat" $ readShowTests $ expandedWeekDateFormat 6+ , nameTest "expandedYearWeekFormat" $ readShowTests $ expandedYearWeekFormat 6+ , nameTest "timeOfDayFormat" $ readShowTests $ timeOfDayFormat+ , nameTest "hourMinuteFormat" $ readShowTestsCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourMinuteFormat+ , nameTest "hourFormat" $ readShowTestCheck (\(TimeOfDay _ _ s) -> s >= 60) $ hourFormat+ , nameTest "withTimeDesignator" $ readShowTests $ \fe -> withTimeDesignator $ timeOfDayFormat fe+ , nameTest "withUTCDesignator" $ readShowTests $ \fe -> withUTCDesignator $ timeOfDayFormat fe+ , nameTest "timeOffsetFormat" $ readShowTests $ timeOffsetFormat+ , nameTest "timeOfDayAndOffsetFormat" $ readShowTests $ timeOfDayAndOffsetFormat+ , nameTest "localTimeFormat" $+ readShowTests $+ \fe -> localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)+ , nameTest "zonedTimeFormat" $+ readShowTests $+ \fe -> zonedTimeFormat (calendarFormat fe) (timeOfDayFormat fe) fe+ , nameTest "utcTimeFormat" $ readShowTests $ \fe -> utcTimeFormat (calendarFormat fe) (timeOfDayFormat fe)+ , nameTest "dayAndTimeFormat" $+ readShowTests $+ \fe -> dayAndTimeFormat (calendarFormat fe) (timeOfDayFormat fe)+ , nameTest "timeAndOffsetFormat" $ readShowTests $ \fe -> timeAndOffsetFormat (timeOfDayFormat fe) fe+ , nameTest "durationDaysFormat" $ readShowTest $ durationDaysFormat+ , nameTest "durationTimeFormat" $ readShowTest $ durationTimeFormat+ , nameTest "alternativeDurationDaysFormat" $+ readBoth $+ \fe -> readShowTest (durationalFormat $ alternativeDurationDaysFormat fe)+ , nameTest "alternativeDurationTimeFormat" $+ readBoth $+ \fe -> readShowTest (durationalFormat $ alternativeDurationTimeFormat fe)+ , nameTest "intervalFormat" $+ readShowTests $ \fe ->+ intervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat+ , nameTest "recurringIntervalFormat" $+ readShowTests $ \fe ->+ recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat+ ] testShowReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree testShowReadFormat name fmt str val =@@ -281,6 +295,16 @@ iso8601Format "2024-07-06T08:45:56.553+06" (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 360))+ , testReadFormat+ "zonedTimeFormat"+ iso8601Format+ "2024-05-30T16:15:18Z"+ (ZonedTime (LocalTime (fromGregorian 2024 05 30) (TimeOfDay 16 15 18)) utc)+ , testReadFormat+ "zonedTimeFormat"+ iso8601Format+ "2024-05-30T16:15:18"+ (ZonedTime (LocalTime (fromGregorian 2024 05 30) (TimeOfDay 16 15 18)) utc) , testShowReadFormat "utcTimeFormat" iso8601Format@@ -290,6 +314,11 @@ "utcTimeFormat" iso8601Format "2028-12-31T23:59:60.9Z"+ (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9))+ , testReadFormat+ "utcTimeFormat"+ iso8601Format+ "2028-12-31T23:59:60.9" (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)
test/main/Test/Format/ParseTime.hs view
@@ -480,6 +480,18 @@ instance HasFormatCodes TimeOfDay where allFormatCodes _ = [(False, s) | s <- "RTXrPpHkIlMSqQ"] +instance HasFormatCodes DayOfWeek where+ allFormatCodes _ = [(False, s) | s <- "uwaA"]++instance HasFormatCodes Month where+ allFormatCodes _ = [(False, s) | s <- "YyCBbhm"]++instance HasFormatCodes QuarterOfYear where+ allFormatCodes _ = [(False, s) | s <- "v"]++instance HasFormatCodes Quarter where+ allFormatCodes _ = allFormatCodes (Proxy :: Proxy QuarterOfYear) ++ [(False, s) | s <- "YyC"]+ instance HasFormatCodes LocalTime where allFormatCodes _ = allFormatCodes (Proxy :: Proxy Day) ++ allFormatCodes (Proxy :: Proxy TimeOfDay) @@ -542,6 +554,7 @@ typedTests prop = [ nameTest "Day" $ tgroup dayFormats prop , nameTest "Month" $ tgroup monthFormats prop+ , nameTest "Quarter" $ tgroup quarterFormats prop , nameTest "TimeOfDay" $ tgroup timeOfDayFormats prop , nameTest "LocalTime" $ tgroup localTimeFormats prop , nameTest "TimeZone" $ tgroup timeZoneFormats prop@@ -552,7 +565,7 @@ , nameTest "UTCTime" $ tgroup utcTimeAlmostFormats $ \fmt t -> utctDayTime t < 86400 ==> prop fmt t , nameTest "UniversalTime" $ tgroup universalTimeFormats prop , nameTest "CalendarDiffDays" $ tgroup calendarDiffDaysFormats prop- , nameTest "CalenderDiffTime" $ tgroup calendarDiffTimeFormats prop+ , nameTest "CalendarDiffTime" $ tgroup calendarDiffTimeFormats prop , nameTest "DiffTime" $ tgroup diffTimeFormats prop , nameTest "NominalDiffTime" $ tgroup nominalDiffTimeFormats prop ]@@ -563,6 +576,10 @@ allTypes f = [ f "Day" (Proxy :: Proxy Day) , f "TimeOfDay" (Proxy :: Proxy TimeOfDay)+ , f "DayOfWeek" (Proxy :: Proxy DayOfWeek)+ , f "Month" (Proxy :: Proxy Month)+ , f "QuarterOfYear" (Proxy :: Proxy QuarterOfYear)+ , f "Quarter" (Proxy :: Proxy Quarter) , f "LocalTime" (Proxy :: Proxy LocalTime) , f "TimeZone" (Proxy :: Proxy TimeZone) , f "ZonedTime" (Proxy :: Proxy ZonedTime)@@ -605,6 +622,85 @@ parseEmptyTests :: TestTree parseEmptyTests = nameTest "parse empty" $ allTypes $ \name p -> nameTest name $ parseEmptyTest p +class (Eq a, Show a, ParseTime a) => TestParse a where+ nonPosixValue :: a -> Bool+ nonPosixValue _ = False++instance TestParse UTCTime where+ nonPosixValue (UTCTime _ dt) = dt >= 86400 || dt < 0++instance TestParse ZonedTime where+ nonPosixValue (ZonedTime t _) = nonPosixValue t++instance TestParse TimeZone++instance TestParse LocalTime where+ nonPosixValue (LocalTime _ t) = nonPosixValue t++instance TestParse Day++instance TestParse Month++instance TestParse DayOfWeek++instance TestParse TimeOfDay where+ nonPosixValue (TimeOfDay _ _ s) = s >= 60 || s < 0++prop_parse_s :: forall a. TestParse a => (UTCTime -> a) -> UTCTime -> Result+prop_parse_s f t =+ if nonPosixValue t+ then succeeded+ else+ let+ str = format "%s%Q" t+ found = parse False "%s%Q" str+ expected = f t+ in+ compareResult (Just expected) found++prop_parse_sz :: forall a. TestParse a => (ZonedTime -> a) -> ZonedTime -> Result+prop_parse_sz f t =+ if nonPosixValue t+ then succeeded+ else+ let+ str = format "%s%Q %z" t+ found = parse False "%s%Q %z" str+ expected = f t+ in+ compareResult (Just expected) found++zeroTimeZone :: TimeZone+zeroTimeZone = TimeZone 0 False ""++parse_s_tests :: TestTree+parse_s_tests =+ nameTest+ "parse_s"+ [ nameTest "UTCTime" $ prop_parse_s @UTCTime id+ , nameTest "ZonedTime" $ prop_parse_s @ZonedTime $ utcToZonedTime zeroTimeZone+ , nameTest "TimeZone" $ prop_parse_s @TimeZone $ \_ -> zeroTimeZone+ , nameTest "LocalTime" $ prop_parse_s @LocalTime $ utcToLocalTime zeroTimeZone+ , nameTest "Day" $ prop_parse_s @Day utctDay+ , nameTest "Month" $ prop_parse_s @Month $ (\(MonthDay m _) -> m) . utctDay+ , nameTest "DayOfWeek" $ prop_parse_s @DayOfWeek $ dayOfWeek . utctDay+ , nameTest "TimeOfDay" $ prop_parse_s @TimeOfDay $ localTimeOfDay . utcToLocalTime zeroTimeZone+ ]++parse_sz_tests :: TestTree+parse_sz_tests =+ nameTest+ "parse_sz"+ [ nameTest "UTCTime" $ prop_parse_sz @UTCTime zonedTimeToUTC+ , nameTest "ZonedTime" $ prop_parse_sz @ZonedTime id+ , nameTest "TimeZone" $ prop_parse_sz @TimeZone zonedTimeZone+ , nameTest "LocalTime" $ prop_parse_sz @LocalTime zonedTimeToLocalTime+ , nameTest "Day" $ prop_parse_sz @Day $ localDay . zonedTimeToLocalTime+ , nameTest "Month" $ prop_parse_sz @Month $ (\(MonthDay m _) -> m) . localDay . zonedTimeToLocalTime+ , nameTest "DayOfWeek" $ prop_parse_sz @DayOfWeek $ dayOfWeek . localDay . zonedTimeToLocalTime+ , nameTest "TimeOfDay" $ prop_parse_sz @TimeOfDay $ localTimeOfDay . zonedTimeToLocalTime+ ]+ formatParseFormatTests :: TestTree formatParseFormatTests = nameTest@@ -680,6 +776,8 @@ , nameTest "parse_format_lower" $ typedTests prop_parse_format_lower , nameTest "parse_format_upper" $ typedTests prop_parse_format_upper , parseEmptyTests+ , parse_s_tests+ , parse_sz_tests , formatParseFormatTests , badInputTests ]@@ -752,6 +850,22 @@ , "%C-%y-%B" , "%C-%y-%b" , "%C-%y-%h"+ ]++quarterFormats :: [FormatString Quarter]+quarterFormats =+ map+ FormatString+ -- numeric year, quarter+ [ "%Y-%v"+ , "%Y-Q%v"+ , "%YQ%v"+ , "%C%y%v"+ , "%Y %v"+ , "%v/%Y"+ , "%v/%Y"+ , "%Y/%vm"+ , "%C %y %v" ] timeOfDayFormats :: [FormatString TimeOfDay]
test/main/Test/LocalTime/CalendarDiffTime.hs view
@@ -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 ]
test/main/Test/TestUtil.hs view
@@ -32,5 +32,8 @@ instance (Arbitrary a, Show a, Testable b) => NameTest (a -> b) where nameTest name = nameTest name . property +instance Testable a => NameTest (Gen a) where+ nameTest name = nameTest name . property+ tgroup :: (Show a, NameTest t) => [a] -> (a -> t) -> [TestTree] tgroup aa f = fmap (\a -> nameTest (show a) $ f a) aa
+ test/template/Main.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Data.Time.Clock+#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 =+ testGroup+ "Lift instances"+ [ testCase "DiffTime" $ $$(TH.liftTyped (secondsToDiffTime 100)) @?= secondsToDiffTime 100+ , testCase "NominalDiffTime" $ $$(TH.liftTyped (secondsToNominalDiffTime 100)) @?= secondsToNominalDiffTime 100+ ]++tests :: TestTree+tests =+ testGroup+ "time-template"+ [ testLift+ ]++main :: IO ()+main = tastyWrapper $ defaultMain tests
+ test/template/Test/TastyWrapper.hs view
@@ -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
test/unix/Test/Format/Format.hs view
@@ -150,9 +150,14 @@ isPadChar _ = False unixWorkarounds _ s = s +lastM :: [a] -> Maybe a+lastM [] = Nothing+lastM [a] = Just a+lastM (_ : aa) = lastM aa+ compareFormat :: (String -> String) -> String -> TimeZone -> UTCTime -> Result compareFormat _modUnix fmt zone _time- | last fmt == 'Z' && timeZoneName zone == "" = rejected+ | lastM fmt == Just 'Z' && timeZoneName zone == "" = rejected compareFormat modUnix fmt zone time = let ctime = utcToZonedTime zone time
time.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: time-version: 1.14+version: 1.16 stability: stable license: BSD-2-Clause license-file: LICENSE@@ -13,9 +13,10 @@ category: Time build-type: Configure tested-with:- GHC == 9.4.8,- GHC == 9.6.4,- GHC == 9.8.2+ GHC == 9.8.4,+ GHC == 9.10.3,+ GHC == 9.12.4,+ GHC == 9.14.1 x-follows-version-policy: extra-source-files:@@ -40,21 +41,27 @@ library hs-source-dirs: lib- default-language: Haskell2010+ default-language: GHC2021 default-extensions:- Rank2Types- DeriveDataTypeable- DeriveLift- DeriveGeneric- StandaloneDeriving+ NoGeneralizedNewtypeDeriving+ LambdaCase PatternSynonyms ViewPatterns- ghc-options: -Wall -fwarn-tabs+ ghc-options:+ -Wall+ -fwarn-tabs+ -Wno-deriving-typeable c-sources: lib/cbits/HsTime.c build-depends:- base >= 4.14 && < 5,+ base >= 4.19 && < 5, deepseq >= 1.1,- template-haskell >= 2.16,+ -- 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:@@ -72,7 +79,6 @@ Data.Time.Clock.TAI, Data.Time.LocalTime, Data.Time.Format,- Data.Time.Format.Internal, Data.Time.Format.ISO8601, Data.Time other-modules:@@ -84,6 +90,7 @@ Data.Time.Calendar.Private, Data.Time.Calendar.Types, Data.Time.Calendar.Week,+ Data.Time.Format.Internal, Data.Time.Clock.Internal.DiffTime, Data.Time.Clock.Internal.AbsoluteTime, Data.Time.Clock.Internal.NominalDiffTime,@@ -92,8 +99,8 @@ Data.Time.Clock.Internal.SystemTime, Data.Time.Clock.Internal.UTCTime, Data.Time.Clock.Internal.CTimeval,- Data.Time.Clock.Internal.CTimespec, Data.Time.Clock.Internal.UTCDiff,+ Data.Time.LocalTime.Internal.Foreign, Data.Time.LocalTime.Internal.TimeZone, Data.Time.LocalTime.Internal.TimeOfDay, Data.Time.LocalTime.Internal.CalendarDiffTime,@@ -105,6 +112,9 @@ Data.Time.Format.Format.Instances, Data.Time.Format.Parse.Class, Data.Time.Format.Parse.Instances+ if !impl(mhs)+ other-modules:+ Data.Time.Clock.Internal.CTimespec include-dirs: lib/include if os(windows) install-includes:@@ -119,7 +129,7 @@ test-suite ShowDefaultTZAbbreviations type: exitcode-stdio-1.0 hs-source-dirs: test- default-language: Haskell2010+ default-language: GHC2021 ghc-options: -Wall -fwarn-tabs build-depends: base,@@ -129,32 +139,39 @@ test-suite ShowTime type: exitcode-stdio-1.0 hs-source-dirs: test- default-language: Haskell2010+ default-language: GHC2021 ghc-options: -Wall -fwarn-tabs build-depends: base, time main-is: ShowTime.hs +test-suite ForeignCalls+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-language: GHC2021+ ghc-options: -Wall -fwarn-tabs+ build-depends:+ base,+ time+ main-is: ForeignCalls.hs+ test-suite test-main+ if arch (javascript)+ -- blocked by splitmix+ -- https://github.com/haskellari/splitmix/issues/93+ buildable: False type: exitcode-stdio-1.0 hs-source-dirs: test/main- default-language: Haskell2010+ default-language: GHC2021 default-extensions:- Rank2Types- TypeApplications- GeneralizedNewtypeDeriving- DeriveDataTypeable- StandaloneDeriving+ DefaultSignatures DerivingStrategies- ExistentialQuantification- MultiParamTypeClasses- FlexibleInstances- UndecidableInstances- ScopedTypeVariables- TupleSections RecordWildCards+ UndecidableInstances ghc-options: -Wall -fwarn-tabs+ if !arch (wasm32)+ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base, deepseq,@@ -164,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@@ -191,7 +212,7 @@ Test.Calendar.Week Test.Calendar.Year Test.Clock.Conversion- Test.Clock.Lift+ Test.Clock.Pattern Test.Clock.Resolution Test.Clock.TAI Test.Format.Compile@@ -203,22 +224,46 @@ Test.LocalTime.TimeOfDay Test.LocalTime.TimeRef +test-suite test-template+ if arch (wasm32)+ buildable: False+ type: exitcode-stdio-1.0+ hs-source-dirs: test/template+ default-language: GHC2021+ default-extensions:+ DerivingStrategies+ UndecidableInstances+ RecordWildCards+ TemplateHaskell+ ghc-options: -Wall -fwarn-tabs+ build-depends:+ base,+ deepseq,+ time,+ random,+ QuickCheck,+ tasty,+ tasty-hunit,+ tasty-quickcheck,+ 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)+ if os(windows) || arch (javascript) || arch (wasm32) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: test/unix- default-language: Haskell2010+ default-language: GHC2021 default-extensions:- Rank2Types- DeriveDataTypeable- StandaloneDeriving- ExistentialQuantification- MultiParamTypeClasses- FlexibleInstances UndecidableInstances- ScopedTypeVariables ghc-options: -Wall -fwarn-tabs+ if !arch (wasm32)+ ghc-options: -threaded -rtsopts -with-rtsopts=-N c-sources: test/unix/Test/Format/FormatStuff.c build-depends: base,@@ -238,11 +283,15 @@ benchmark time-bench type: exitcode-stdio-1.0 hs-source-dirs: benchmark- default-language: Haskell2010+ default-language: GHC2021 ghc-options: -Wall -fwarn-tabs build-depends: base, 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