packages feed

time 1.10 → 1.11

raw patch · 36 files changed

+1021/−421 lines, 36 filesdep +criteriondep ~basedep ~deepseq

Dependencies added: criterion

Dependency ranges changed: base, deepseq

Files

LICENSE view
@@ -1,4 +1,4 @@-TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.+TimeLib is Copyright (c) Ashley Yakeley and contributors, 2004-2020. All rights reserved. Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+ benchmark/Main.hs view
@@ -0,0 +1,21 @@+module Main where++import Criterion.Main+import Data.Time+import Data.Time.Clock.POSIX+import Data.Time.Clock.System++main :: IO ()+main = do+    getCurrentTime >>= print+    getPOSIXTime >>= print . posixSecondsToUTCTime+    getZonedTime >>= print+    ct <- getCurrentTime+    defaultMain+        [ bench "getCurrentTime" $ nfIO getCurrentTime+        , bench "getPOSIXTime" $ nfIO getPOSIXTime+        , bench "getSystemTime" $ nfIO getSystemTime+        , bench "getTimeZone" $ nfIO $ getTimeZone ct+        , bench "getCurrentTimeZone" $ nfIO getCurrentTimeZone+        , bench "getZonedTime" $ nfIO getZonedTime+        ]
changelog.md view
@@ -1,5 +1,15 @@ # Change Log +## [1.11]+- new calendrical type synonyms and abstract constructors+- new Month type, with appropriate functions+- new QuarterOfYear and Quarter type, with appropriate functions+- new functions for working with week-based years+- new parseTimeMultipleM function for a list of (format, input) pairs+- add instance Ord DayOfWeek+- add instance Read DiffTime (and NominalDiffTime)+- change instance Read UTCTime to allow omitted timezone+ ## [1.10] - remove deprecated functions parseTime, readTime, readsTime - deprecate iso8601DateFormat
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell time package], [1.10], [ashley@semantic.org], [time])+AC_INIT([Haskell time package], [1.11], [ashley@semantic.org], [time])  # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h])
lib/Data/Time.hs view
@@ -11,6 +11,9 @@  * 'Day' for something like June 27th 2017 * 'DayOfWeek' for something like Tuesday+* 'Data.Time.Calendar.Month.Month' for something like August 2021+* 'Data.Time.Calendar.Quarter.QuarterOfYear' for something like Q2+* 'Data.Time.Calendar.Quarter.Quarter' for something like Q2 of 2023 * 'TimeOfDay' for something like 5pm * 'LocalTime' for a 'Day' with a 'TimeOfDay' * 'TimeZone' for a time zone offset (not actually the time zone itself) like -0700
lib/Data/Time/Calendar/Days.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS -fno-warn-unused-imports #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Data.Time.Calendar.Days     (@@ -11,7 +12,6 @@ import Control.DeepSeq import Data.Data import Data.Ix-import Data.Typeable  -- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17. newtype Day = ModifiedJulianDay
lib/Data/Time/Calendar/Easter.hs view
@@ -15,7 +15,7 @@ sundayAfter day = addDays (7 - (mod (toModifiedJulianDay day + 3) 7)) day  -- | Given a year, find the Paschal full moon according to Orthodox Christian tradition-orthodoxPaschalMoon :: Integer -> Day+orthodoxPaschalMoon :: Year -> Day orthodoxPaschalMoon year = addDays (-shiftedEpact) (fromJulian jyear 4 19)   where     shiftedEpact = mod (14 + 11 * (mod year 19)) 30@@ -25,11 +25,11 @@             else year - 1  -- | Given a year, find Easter according to Orthodox Christian tradition-orthodoxEaster :: Integer -> Day+orthodoxEaster :: Year -> Day orthodoxEaster = sundayAfter . orthodoxPaschalMoon  -- | Given a year, find the Paschal full moon according to the Gregorian method-gregorianPaschalMoon :: Integer -> Day+gregorianPaschalMoon :: Year -> Day gregorianPaschalMoon year = addDays (-adjustedEpact) (fromGregorian year 4 19)   where     century = (div year 100) + 1@@ -40,5 +40,5 @@             else shiftedEpact  -- | Given a year, find Easter according to the Gregorian method-gregorianEaster :: Integer -> Day+gregorianEaster :: Year -> Day gregorianEaster = sundayAfter . gregorianPaschalMoon
lib/Data/Time/Calendar/Gregorian.hs view
@@ -2,9 +2,14 @@  module Data.Time.Calendar.Gregorian     (+    -- * Year, month and day+      Year+    , MonthOfYear+    , DayOfMonth     -- * Gregorian calendar-      toGregorian+    , toGregorian     , fromGregorian+    , pattern YearMonthDay     , fromGregorianValid     , showGregorian     , gregorianMonthLength@@ -22,27 +27,38 @@     , isLeapYear     ) where +import Data.Time.Calendar.Types 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 --- | Convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31).-toGregorian :: Day -> (Integer, Int, Int)+-- | Convert to proleptic Gregorian calendar.+toGregorian :: Day -> (Year, MonthOfYear, DayOfMonth) toGregorian date = (year, month, day)   where     (year, yd) = toOrdinalDate date     (month, day) = dayOfYearToMonthAndDay (isLeapYear year) yd --- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).+-- | Convert from proleptic Gregorian calendar. -- Invalid values will be clipped to the correct range, month first, then day.-fromGregorian :: Integer -> Int -> Int -> Day+fromGregorian :: Year -> MonthOfYear -> DayOfMonth -> Day fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day) --- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).+-- | Bidirectional abstract constructor for the proleptic Gregorian calendar.+-- Invalid values will be clipped to the correct range, month first, then day.+pattern YearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day+pattern YearMonthDay y m d <- (toGregorian -> (y,m,d)) where+    YearMonthDay y m d = fromGregorian y m d++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE YearMonthDay #-}+#endif++-- | Convert from proleptic Gregorian calendar. -- Invalid values will return Nothing-fromGregorianValid :: Integer -> Int -> Int -> Maybe Day+fromGregorianValid :: Year -> MonthOfYear -> DayOfMonth -> Maybe Day fromGregorianValid year month day = do     doy <- monthAndDayToDayOfYearValid (isLeapYear year) month day     fromOrdinalDateValid year doy@@ -53,14 +69,14 @@   where     (y, m, d) = toGregorian date --- | The number of days in a given month according to the proleptic Gregorian calendar. First argument is year, second is month.-gregorianMonthLength :: Integer -> Int -> Int+-- | The number of days in a given month according to the proleptic Gregorian calendar.+gregorianMonthLength :: Year -> MonthOfYear -> DayOfMonth gregorianMonthLength year = monthLength (isLeapYear year) -rolloverMonths :: (Integer, Integer) -> (Integer, Int)+rolloverMonths :: (Year, Integer) -> (Year, MonthOfYear) rolloverMonths (y, m) = (y + (div (m - 1) 12), fromIntegral (mod (m - 1) 12) + 1) -addGregorianMonths :: Integer -> Day -> (Integer, Int, Int)+addGregorianMonths :: Integer -> Day -> (Year, MonthOfYear, DayOfMonth) addGregorianMonths n day = (y', m', d)   where     (y, m, d) = toGregorian day
lib/Data/Time/Calendar/Julian.hs view
@@ -1,7 +1,12 @@ module Data.Time.Calendar.Julian-    ( module Data.Time.Calendar.JulianYearDay+    ( Year+    , MonthOfYear+    , DayOfMonth+    , DayOfYear+    , module Data.Time.Calendar.JulianYearDay     , toJulian     , fromJulian+    , pattern JulianYearMonthDay     , fromJulianValid     , showJulian     , julianMonthLength@@ -17,27 +22,38 @@     , diffJulianDurationRollOver     ) where +import Data.Time.Calendar.Types import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days import Data.Time.Calendar.JulianYearDay import Data.Time.Calendar.MonthDay import Data.Time.Calendar.Private --- | Convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31).-toJulian :: Day -> (Integer, Int, Int)+-- | Convert to proleptic Julian calendar.+toJulian :: Day -> (Year, MonthOfYear, DayOfMonth) toJulian date = (year, month, day)   where     (year, yd) = toJulianYearAndDay date     (month, day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd --- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).+-- | Convert from proleptic Julian calendar. -- Invalid values will be clipped to the correct range, month first, then day.-fromJulian :: Integer -> Int -> Int -> Day+fromJulian :: Year -> MonthOfYear -> DayOfMonth -> Day fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day) --- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).+-- | Bidirectional abstract constructor for the proleptic Julian calendar.+-- Invalid values will be clipped to the correct range, month first, then day.+pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day+pattern JulianYearMonthDay y m d <- (toJulian -> (y,m,d)) where+    JulianYearMonthDay y m d = fromJulian y m d++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE JulianYearMonthDay #-}+#endif++-- | Convert from proleptic Julian calendar. -- Invalid values will return Nothing.-fromJulianValid :: Integer -> Int -> Int -> Maybe Day+fromJulianValid :: Year -> MonthOfYear -> DayOfMonth -> Maybe Day fromJulianValid year month day = do     doy <- monthAndDayToDayOfYearValid (isJulianLeapYear year) month day     fromJulianYearAndDayValid year doy@@ -48,14 +64,14 @@   where     (y, m, d) = toJulian date --- | The number of days in a given month according to the proleptic Julian calendar. First argument is year, second is month.-julianMonthLength :: Integer -> Int -> Int+-- | The number of days in a given month according to the proleptic Julian calendar.+julianMonthLength :: Year -> MonthOfYear -> DayOfMonth julianMonthLength year = monthLength (isJulianLeapYear year) -rolloverMonths :: (Integer, Integer) -> (Integer, Int)+rolloverMonths :: (Year, Integer) -> (Year, MonthOfYear) rolloverMonths (y, m) = (y + (div (m - 1) 12), fromIntegral (mod (m - 1) 12) + 1) -addJulianMonths :: Integer -> Day -> (Integer, Int, Int)+addJulianMonths :: Integer -> Day -> (Year, MonthOfYear, DayOfMonth) addJulianMonths n day = (y', m', d)   where     (y, m, d) = toJulian day
lib/Data/Time/Calendar/JulianYearDay.hs view
@@ -4,12 +4,12 @@       module Data.Time.Calendar.JulianYearDay     ) where +import Data.Time.Calendar.Types import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | Convert to proleptic Julian year and day format. First element of result is year (proleptic Julian calendar),--- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.-toJulianYearAndDay :: Day -> (Integer, Int)+-- | Convert to proleptic Julian year and day format.+toJulianYearAndDay :: Day -> (Year, DayOfYear) toJulianYearAndDay (ModifiedJulianDay mjd) = (year, yd)   where     a = mjd + 678577@@ -21,7 +21,7 @@  -- | Convert from proleptic Julian year and day format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).-fromJulianYearAndDay :: Integer -> Int -> Day+fromJulianYearAndDay :: Year -> DayOfYear -> Day fromJulianYearAndDay year day = ModifiedJulianDay mjd   where     y = year - 1@@ -39,7 +39,7 @@  -- | Convert from proleptic Julian year and day format. -- Invalid day numbers will return Nothing-fromJulianYearAndDayValid :: Integer -> Int -> Maybe Day+fromJulianYearAndDayValid :: Year -> DayOfYear -> Maybe Day fromJulianYearAndDayValid year day = do     day' <-         clipValid@@ -60,5 +60,5 @@     (y, d) = toJulianYearAndDay date  -- | Is this year a leap year according to the proleptic Julian calendar?-isJulianLeapYear :: Integer -> Bool+isJulianLeapYear :: Year -> Bool isJulianLeapYear year = (mod year 4 == 0)
+ lib/Data/Time/Calendar/Month.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-}+#endif++-- | An absolute count of common calendar months.+module Data.Time.Calendar.Month+    (+        Month(..), addMonths, diffMonths,+        pattern YearMonth,+        fromYearMonthValid,+        pattern MonthDay,+        fromMonthDayValid+    ) where++import Data.Time.Calendar.Types+import Data.Time.Calendar.Days+import Data.Time.Calendar.Gregorian+import Data.Time.Calendar.Private+import Data.Data+import Data.Fixed+import Text.Read+import Text.ParserCombinators.ReadP++-- | An absolute count of common calendar months.+-- Number is equal to @(year * 12) + (monthOfYear - 1)@.+newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable)++-- | Show as @yyyy-mm@.+instance Show Month where+    show (YearMonth y m) = show4 y ++ "-" ++ show2 m++-- | Read as @yyyy-mm@.+instance Read Month where+    readPrec = do+        y <- readPrec+        _ <- lift $ char '-'+        m <- readPrec+        return $ YearMonth y m++addMonths :: Integer -> Month -> Month+addMonths n (MkMonth a) = MkMonth $ a + n++diffMonths :: Month -> Month -> Integer+diffMonths (MkMonth a) (MkMonth b) = a - b++-- | Bidirectional abstract constructor.+-- 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)) where+    YearMonth y my = MkMonth $ (y * 12) + toInteger (pred $ clip 1 12 my)++fromYearMonthValid :: Year -> MonthOfYear -> Maybe Month+fromYearMonthValid y my = do+    my' <- clipValid 1 12 my+    return $ YearMonth y my'++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE YearMonth #-}+#endif++toMonthDay :: Day -> (Month,DayOfMonth)+toMonthDay (YearMonthDay y my dm) = (YearMonth y my, dm)++-- | Bidirectional abstract constructor.+-- Invalid days of month will be clipped to the correct range.+pattern MonthDay :: Month -> DayOfMonth -> Day+pattern MonthDay m dm <- (toMonthDay -> (m,dm)) where+    MonthDay (YearMonth y my) dm = YearMonthDay y my dm++fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day+fromMonthDayValid (YearMonth y my) dm = fromGregorianValid y my dm++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE MonthDay #-}+#endif
lib/Data/Time/Calendar/MonthDay.hs view
@@ -1,15 +1,17 @@ module Data.Time.Calendar.MonthDay-    ( monthAndDayToDayOfYear+    ( MonthOfYear, DayOfMonth, DayOfYear+    , monthAndDayToDayOfYear     , monthAndDayToDayOfYearValid     , dayOfYearToMonthAndDay     , monthLength     ) where +import Data.Time.Calendar.Types import Data.Time.Calendar.Private  -- | Convert month and day in the Gregorian or Julian calendars to day of year. -- First arg is leap year flag.-monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int+monthAndDayToDayOfYear :: Bool -> MonthOfYear -> DayOfMonth -> DayOfYear monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day'   where     month' = clip 1 12 month@@ -24,7 +26,7 @@  -- | Convert month and day in the Gregorian or Julian calendars to day of year. -- First arg is leap year flag.-monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int+monthAndDayToDayOfYearValid :: Bool -> MonthOfYear -> DayOfMonth -> Maybe DayOfYear monthAndDayToDayOfYearValid isLeap month day = do     month' <- clipValid 1 12 month     day' <- clipValid 1 (monthLength' isLeap month') day@@ -41,7 +43,7 @@  -- | Convert day of year in the Gregorian or Julian calendars to month and day. -- First arg is leap year flag.-dayOfYearToMonthAndDay :: Bool -> Int -> (Int, Int)+dayOfYearToMonthAndDay :: Bool -> DayOfYear -> (MonthOfYear, DayOfMonth) dayOfYearToMonthAndDay isLeap yd =     findMonthDay         (monthLengths isLeap)@@ -59,13 +61,13 @@  -- | The length of a given month in the Gregorian or Julian calendars. -- First arg is leap year flag.-monthLength :: Bool -> Int -> Int+monthLength :: Bool -> MonthOfYear -> DayOfMonth monthLength isLeap month' = monthLength' isLeap (clip 1 12 month') -monthLength' :: Bool -> Int -> Int+monthLength' :: Bool -> MonthOfYear -> DayOfMonth monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1) -monthLengths :: Bool -> [Int]+monthLengths :: Bool -> [DayOfMonth] monthLengths isleap =     [ 31     , if isleap
lib/Data/Time/Calendar/OrdinalDate.hs view
@@ -1,12 +1,12 @@ -- | ISO 8601 Ordinal Date format-module Data.Time.Calendar.OrdinalDate where+module Data.Time.Calendar.OrdinalDate (Day, Year, DayOfYear, WeekOfYear, module Data.Time.Calendar.OrdinalDate) where +import Data.Time.Calendar.Types import Data.Time.Calendar.Days import Data.Time.Calendar.Private --- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar),--- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.-toOrdinalDate :: Day -> (Integer, Int)+-- | Convert to ISO 8601 Ordinal Date format.+toOrdinalDate :: Day -> (Year, DayOfYear) toOrdinalDate (ModifiedJulianDay mjd) = (year, yd)   where     a = mjd + 678575@@ -22,7 +22,7 @@  -- | Convert from ISO 8601 Ordinal Date format. -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).-fromOrdinalDate :: Integer -> Int -> Day+fromOrdinalDate :: Year -> DayOfYear -> Day fromOrdinalDate year day = ModifiedJulianDay mjd   where     y = year - 1@@ -40,9 +40,19 @@         (div y 400) -         678576 +-- | Bidirectional abstract constructor for ISO 8601 Ordinal Date format.+-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).+pattern YearDay :: Year -> DayOfYear -> Day+pattern YearDay y d <- (toOrdinalDate -> (y,d)) where+    YearDay y d = fromOrdinalDate y d++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE YearDay #-}+#endif+ -- | Convert from ISO 8601 Ordinal Date format. -- Invalid day numbers return 'Nothing'-fromOrdinalDateValid :: Integer -> Int -> Maybe Day+fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day fromOrdinalDateValid year day = do     day' <-         clipValid@@ -63,13 +73,13 @@     (y, d) = toOrdinalDate date  -- | Is this year a leap year according to the proleptic Gregorian calendar?-isLeapYear :: Integer -> Bool+isLeapYear :: Year -> Bool isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))  -- | Get the number of the Monday-starting week in the year and the day of the week. -- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').-mondayStartWeek :: Day -> (Int, Int)+mondayStartWeek :: Day -> (WeekOfYear, Int) mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)), fromInteger (mod d 7) + 1)   where     yd = snd (toOrdinalDate date)@@ -79,7 +89,7 @@ -- | Get the number of the Sunday-starting week in the year and the day of the week. -- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').-sundayStartWeek :: Day -> (Int, Int)+sundayStartWeek :: Day -> (WeekOfYear, Int) sundayStartWeek date = (fromInteger ((div d 7) - (div k 7)), fromInteger (mod d 7))   where     yd = snd (toOrdinalDate date)@@ -91,8 +101,8 @@ -- The first Monday is the first day of week 1, any earlier days in the year -- are week 0 (as @%W@ in 'Data.Time.Format.formatTime'). fromMondayStartWeek ::-       Integer -- ^ Year.-    -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').+       Year -- ^ Year.+    -> WeekOfYear -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').     -> Int -- ^ Day of week.                                -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').     -> Day@@ -110,8 +120,8 @@     in addDays zbYearDay firstDay  fromMondayStartWeekValid ::-       Integer -- ^ Year.-    -> Int -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').+       Year -- ^ Year.+    -> WeekOfYear -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').     -> Int -- ^ Day of week.                                -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').     -> Maybe Day@@ -142,8 +152,8 @@ -- The first Sunday is the first day of week 1, any earlier days in the -- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime'). fromSundayStartWeek ::-       Integer -- ^ Year.-    -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').+       Year -- ^ Year.+    -> WeekOfYear -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').     -> Int -- ^ Day of week                                -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').     -> Day@@ -161,8 +171,8 @@     in addDays zbYearDay firstDay  fromSundayStartWeekValid ::-       Integer -- ^ Year.-    -> Int -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').+       Year -- ^ Year.+    -> WeekOfYear -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').     -> Int -- ^ Day of week.                                -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').     -> Maybe Day
+ lib/Data/Time/Calendar/Quarter.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-}+#endif++-- | Year quarters.+module Data.Time.Calendar.Quarter+    (+        QuarterOfYear(..), addQuarters, diffQuarters,+        Quarter(..),+        pattern YearQuarter,+        monthOfYearQuarter,+        monthQuarter,+        dayQuarter+    ) where++import Data.Time.Calendar.Types+import Data.Time.Calendar.Private+import Data.Time.Calendar.Days+import Data.Time.Calendar.Month+import Data.Data+import Data.Fixed+import Text.Read+import Text.ParserCombinators.ReadP++-- | Quarters of each year. Each quarter corresponds to three months.+data QuarterOfYear = Q1 | Q2 | Q3 | Q4 deriving (Eq, Ord, Data, Typeable, Read, Show)++-- | maps Q1..Q4 to 1..4+instance Enum QuarterOfYear where+    toEnum i =+        case mod' i 4 of+            1 -> Q1+            2 -> Q2+            3 -> Q3+            _ -> Q4+    fromEnum Q1 = 1+    fromEnum Q2 = 2+    fromEnum Q3 = 3+    fromEnum Q4 = 4++instance Bounded QuarterOfYear where+    minBound = Q1+    maxBound = Q4++-- | An absolute count of year quarters.+-- Number is equal to @(year * 4) + (quarterOfYear - 1)@.+newtype Quarter = MkQuarter Integer deriving (Eq, Ord, Data, Typeable)++-- | Show as @yyyy-Qn@.+instance Show Quarter where+    show (YearQuarter y qy) = show4 y ++ "-" ++ show qy++-- | Read as @yyyy-Qn@.+instance Read Quarter where+    readPrec = do+        y <- readPrec+        _ <- lift $ char '-'+        m <- readPrec+        return $ YearQuarter y m++addQuarters :: Integer -> Quarter -> Quarter+addQuarters n (MkQuarter a) = MkQuarter $ a + n++diffQuarters :: Quarter -> Quarter -> Integer+diffQuarters (MkQuarter a) (MkQuarter b) = a - b++-- | Bidirectional abstract constructor.+pattern YearQuarter :: Year -> QuarterOfYear -> Quarter+pattern YearQuarter y qy <- MkQuarter ((\q -> divMod' q 4) -> (y,toEnum . succ . fromInteger -> qy)) where+    YearQuarter y qy = MkQuarter $ (y * 4) + toInteger (pred $ fromEnum qy)++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE YearQuarter #-}+#endif++monthOfYearQuarter :: MonthOfYear -> QuarterOfYear+monthOfYearQuarter my | my <= 3 = Q1+monthOfYearQuarter my | my <= 6 = Q2+monthOfYearQuarter my | my <= 9 = Q3+monthOfYearQuarter _ = Q4++monthQuarter :: Month -> Quarter+monthQuarter (YearMonth y my) = YearQuarter y $ monthOfYearQuarter my++dayQuarter :: Day -> Quarter+dayQuarter (MonthDay m _) = monthQuarter m
+ lib/Data/Time/Calendar/Types.hs view
@@ -0,0 +1,18 @@+module Data.Time.Calendar.Types where+++-- | Year of Common Era.+type Year = Integer++-- | Month of year, in range 1 (January) to 12 (December).+type MonthOfYear = Int++-- | Day of month, in range 1 to 31.+type DayOfMonth = Int++-- | Day of year, in range 1 (January 1st) to 366.+-- December 31st is 365 in a common year, 366 in a leap year.+type DayOfYear = Int++-- | Week of year, by various reckonings, generally in range 0-53 depending on reckoning+type WeekOfYear = Int
lib/Data/Time/Calendar/Week.hs view
@@ -3,8 +3,11 @@       -- * Week       DayOfWeek(..)     , dayOfWeek+    , dayOfWeekDiff+    , firstDayOfWeekOnAfter     ) where +import Data.Fixed import Data.Data import Data.Time.Calendar.Days @@ -16,7 +19,7 @@     | Friday     | Saturday     | Sunday-    deriving (Eq, Show, Read, Data, Typeable)+    deriving (Eq, Show, Read, Data, Typeable, Ord)  -- | \"Circular\", so for example @[Tuesday ..]@ gives an endless sequence. -- Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday], and 'toEnum' performs mod 7 to give a cycle of days.@@ -46,3 +49,13 @@  dayOfWeek :: Day -> DayOfWeek dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3+++-- | @dayOfWeekDiff a b = a - b@ in range 0 to 6.+-- The number of days from b to the next a.+dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int+dayOfWeekDiff a b = mod' (fromEnum a - fromEnum b) 7++-- | The first day-of-week on or after some day+firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day+firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d
lib/Data/Time/Calendar/WeekDate.hs view
@@ -1,73 +1,113 @@--- | ISO 8601 Week Date format-module Data.Time.Calendar.WeekDate where+-- | Week-based calendars+module Data.Time.Calendar.WeekDate+    (+        Year, WeekOfYear, DayOfWeek(..), dayOfWeek,+        FirstWeekType (..),toWeekCalendar,fromWeekCalendar,fromWeekCalendarValid,+        -- * ISO 8601 Week Date format+        toWeekDate, fromWeekDate, pattern YearWeekDay,+        fromWeekDateValid, showWeekDate+    ) where +import Data.Time.Calendar.Types import Data.Time.Calendar.Days+import Data.Time.Calendar.Week import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private ++data FirstWeekType+    = FirstWholeWeek+    -- ^ first week is the first whole week of the year+    | FirstMostWeek+    -- ^ first week is the first week with four days in the year+    deriving Eq++firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day+firstDayOfWeekCalendar wt dow year = let+    jan1st = fromOrdinalDate year 1+    in case wt of+        FirstWholeWeek -> firstDayOfWeekOnAfter dow jan1st+        FirstMostWeek -> firstDayOfWeekOnAfter dow $ addDays (-3) jan1st++-- | Convert to the given kind of "week calendar".+-- Note that the year number matches the weeks, and so is not always the same as the Gregorian year number.+toWeekCalendar ::+    FirstWeekType+    -- ^ how to reckon the first week of the year+    -> DayOfWeek+    -- ^ the first day of each week+    -> Day+    -> (Year, WeekOfYear, DayOfWeek)+toWeekCalendar wt ws d = let+    dw = dayOfWeek d+    (y0,_) = toOrdinalDate d+    j1p = firstDayOfWeekCalendar wt ws $ pred y0+    j1 = firstDayOfWeekCalendar wt ws y0+    j1s = firstDayOfWeekCalendar wt ws $ succ y0+    in if d < j1+        then (pred y0,succ $ div (fromInteger $ diffDays d j1p) 7,dw)+        else if d < j1s then (y0,succ $ div (fromInteger $ diffDays d j1) 7,dw)+        else (succ y0,succ $ div (fromInteger $ diffDays d j1s) 7,dw)++-- | Convert from the given kind of "week calendar".+-- Invalid week and day values will be clipped to the correct range.+fromWeekCalendar ::+    FirstWeekType+    -- ^ how to reckon the first week of the year+    -> DayOfWeek+    -- ^ the first day of each week+    -> Year -> WeekOfYear -> DayOfWeek -> Day+fromWeekCalendar wt ws y wy dw = let+    d1 :: Day+    d1 = firstDayOfWeekCalendar wt ws y+    wy' = clip 1 53 wy+    getday :: WeekOfYear -> Day+    getday wy'' = addDays (toInteger $ (pred wy'' * 7) + (dayOfWeekDiff dw ws)) d1+    d1s = firstDayOfWeekCalendar wt ws $ succ y+    day = getday wy'+    in if wy' == 53 then if day >= d1s then getday 52 else day else day++-- | Convert from the given kind of "week calendar".+-- Invalid week and day values will return Nothing.+fromWeekCalendarValid ::+     FirstWeekType+    -- ^ how to reckon the first week of the year+    -> DayOfWeek+    -- ^ the first day of each week+    -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day+fromWeekCalendarValid wt ws y wy dw = let+    d = fromWeekCalendar wt ws y wy dw+    in if toWeekCalendar wt ws d == (y,wy,dw) then Just d else Nothing+ -- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday). -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday. -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year.-toWeekDate :: Day -> (Integer, Int, Int)-toWeekDate date@(ModifiedJulianDay mjd) = (y1, fromInteger (w1 + 1), fromInteger d_mod_7 + 1)-  where-    (d_div_7, d_mod_7) = d `divMod` 7-    (y0, yd) = toOrdinalDate date-    d = mjd + 2-    foo :: Integer -> Integer-    foo y = bar (toModifiedJulianDay (fromOrdinalDate y 6))-    bar k = d_div_7 - k `div` 7-    (y1, w1) =-        case bar (d - toInteger yd + 4) of-            -1 -> (y0 - 1, foo (y0 - 1))-            52 ->-                if foo (y0 + 1) == 0-                    then (y0 + 1, 0)-                    else (y0, 52)-            w0 -> (y0, w0)+toWeekDate :: Day -> (Year, WeekOfYear, Int)+toWeekDate d = let+    (y,wy,dw) = toWeekCalendar FirstMostWeek Monday d+    in (y,wy,fromEnum dw)  -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will be clipped to the correct range.-fromWeekDate :: Integer -> Int -> Int -> Day-fromWeekDate y w d =-    ModifiedJulianDay-        (k - (mod k 7) +-         (toInteger-              (((clip-                     1-                     (if longYear-                          then 53-                          else 52)-                     w) *-                7) +-               (clip 1 7 d))) --         10)-  where-    k = toModifiedJulianDay (fromOrdinalDate y 6)-    longYear =-        case toWeekDate (fromOrdinalDate y 365) of-            (_, 53, _) -> True-            _ -> False+fromWeekDate :: Year -> WeekOfYear -> Int -> Day+fromWeekDate y wy dw = fromWeekCalendar FirstMostWeek Monday y wy (toEnum $ clip 1 7 dw) +-- | Bidirectional abstract constructor for ISO 8601 Week Date format.+-- Invalid week values will be clipped to the correct range.+pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day+pattern YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where+    YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw)++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE YearWeekDay #-}+#endif+ -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday). -- Invalid week and day values will return Nothing.-fromWeekDateValid :: Integer -> Int -> Int -> Maybe Day-fromWeekDateValid y w d = do-    d' <- clipValid 1 7 d-    let-        longYear =-            case toWeekDate (fromOrdinalDate y 365) of-                (_, 53, _) -> True-                _ -> False-    w' <--        clipValid-            1-            (if longYear-                 then 53-                 else 52)-            w-    let k = toModifiedJulianDay (fromOrdinalDate y 6)-    return (ModifiedJulianDay (k - (mod k 7) + (toInteger ((w' * 7) + d')) - 10))+fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day+fromWeekDateValid y wy dwr = do+    dw <- clipValid 1 7 dwr+    fromWeekCalendarValid FirstMostWeek Monday y wy (toEnum dw)  -- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). showWeekDate :: Day -> String
lib/Data/Time/Clock/Internal/DiffTime.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE Trustworthy #-}-{-# OPTIONS -fno-warn-unused-imports #-}  module Data.Time.Clock.Internal.DiffTime     (@@ -13,12 +12,15 @@ import Control.DeepSeq import Data.Data import Data.Fixed-import Data.Ratio ((%))-import Data.Typeable+import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec+import GHC.Read  -- | This is a length of time, as measured by a clock.--- Conversion functions will treat it as seconds.--- It has a precision of 10^-12 s.+-- Conversion functions such as 'fromInteger' and 'realToFrac' will treat it as seconds.+-- For example, @(0.010 :: DiffTime)@ corresponds to 10 milliseconds.+--+-- 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)@@ -41,6 +43,12 @@  instance Show DiffTime where     show (MkDiffTime t) = (showFixed True t) ++ "s"++instance Read DiffTime where+    readPrec = do+        t <- readPrec+        _ <- lift $ char 's'+        return $ MkDiffTime t  -- necessary because H98 doesn't have "cunning newtype" derivation instance Num DiffTime where
lib/Data/Time/Clock/Internal/NominalDiffTime.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS -fno-warn-unused-imports #-} {-# LANGUAGE Trustworthy #-}  module Data.Time.Clock.Internal.NominalDiffTime@@ -11,15 +10,18 @@ import Control.DeepSeq import Data.Data import Data.Fixed-import Data.Time.Calendar.Days-import Data.Typeable+import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec+import GHC.Read  -- | This is a length of time, as measured by UTC. -- It has a precision of 10^-12 s. ----- Conversion functions will treat it as seconds.+-- 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.+-- -- 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.@@ -57,6 +59,12 @@  instance Show NominalDiffTime where     show (MkNominalDiffTime t) = (showFixed True t) ++ "s"++instance Read NominalDiffTime where+    readPrec = do+        t <- readPrec+        _ <- lift $ char 's'+        return $ MkNominalDiffTime t  -- necessary because H98 doesn't have "cunning newtype" derivation instance Num NominalDiffTime where
lib/Data/Time/Clock/Internal/SystemTime.hs view
@@ -1,5 +1,8 @@-{-# OPTIONS -fno-warn-trustworthy-safe #-}+#ifdef mingw32_HOST_OS+{-# LANGUAGE Safe #-}+#else {-# LANGUAGE Trustworthy #-}+#endif  module Data.Time.Clock.Internal.SystemTime     ( SystemTime(..)@@ -40,7 +43,8 @@ -- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored. -- 'getSystemTime' is typically much faster than 'getCurrentTime'. getSystemTime :: IO SystemTime--- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime'+-- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime'.+-- On UNIX systems this uses @clock_getres@, which may be <https://github.com/microsoft/WSL/issues/6029 wrong on WSL2>. getTime_resolution :: DiffTime -- | If supported, get TAI time, epoch start of 1970 TAI, with resolution. -- This is supported only on UNIX systems, and only those with CLOCK_TAI available at run-time.
lib/Data/Time/Format/Format/Class.hs view
@@ -209,14 +209,8 @@ -- -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@ ----- === 'Day'--- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):------ [@%D@] same as @%m\/%d\/%y@------ [@%F@] same as @%Y-%m-%d@------ [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@)+-- === 'Month'+-- For 'Month' (and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars --@@ -229,6 +223,15 @@ -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@ -- -- [@%m@] month of year, 0-padded to two chars, @01@ - @12@+--+-- === 'Day'+-- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):+--+-- [@%D@] same as @%m\/%d\/%y@+--+-- [@%F@] same as @%Y-%m-%d@+--+-- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@) -- -- [@%d@] day of month, 0-padded to two chars, @01@ - @31@ --
lib/Data/Time/Format/Format/Instances.hs view
@@ -1,15 +1,20 @@ {-# OPTIONS -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-}+#endif  module Data.Time.Format.Format.Instances     (     ) where +import Control.Applicative ((<|>)) import Data.Char import Data.Fixed import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.OrdinalDate+import Data.Time.Calendar.Month import Data.Time.Calendar.Private import Data.Time.Calendar.Week import Data.Time.Calendar.WeekDate@@ -26,15 +31,14 @@ import Data.Time.LocalTime.Internal.TimeZone import Data.Time.LocalTime.Internal.ZonedTime +mapFormatCharacter :: (b -> a) -> Maybe (FormatOptions -> a -> String) -> Maybe (FormatOptions -> b -> String)+mapFormatCharacter ba = fmap $ fmap $ \as -> as . ba+ instance FormatTime LocalTime where     formatCharacter _ 'c' = Just $ \fo -> formatTime (foLocale fo) $ dateTimeFmt $ foLocale fo     formatCharacter alt c =-        case formatCharacter alt c of-            Just f -> Just $ \fo dt -> f fo (localDay dt)-            Nothing ->-                case formatCharacter alt c of-                    Just f -> Just $ \fo dt -> f fo (localTimeOfDay dt)-                    Nothing -> Nothing+        mapFormatCharacter localDay (formatCharacter alt c) <|>+        mapFormatCharacter localTimeOfDay (formatCharacter alt c)  todAMPM :: TimeLocale -> TimeOfDay -> String todAMPM locale day = let@@ -78,12 +82,8 @@     formatCharacter _ 's' =         Just $ formatNumber True 1 '0' $ (floor . utcTimeToPOSIXSeconds . zonedTimeToUTC :: ZonedTime -> Integer)     formatCharacter alt c =-        case formatCharacter alt c of-            Just f -> Just $ \fo dt -> f fo (zonedTimeToLocalTime dt)-            Nothing ->-                case formatCharacter alt c of-                    Just f -> Just $ \fo dt -> f fo (zonedTimeZone dt)-                    Nothing -> Nothing+        mapFormatCharacter zonedTimeToLocalTime (formatCharacter alt c) <|>+        mapFormatCharacter zonedTimeZone (formatCharacter alt c)  instance FormatTime TimeZone where     formatCharacter False 'z' = Just $ formatGeneral False True 4 '0' $ \_ -> timeZoneOffsetString'' False@@ -107,34 +107,38 @@     formatCharacter _ 'A' = Just $ formatString $ \locale wd -> fst $ (wDays locale) !! (mod (fromEnum wd) 7)     formatCharacter _ _ = Nothing -instance FormatTime Day where-    -- Aggregate-    formatCharacter _ 'D' = Just $ formatString $ \locale -> formatTime locale "%m/%d/%y"-    formatCharacter _ 'F' = Just $ formatString $ \locale -> formatTime locale "%Y-%m-%d"-    formatCharacter _ 'x' = Just $ formatString $ \locale -> formatTime locale (dateFmt locale)+instance FormatTime Month where     -- Year Count-    formatCharacter _ 'Y' = Just $ formatNumber False 4 '0' $ fst . toOrdinalDate-    formatCharacter _ 'y' = Just $ formatNumber True 2 '0' $ mod100 . fst . toOrdinalDate-    formatCharacter _ 'C' = Just $ formatNumber False 2 '0' $ div100 . fst . toOrdinalDate+    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     -- Month of Year     formatCharacter _ 'B' =-        Just $ formatString $ \locale -> fst . (\(_, m, _) -> (months locale) !! (m - 1)) . toGregorian+        Just $ formatString $ \locale (YearMonth _ my) -> fst $ (months locale) !! (my - 1)     formatCharacter _ 'b' =-        Just $ formatString $ \locale -> snd . (\(_, m, _) -> (months locale) !! (m - 1)) . toGregorian+        Just $ formatString $ \locale (YearMonth _ my) -> snd $ (months locale) !! (my - 1)     formatCharacter _ 'h' =-        Just $ formatString $ \locale -> snd . (\(_, m, _) -> (months locale) !! (m - 1)) . toGregorian-    formatCharacter _ 'm' = Just $ formatNumber True 2 '0' $ (\(_, m, _) -> m) . toGregorian+        Just $ formatString $ \locale (YearMonth _ my) -> snd $ (months locale) !! (my - 1)+    formatCharacter _ 'm' = Just $ formatNumber True 2 '0' $ \(YearMonth _ m) -> m+    -- Default+    formatCharacter _ _ = Nothing++instance FormatTime Day where+    -- Aggregate+    formatCharacter _ 'D' = Just $ formatString $ \locale -> formatTime locale "%m/%d/%y"+    formatCharacter _ 'F' = Just $ formatString $ \locale -> formatTime locale "%Y-%m-%d"+    formatCharacter _ 'x' = Just $ formatString $ \locale -> formatTime locale (dateFmt locale)     -- Day of Month-    formatCharacter _ 'd' = Just $ formatNumber True 2 '0' $ (\(_, _, d) -> d) . toGregorian-    formatCharacter _ 'e' = Just $ formatNumber True 2 ' ' $ (\(_, _, d) -> d) . toGregorian+    formatCharacter _ 'd' = Just $ formatNumber True 2 '0' $ \(YearMonthDay _ _ dm) -> dm+    formatCharacter _ 'e' = Just $ formatNumber True 2 ' ' $ \(YearMonthDay _ _ dm) -> dm     -- Day of Year-    formatCharacter _ 'j' = Just $ formatNumber True 3 '0' $ snd . toOrdinalDate+    formatCharacter _ 'j' = Just $ formatNumber True 3 '0' $ \(YearDay _ dy) -> dy     -- ISO 8601 Week Date-    formatCharacter _ 'G' = Just $ formatNumber False 4 '0' $ (\(y, _, _) -> y) . toWeekDate-    formatCharacter _ 'g' = Just $ formatNumber True 2 '0' $ mod100 . (\(y, _, _) -> y) . toWeekDate-    formatCharacter _ 'f' = Just $ formatNumber False 2 '0' $ div100 . (\(y, _, _) -> y) . toWeekDate-    formatCharacter _ 'V' = Just $ formatNumber True 2 '0' $ (\(_, w, _) -> w) . toWeekDate-    formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ (\(_, _, d) -> d) . toWeekDate+    formatCharacter _ 'G' = Just $ formatNumber False 4 '0' $ \(YearWeekDay y _ _) -> y+    formatCharacter _ 'g' = Just $ formatNumber True 2 '0' $ \(YearWeekDay y _ _) -> mod100 y+    formatCharacter _ 'f' = Just $ formatNumber False 2 '0' $ \(YearWeekDay y _ _) -> div100 y+    formatCharacter _ 'V' = Just $ formatNumber True 2 '0' $ \(YearWeekDay _ wy _) -> wy+    formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ \(YearWeekDay _ _ dw) -> fromEnum dw     -- Day of week     formatCharacter _ 'a' = Just $ formatString $ \locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek     formatCharacter _ 'A' = Just $ formatString $ \locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek@@ -142,13 +146,13 @@     formatCharacter _ 'w' = Just $ formatNumber True 1 '0' $ snd . sundayStartWeek     formatCharacter _ 'W' = Just $ formatNumber True 2 '0' $ fst . mondayStartWeek     -- Default-    formatCharacter _ _ = Nothing+    formatCharacter alt c = mapFormatCharacter (\(MonthDay m _) -> m) $ formatCharacter alt c  instance FormatTime UTCTime where-    formatCharacter alt c = fmap (\f fo t -> f fo (utcToZonedTime utc t)) (formatCharacter alt c)+    formatCharacter alt c = mapFormatCharacter (utcToZonedTime utc) $ formatCharacter alt c  instance FormatTime UniversalTime where-    formatCharacter alt c = fmap (\f fo t -> f fo (ut1ToLocalTime 0 t)) (formatCharacter alt c)+    formatCharacter alt c = mapFormatCharacter (ut1ToLocalTime 0) $ formatCharacter alt c  instance FormatTime NominalDiffTime where     formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy $ 7 * 86400@@ -207,4 +211,4 @@     formatCharacter _ 'y' = Just $ formatNumberStd 1 $ quotBy 12 . ctMonths     formatCharacter _ 'b' = Just $ formatNumberStd 1 $ ctMonths     formatCharacter _ 'B' = Just $ formatNumberStd 2 $ remBy 12 . ctMonths-    formatCharacter alt c = fmap (\f fo t -> f fo (ctTime t)) (formatCharacter alt c)+    formatCharacter alt c = mapFormatCharacter ctTime $ formatCharacter alt c
lib/Data/Time/Format/Locale.hs view
@@ -23,7 +23,7 @@  -- | Locale representing American usage. ----- 'knownTimeZones' contains only the ten time-zones mentioned in RFC 822 sec. 5:+-- 'knownTimeZones' contains only the ten time-zones mentioned in RFC 802 sec. 5: -- \"UT\", \"GMT\", \"EST\", \"EDT\", \"CST\", \"CDT\", \"MST\", \"MDT\", \"PST\", \"PDT\". -- Note that the parsing functions will regardless parse \"UTC\", single-letter military time-zones, and +HHMM format. defaultTimeLocale :: TimeLocale
lib/Data/Time/Format/Parse.hs view
@@ -4,6 +4,7 @@     (     -- * UNIX-style parsing       parseTimeM+    , parseTimeMultipleM     , parseTimeOrError     , readSTime     , readPTime@@ -12,9 +13,11 @@     , module Data.Time.Format.Locale     ) where +import Control.Applicative ((<|>)) import Control.Monad.Fail import Data.Char import Data.Proxy+import Data.Traversable import Data.Time.Calendar.Days import Data.Time.Clock.Internal.UTCTime import Data.Time.Clock.Internal.UniversalTime@@ -29,6 +32,7 @@ import Text.ParserCombinators.ReadP hiding (char, string)  -- | Parses a time value given a format string.+-- Missing information will be derived from 1970-01-01 00:00 UTC (which was a Thursday). -- Supports the same %-codes as 'formatTime', including @%-@, @%_@ and @%0@ modifiers, however padding widths are not supported. -- Case is not significant in the input string. -- Some variations in the input are accepted:@@ -58,14 +62,34 @@     -> TimeLocale -- ^ Time locale.     -> String -- ^ Format string.     -> String -- ^ Input string.-    -> m t -- ^ Return the time value, or fail if the input could-                        -- not be parsed using the given format.-parseTimeM acceptWS l fmt s =-    case parseTimeList acceptWS l fmt s of-        [t] -> return t-        [] -> fail $ "parseTimeM: no parse of " ++ show s-        _ -> fail $ "parseTimeM: multiple parses of " ++ show s+    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.+parseTimeM acceptWS l fmt s = parseTimeMultipleM acceptWS l [(fmt, s)] +-- | Parses a time value given a list of pairs of format and input.+-- Resulting value is constructed from all provided specifiers.+parseTimeMultipleM' ::+       (MonadFail m, ParseTime t)+    => Proxy t+    -> Bool -- ^ Accept leading and trailing whitespace?+    -> TimeLocale -- ^ Time locale.+    -> [(String, String)] -- ^ Pairs of (format string, input string).+    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.+parseTimeMultipleM' pt acceptWS l fmts = do+    specss <- for fmts $ \(fmt,s) -> parseTimeSpecifiersM pt acceptWS l fmt s+    case buildTime l $ mconcat specss of+        Just t -> return t+        Nothing -> fail "parseTimeM: cannot construct"++-- | Parses a time value given a list of pairs of format and input.+-- Resulting value is constructed from all provided specifiers.+parseTimeMultipleM ::+       (MonadFail m, ParseTime t)+    => Bool -- ^ Accept leading and trailing whitespace?+    -> TimeLocale -- ^ Time locale.+    -> [(String, String)] -- ^ Pairs of (format string, input string).+    -> m t -- ^ Return the time value, or fail if the input could not be parsed using the given format.+parseTimeMultipleM = parseTimeMultipleM' Proxy+ -- | Parse a time value given a format string. Fails if the input could -- not be parsed using the given format. See 'parseTimeM' for details. parseTimeOrError ::@@ -76,20 +100,35 @@     -> String -- ^ Input string.     -> t -- ^ The time value. parseTimeOrError acceptWS l fmt s =-    case parseTimeList acceptWS l fmt s of+    case parseTimeM acceptWS l fmt s of         [t] -> t         [] -> error $ "parseTimeOrError: no parse of " ++ show s         _ -> error $ "parseTimeOrError: multiple parses of " ++ show s -parseTimeList ::+parseTimeSpecifiersM ::+       (MonadFail m, ParseTime t)+    => Proxy t+    -> Bool -- ^ Accept leading and trailing whitespace?+    -> TimeLocale -- ^ Time locale.+    -> String -- ^ Format string+    -> String -- ^ Input string.+    -> m [(Char, String)]+parseTimeSpecifiersM pt acceptWS l fmt s =+    case parseTimeSpecifiers pt acceptWS l fmt s of+        [t] -> return t+        [] -> fail $ "parseTimeM: no parse of " ++ show s+        _ -> fail $ "parseTimeM: multiple parses of " ++ show s++parseTimeSpecifiers ::        ParseTime t-    => Bool -- ^ Accept leading and trailing whitespace?+    => Proxy t+    -> Bool -- ^ Accept leading and trailing whitespace?     -> TimeLocale -- ^ Time locale.     -> String -- ^ Format string     -> String -- ^ Input string.-    -> [t]-parseTimeList False l fmt s = [t | (t, "") <- readSTime False l fmt s]-parseTimeList True l fmt s = [t | (t, r) <- readSTime True l fmt s, all isSpace r]+    -> [[(Char, String)]]+parseTimeSpecifiers pt False l fmt s = [t | (t, "") <- readP_to_S (readPSpecifiers pt False l fmt) s]+parseTimeSpecifiers pt True l fmt s = [t | (t, r) <- readP_to_S (readPSpecifiers pt True l fmt) s, all isSpace r]  -- | Parse a time value given a format string.  See 'parseTimeM' for details. readSTime ::@@ -98,32 +137,40 @@     -> TimeLocale -- ^ Time locale.     -> String -- ^ Format string     -> ReadS t-readSTime acceptWS l f = readP_to_S (readPTime acceptWS l f)+readSTime acceptWS l f = readP_to_S $ readPTime acceptWS l f +readPSpecifiers ::+       ParseTime t+    => Proxy t+    -> Bool -- ^ Accept leading whitespace?+    -> TimeLocale -- ^ Time locale.+    -> String -- ^ Format string+    -> ReadP [(Char, String)]+readPSpecifiers pt False l f = parseSpecifiers pt l f+readPSpecifiers pt True l f = (skipSpaces >> parseSpecifiers pt l f) <++ parseSpecifiers pt l f+ -- | Parse a time value given a format string.  See 'parseTimeM' for details.-readPTime ::+readPTime' ::        ParseTime t-    => Bool -- ^ Accept leading whitespace?+    => Proxy t+    -> Bool -- ^ Accept leading whitespace?     -> TimeLocale -- ^ Time locale.     -> String -- ^ Format string     -> ReadP t-readPTime False l f = readPOnlyTime l f-readPTime True l f = (skipSpaces >> readPOnlyTime l f) <++ readPOnlyTime l f--readPOnlyTime' :: ParseTime t => Proxy t -> TimeLocale -> String -> ReadP t-readPOnlyTime' pt l f = do-    pairs <- parseSpecifiers pt l f+readPTime' pt ws l f = do+    pairs <- readPSpecifiers pt ws l f     case buildTime l pairs of         Just t -> return t         Nothing -> pfail --- | Parse a time value given a format string (without allowing leading whitespace).  See 'parseTimeM' for details.-readPOnlyTime ::+-- | Parse a time value given a format string.  See 'parseTimeM' for details.+readPTime ::        ParseTime t-    => TimeLocale -- ^ Time locale.+    => Bool -- ^ Accept leading whitespace?+    -> TimeLocale -- ^ Time locale.     -> String -- ^ Format string     -> ReadP t-readPOnlyTime = readPOnlyTime' Proxy+readPTime = readPTime' Proxy  -- * Read instances for time package types instance Read Day where@@ -148,7 +195,10 @@     readsPrec n = readParen False $ \s -> [(ZonedTime t z, r2) | (t, r1) <- readsPrec n s, (z, r2) <- readsPrec n r1]  instance Read UTCTime where-    readsPrec n s = [(zonedTimeToUTC t, r) | (t, r) <- readsPrec n s]+    readsPrec n s = do+        (lt, s') <- readsPrec n s+        (tz, s'') <- readsPrec n s' <|> pure (utc, s')+        return (localTimeToUTC tz lt, s'')  instance Read UniversalTime where     readsPrec n s = [(localTimeToUT1 0 t, r) | (t, r) <- readsPrec n s]
lib/Data/Time/Format/Parse/Instances.hs view
@@ -11,12 +11,14 @@ #endif import Data.Char import Data.Fixed-import Data.List+import Data.List (elemIndex,find) import Data.Ratio+import Data.Time.Calendar.Types import Data.Time.Calendar.CalendarDiffDays import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.OrdinalDate+import Data.Time.Calendar.Month import Data.Time.Calendar.Private (clipValid) import Data.Time.Calendar.WeekDate import Data.Time.Clock.Internal.DiffTime@@ -35,167 +37,194 @@ import Text.Read (readMaybe)  data DayComponent-    = Century Integer -- century of all years-    | CenturyYear Integer -- 0-99, last two digits of both real years and week years-    | YearMonth Int -- 1-12-    | MonthDay Int -- 1-31-    | YearDay Int -- 1-366-    | WeekDay Int -- 1-7 (mon-sun)-    | YearWeek WeekType-               Int -- 1-53 or 0-53+    = 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 +makeDayComponent :: TimeLocale -> Char -> String -> Maybe [DayComponent]+makeDayComponent l c x = let+    ra :: (Read a) => Maybe a+    ra = readMaybe x+    zeroBasedListIndex :: [String] -> Maybe Int+    zeroBasedListIndex ss = elemIndex (map toUpper x) $ fmap (map toUpper) ss+    oneBasedListIndex :: [String] -> Maybe Int+    oneBasedListIndex ss = do+        index <- zeroBasedListIndex ss+        return $ 1 + index+    in case c of+    -- %C: century (all but the last two digits of the year), 00 - 99+            'C' -> do+                a <- ra+                return [DCCentury a]+    -- %f century (all but the last two digits of the year), 00 - 99+            'f' -> do+                a <- ra+                return [DCCentury a]+    -- %Y: year+            'Y' -> do+                a <- ra+                return [DCCentury (a `div` 100), DCCenturyYear (a `mod` 100)]+    -- %G: year for Week Date format+            'G' -> do+                a <- ra+                return [DCCentury (a `div` 100), DCCenturyYear (a `mod` 100)]+    -- %y: last two digits of year, 00 - 99+            'y' -> do+                a <- ra+                return [DCCenturyYear a]+    -- %g: last two digits of year for Week Date format, 00 - 99+            'g' -> do+                a <- ra+                return [DCCenturyYear a]+    -- %B: month name, long form (fst from months locale), January - December+            'B' -> do+                a <- oneBasedListIndex $ fmap fst $ months l+                return [DCYearMonth a]+    -- %b: month name, short form (snd from months locale), Jan - Dec+            'b' -> do+                a <- oneBasedListIndex $ fmap snd $ months l+                return [DCYearMonth a]+    -- %m: month of year, leading 0 as needed, 01 - 12+            'm' -> do+                raw <- ra+                a <- clipValid 1 12 raw+                return [DCYearMonth a]+    -- %d: day of month, leading 0 as needed, 01 - 31+            'd' -> do+                raw <- ra+                a <- clipValid 1 31 raw+                return [DCMonthDay a]+    -- %e: day of month, leading space as needed, 1 - 31+            'e' -> do+                raw <- ra+                a <- clipValid 1 31 raw+                return [DCMonthDay a]+    -- %V: week for Week Date format, 01 - 53+            'V' -> do+                raw <- ra+                a <- clipValid 1 53 raw+                return [DCYearWeek 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]+    -- %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]+    -- %u: day for Week Date format, 1 - 7+            'u' -> do+                raw <- ra+                a <- clipValid 1 7 raw+                return [DCWeekDay 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: 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]+    -- %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]+    -- %j: day of year for Ordinal Date format, 001 - 366+            'j' -> do+                raw <- ra+                a <- clipValid 1 366 raw+                return [DCYearDay 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++safeLast :: a -> [a] -> a+safeLast x xs = last (x : xs)+ instance ParseTime Day where     substituteTimeSpecifier _ = timeSubstituteTimeSpecifier     parseTimeSpecifier _ = timeParseTimeSpecifier-    buildTime l = let+    buildTime l pairs = do+        cs <- makeDayComponents l pairs         -- 'Nothing' indicates a parse failure,         -- while 'Just []' means no information-        f :: Char -> String -> Maybe [DayComponent]-        f c x = let-            ra :: (Read a) => Maybe a-            ra = readMaybe x-            zeroBasedListIndex :: [String] -> Maybe Int-            zeroBasedListIndex ss = elemIndex (map toUpper x) $ fmap (map toUpper) ss-            oneBasedListIndex :: [String] -> Maybe Int-            oneBasedListIndex ss = do-                index <- zeroBasedListIndex ss-                return $ 1 + index-            in case c of-            -- %C: century (all but the last two digits of the year), 00 - 99-                   'C' -> do-                       a <- ra-                       return [Century a]-            -- %f century (all but the last two digits of the year), 00 - 99-                   'f' -> do-                       a <- ra-                       return [Century a]-            -- %Y: year-                   'Y' -> do-                       a <- ra-                       return [Century (a `div` 100), CenturyYear (a `mod` 100)]-            -- %G: year for Week Date format-                   'G' -> do-                       a <- ra-                       return [Century (a `div` 100), CenturyYear (a `mod` 100)]-            -- %y: last two digits of year, 00 - 99-                   'y' -> do-                       a <- ra-                       return [CenturyYear a]-            -- %g: last two digits of year for Week Date format, 00 - 99-                   'g' -> do-                       a <- ra-                       return [CenturyYear a]-            -- %B: month name, long form (fst from months locale), January - December-                   'B' -> do-                       a <- oneBasedListIndex $ fmap fst $ months l-                       return [YearMonth a]-            -- %b: month name, short form (snd from months locale), Jan - Dec-                   'b' -> do-                       a <- oneBasedListIndex $ fmap snd $ months l-                       return [YearMonth a]-            -- %m: month of year, leading 0 as needed, 01 - 12-                   'm' -> do-                       raw <- ra-                       a <- clipValid 1 12 raw-                       return [YearMonth a]-            -- %d: day of month, leading 0 as needed, 01 - 31-                   'd' -> do-                       raw <- ra-                       a <- clipValid 1 31 raw-                       return [MonthDay a]-            -- %e: day of month, leading space as needed, 1 - 31-                   'e' -> do-                       raw <- ra-                       a <- clipValid 1 31 raw-                       return [MonthDay a]-            -- %V: week for Week Date format, 01 - 53-                   'V' -> do-                       raw <- ra-                       a <- clipValid 1 53 raw-                       return [YearWeek 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 [YearWeek 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 [YearWeek MondayWeek a]-            -- %u: day for Week Date format, 1 - 7-                   'u' -> do-                       raw <- ra-                       a <- clipValid 1 7 raw-                       return [WeekDay 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 [WeekDay 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 [WeekDay 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 [WeekDay a]-            -- %j: day of year for Ordinal Date format, 001 - 366-                   'j' -> do-                       raw <- ra-                       a <- clipValid 1 366 raw-                       return [YearDay a]-            -- unrecognised, pass on to other parsers-                   _ -> return []-        buildDay :: [DayComponent] -> Maybe Day-        buildDay cs = let-            safeLast x xs = last (x : xs)+        let             y = let-                d = safeLast 70 [x | CenturyYear x <- cs]+                d = safeLast 70 [x | DCCenturyYear x <- cs]                 c =                     safeLast                         (if d >= 69                              then 19                              else 20)-                        [x | Century x <- cs]+                        [x | DCCentury x <- cs]                 in 100 * c + d-            rest (YearMonth m:_) = let-                d = safeLast 1 [x | MonthDay x <- cs]+            rest (DCYearMonth m:_) = let+                d = safeLast 1 [x | DCMonthDay x <- cs]                 in fromGregorianValid y m d-            rest (YearDay d:_) = fromOrdinalDateValid y d-            rest (YearWeek wt w:_) = let-                d = safeLast 4 [x | WeekDay x <- cs]+            rest (DCYearDay d:_) = fromOrdinalDateValid y d+            rest (DCYearWeek wt w:_) = let+                d = safeLast 4 [x | DCWeekDay x <- cs]                 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 [YearMonth 1]-            in rest cs-        in \pairs -> do-               components <- for pairs $ \(c, x) -> f c x-               buildDay $ concat components+            rest [] = rest [DCYearMonth 1]+        rest cs++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 = let+                d = safeLast 70 [x | DCCenturyYear x <- cs]+                c =+                    safeLast+                        (if d >= 69+                             then 19+                             else 20)+                        [x | DCCentury x <- cs]+                in 100 * c + d+            rest (DCYearMonth m:_) = fromYearMonthValid y m+            rest (_:xs) = rest xs+            rest [] = fromYearMonthValid y 1+        rest cs  mfoldl :: (Monad m) => (a -> b -> m a) -> m a -> [b] -> m a mfoldl f = let
lib/Data/Time/LocalTime/Internal/TimeOfDay.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fno-warn-unused-imports #-}- module Data.Time.LocalTime.Internal.TimeOfDay     (     -- * Time of day@@ -26,7 +24,6 @@ import Data.Time.Clock.Internal.DiffTime import Data.Time.Clock.Internal.NominalDiffTime import Data.Time.LocalTime.Internal.TimeZone-import Data.Typeable  -- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. data TimeOfDay = TimeOfDay
lib/Data/Time/LocalTime/Internal/TimeZone.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface #-}  module Data.Time.LocalTime.Internal.TimeZone@@ -22,7 +21,6 @@ import Data.Time.Clock.Internal.UTCTime import Data.Time.Clock.POSIX import Data.Time.Clock.System-import Data.Typeable import Foreign import Foreign.C
test/main/Main.hs view
@@ -2,6 +2,7 @@  import Test.Types() import Test.Calendar.AddDays+import Test.Calendar.CalendarProps import Test.Calendar.Calendars import Test.Calendar.ClipDates import Test.Calendar.ConvertBack@@ -30,6 +31,7 @@         [ testGroup               "Calendar"               [ addDaysTest+              , testCalendarProps               , testCalendars               , clipDates               , convertBack
test/main/Test/Arbitrary.hs view
@@ -6,11 +6,30 @@ import Data.Fixed import Data.Ratio import Data.Time+import Data.Time.Calendar.WeekDate+import Data.Time.Calendar.Month+import Data.Time.Calendar.Quarter import Data.Time.Clock.POSIX import Test.Tasty.QuickCheck hiding (reason)  instance Arbitrary DayOfWeek where     arbitrary = fmap toEnum $ choose (1, 7)++instance Arbitrary FirstWeekType where+    arbitrary = do+        b <- arbitrary+        return $ if b then FirstWholeWeek else FirstMostWeek++deriving instance Show FirstWeekType++instance Arbitrary Month where+    arbitrary = liftM MkMonth $ choose (-30000, 200000)++instance Arbitrary Quarter where+    arbitrary = liftM MkQuarter $ choose (-30000, 200000)++instance Arbitrary QuarterOfYear where+    arbitrary = liftM toEnum $ choose (1, 4)  instance Arbitrary Day where     arbitrary = liftM ModifiedJulianDay $ choose (-313698, 2973483) -- 1000-01-1 to 9999-12-31
+ test/main/Test/Calendar/CalendarProps.hs view
@@ -0,0 +1,27 @@+#if __GLASGOW_HASKELL__ < 802+{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-incomplete-uni-patterns #-}+#endif+module Test.Calendar.CalendarProps+    ( testCalendarProps+    ) where++import Data.Time.Calendar.Month+import Data.Time.Calendar.Quarter+import Test.TestUtil+import Test.Tasty+import Test.Arbitrary ()++testYearMonth :: TestTree+testYearMonth = nameTest "YearMonth" $ \m -> case m of+    YearMonth y my -> m == YearMonth y my++testMonthDay :: TestTree+testMonthDay = nameTest "MonthDay" $ \d -> case d of+    MonthDay m dm -> d == MonthDay m dm++testYearQuarter :: TestTree+testYearQuarter = nameTest "YearQuarter" $ \q -> case q of+    YearQuarter y qy -> q == YearQuarter y qy++testCalendarProps :: TestTree+testCalendarProps = nameTest "calender-props" [testYearMonth,testMonthDay,testYearQuarter]
test/main/Test/Calendar/ClipDates.hs view
@@ -27,17 +27,17 @@     ts = tupleUp2 l2 l3     in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1 +testPairs :: String -> [String] -> [String] -> TestTree+testPairs name expected found = testGroup name $ fmap (\(e,f) -> testCase e $ assertEqual "" e f) $ zip expected found+ -- clipDates :: TestTree clipDates =-    testCase "clipDates" $ let-        yad = unlines $ map yearAndDay $ tupleUp2 [1968, 1969, 1971] [-4, 0, 1, 200, 364, 365, 366, 367, 700]-        greg =-            unlines $-            map gregorian $-            tupleUp3 [1968, 1969, 1971] [-20, -1, 0, 1, 2, 12, 13, 17] [-7, -1, 0, 1, 2, 27, 28, 29, 30, 31, 32, 40]-        iso =-            unlines $-            map iSOWeekDay $-            tupleUp3 [1968, 1969, 2004] [-20, -1, 0, 1, 20, 51, 52, 53, 54] [-2, -1, 0, 1, 4, 6, 7, 8, 9]-        in assertEqual "" clipDatesRef $ concat ["YearAndDay\n", yad, "Gregorian\n", greg, "ISOWeekDay\n", iso]+    testGroup "clipDates"+        [+            testPairs "YearAndDay" clipDatesYearAndDayRef $ map yearAndDay $ tupleUp2 [1968, 1969, 1971] [-4, 0, 1, 200, 364, 365, 366, 367, 700],+            testPairs "Gregorian" clipDatesGregorianDayRef $ map gregorian $+                tupleUp3 [1968, 1969, 1971] [-20, -1, 0, 1, 2, 12, 13, 17] [-7, -1, 0, 1, 2, 27, 28, 29, 30, 31, 32, 40],+            testPairs "ISOWeekDay" clipDatesISOWeekDayRef $ map iSOWeekDay $+                tupleUp3 [1968, 1969, 2004] [-20, -1, 0, 1, 20, 51, 52, 53, 54] [-2, -1, 0, 1, 4, 6, 7, 8, 9]+        ]
test/main/Test/Calendar/ClipDatesRef.hs view
@@ -1,10 +1,8 @@ module Test.Calendar.ClipDatesRef where -clipDatesRef :: String-clipDatesRef =-    unlines-        [ "YearAndDay"-        , "1968--4 = 1968-001"+clipDatesYearAndDayRef :: [String]+clipDatesYearAndDayRef =+        [ "1968--4 = 1968-001"         , "1968-0 = 1968-001"         , "1968-1 = 1968-001"         , "1968-200 = 1968-200"@@ -31,8 +29,11 @@         , "1971-366 = 1971-365"         , "1971-367 = 1971-365"         , "1971-700 = 1971-365"-        , "Gregorian"-        , "1968--20--7 = 1968-01-01"+        ]++clipDatesGregorianDayRef :: [String]+clipDatesGregorianDayRef =+        [ "1968--20--7 = 1968-01-01"         , "1968--20--1 = 1968-01-01"         , "1968--20-0 = 1968-01-01"         , "1968--20-1 = 1968-01-01"@@ -320,8 +321,11 @@         , "1971-17-31 = 1971-12-31"         , "1971-17-32 = 1971-12-31"         , "1971-17-40 = 1971-12-31"-        , "ISOWeekDay"-        , "1968-W-20--2 = 1968-W01-1"+        ]++clipDatesISOWeekDayRef :: [String]+clipDatesISOWeekDayRef =+        [ "1968-W-20--2 = 1968-W01-1"         , "1968-W-20--1 = 1968-W01-1"         , "1968-W-20-0 = 1968-W01-1"         , "1968-W-20-1 = 1968-W01-1"
test/main/Test/Calendar/Valid.hs view
@@ -63,56 +63,56 @@     (w, d) = mondayStartWeek day     in (y, w, d) -newtype Year =-    MkYear Integer+newtype WYear =+    MkWYear Year     deriving (Eq, Show) -instance Arbitrary Year where-    arbitrary = fmap MkYear $ choose (-1000, 3000)+instance Arbitrary WYear where+    arbitrary = fmap MkWYear $ choose (-1000, 3000) -newtype YearMonth =-    MkYearMonth Int+newtype WMonthOfYear =+    MkWMonthOfYear MonthOfYear     deriving (Eq, Show) -instance Arbitrary YearMonth where-    arbitrary = fmap MkYearMonth $ choose (-5, 17)+instance Arbitrary WMonthOfYear where+    arbitrary = fmap MkWMonthOfYear $ choose (-5, 17) -newtype MonthDay =-    MkMonthDay Int+newtype WDayOfMonth =+    MkWDayOfMonth DayOfMonth     deriving (Eq, Show) -instance Arbitrary MonthDay where-    arbitrary = fmap MkMonthDay $ choose (-5, 35)+instance Arbitrary WDayOfMonth where+    arbitrary = fmap MkWDayOfMonth $ choose (-5, 35) -newtype YearDay =-    MkYearDay Int+newtype WDayOfYear =+    MkWDayOfYear DayOfYear     deriving (Eq, Show) -instance Arbitrary YearDay where-    arbitrary = fmap MkYearDay $ choose (-20, 400)+instance Arbitrary WDayOfYear where+    arbitrary = fmap MkWDayOfYear $ choose (-20, 400) -newtype YearWeek =-    MkYearWeek Int+newtype WWeekOfYear =+    MkWWeekOfYear WeekOfYear     deriving (Eq, Show) -instance Arbitrary YearWeek where-    arbitrary = fmap MkYearWeek $ choose (-5, 60)+instance Arbitrary WWeekOfYear where+    arbitrary = fmap MkWWeekOfYear $ choose (-5, 60) -newtype WeekDay =-    MkWeekDay Int+newtype WDayOfWeek =+    MkWDayOfWeek Int     deriving (Eq, Show) -instance Arbitrary WeekDay where-    arbitrary = fmap MkWeekDay $ choose (-5, 15)+instance Arbitrary WDayOfWeek where+    arbitrary = fmap MkWDayOfWeek $ choose (-5, 15) -fromYMD :: (Year, YearMonth, MonthDay) -> (Integer, Int, Int)-fromYMD (MkYear y, MkYearMonth ym, MkMonthDay md) = (y, ym, md)+fromYMD :: (WYear, WMonthOfYear, WDayOfMonth) -> (Year, MonthOfYear, DayOfMonth)+fromYMD (MkWYear y, MkWMonthOfYear ym, MkWDayOfMonth md) = (y, ym, md) -fromYD :: (Year, YearDay) -> (Integer, Int)-fromYD (MkYear y, MkYearDay yd) = (y, yd)+fromYD :: (WYear, WDayOfYear) -> (Year, DayOfYear)+fromYD (MkWYear y, MkWDayOfYear yd) = (y, yd) -fromYWD :: (Year, YearWeek, WeekDay) -> (Integer, Int, Int)-fromYWD (MkYear y, MkYearWeek yw, MkWeekDay wd) = (y, yw, wd)+fromYWD :: (WYear, WWeekOfYear, WDayOfWeek) -> (Year, WeekOfYear, Int)+fromYWD (MkWYear y, MkWWeekOfYear yw, MkWDayOfWeek wd) = (y, yw, wd)  testValid :: TestTree testValid =
test/main/Test/Calendar/Week.hs view
@@ -3,13 +3,16 @@     ) where  import Data.Time.Calendar+import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate+import Test.TestUtil import Test.Tasty import Test.Tasty.HUnit+import Test.Arbitrary ()  testDay :: TestTree testDay =-    testCase "day" $ do+    nameTest "day" $ do         let day = fromGregorian 2018 1 9         assertEqual "" (ModifiedJulianDay 58127) day         assertEqual "" (2018, 2, 2) $ toWeekDate day@@ -19,7 +22,7 @@ allDaysOfWeek = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]  testAllDays :: String -> (DayOfWeek -> IO ()) -> TestTree-testAllDays name f = testGroup name $ fmap (\wd -> testCase (show wd) $ f wd) allDaysOfWeek+testAllDays name f = nameTest name $ fmap (\wd -> nameTest (show wd) $ f wd) allDaysOfWeek  testSucc :: TestTree testSucc = testAllDays "succ" $ \wd -> assertEqual "" (toEnum $ succ $ fromEnum wd) $ succ wd@@ -29,15 +32,15 @@  testSequences :: TestTree testSequences =-    testGroup+    nameTest         "sequence"-        [ testCase "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday]-        , testCase "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday]-        , testCase "[Sunday .. Saturday]" $+        [ nameTest "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday]+        , nameTest "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday]+        , nameTest "[Sunday .. Saturday]" $           assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday]-        , testCase "[Thursday .. Wednesday]" $+        , nameTest "[Thursday .. Wednesday]" $           assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday]-        , testCase "[Tuesday ..]" $+        , nameTest "[Tuesday ..]" $           assertEqual               ""               [ Tuesday@@ -57,7 +60,7 @@               , Tuesday               ] $           take 15 [Tuesday ..]-        , testCase "[Wednesday, Tuesday ..]" $+        , nameTest "[Wednesday, Tuesday ..]" $           assertEqual               ""               [ Wednesday@@ -77,17 +80,59 @@               , Wednesday               ] $           take 15 [Wednesday,Tuesday ..]-        , testCase "[Sunday, Friday ..]" $+        , nameTest "[Sunday, Friday ..]" $           assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $           take 8 [Sunday,Friday ..]-        , testCase "[Monday,Sunday .. Tuesday]" $+        , nameTest "[Monday,Sunday .. Tuesday]" $           assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday,Sunday .. Tuesday]-        , testCase "[Thursday, Saturday .. Tuesday]" $+        , nameTest "[Thursday, Saturday .. Tuesday]" $           assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday,Saturday .. Tuesday]         ]  testReadShow :: TestTree testReadShow = testAllDays "read show" $ \wd -> assertEqual "" wd $ read $ show wd +prop_firstDayOfWeekOnAfter_onAfter :: DayOfWeek -> Day -> Bool+prop_firstDayOfWeekOnAfter_onAfter dw d = firstDayOfWeekOnAfter dw d >= d++prop_firstDayOfWeekOnAfter_Day :: DayOfWeek -> Day -> Bool+prop_firstDayOfWeekOnAfter_Day dw d = dayOfWeek (firstDayOfWeekOnAfter dw d) == dw++prop_toFromWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> Bool+prop_toFromWeekCalendar wt ws d = let+    (y,wy,dw) = toWeekCalendar wt ws d+    in fromWeekCalendar wt ws y wy dw == d++prop_weekChanges :: FirstWeekType -> DayOfWeek -> Day -> Bool+prop_weekChanges wt ws d = let+    (_,wy0,_) = toWeekCalendar wt ws d+    (_,wy1,dw) = toWeekCalendar wt ws $ succ d+    in if dw == ws then wy0 /= wy1 else wy0 == wy1++prop_weekYearWholeStart :: DayOfWeek -> Year -> Bool+prop_weekYearWholeStart ws y = let+    d = fromWeekCalendar FirstWholeWeek ws y 1 ws+    (y',dy) = toOrdinalDate d+    in y == y' && dy >= 1 && dy <= 7++prop_weekYearMostStart :: DayOfWeek -> Year -> Bool+prop_weekYearMostStart ws y = let+    d = fromWeekCalendar FirstMostWeek ws y 2 ws+    (y',dy) = toOrdinalDate d+    in y == y' && dy >= 5 && dy <= 11++testDiff :: TestTree+testDiff = nameTest "diff"+    [+        nameTest "Friday - Tuesday" $ assertEqual "" 3 $ dayOfWeekDiff Friday Tuesday,+        nameTest "Tuesday - Friday" $ assertEqual "" 4 $ dayOfWeekDiff Tuesday Friday,+        nameTest "firstDayOfWeekOnAfter_onAfter" prop_firstDayOfWeekOnAfter_onAfter,+        nameTest "firstDayOfWeekOnAfter_Day" prop_firstDayOfWeekOnAfter_Day,+        nameTest "toFromWeekCalendar" prop_toFromWeekCalendar,+        nameTest "weekChanges" prop_weekChanges,+        nameTest "weekYearWholeStart" prop_weekYearWholeStart,+        nameTest "weekYearMostStart" prop_weekYearMostStart+    ]+ testWeek :: TestTree-testWeek = testGroup "Week" [testDay, testSucc, testPred, testSequences, testReadShow]+testWeek = nameTest "Week" [testDay, testSucc, testPred, testSequences, testReadShow, testDiff]
test/main/Test/Format/ParseTime.hs view
@@ -16,6 +16,8 @@ import Data.Time import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate+import Data.Time.Calendar.Month+import Data.Time.Calendar.Quarter import Test.Arbitrary () import Test.QuickCheck.Property import Test.Tasty@@ -60,6 +62,8 @@  class HasFormatCodes t where     allFormatCodes :: Proxy t -> [(Bool, Char)]+    incompleteS :: Maybe t+    incompleteS = Nothing  minCodeWidth :: Char -> Int minCodeWidth _ = 0@@ -376,6 +380,12 @@ prop_read_show :: (Read a, Show a, Eq a) => a -> Result prop_read_show t = compareResult (Just t) (readMaybe (show t)) +prop_read_show_ZonedUTC :: ZonedTime -> Result+prop_read_show_ZonedUTC t = compareResult (Just $ zonedTimeToUTC t) (readMaybe (show t))++prop_read_show_LocalUTC :: LocalTime -> Result+prop_read_show_LocalUTC t = compareResult (Just $ localTimeToUTC utc t) (readMaybe (show t))+ -- -- * special show functions --@@ -416,25 +426,23 @@ prop_parse_format_lower (FormatString f) t = compareParse t f (map toLower $ format f t)  -- Default time is 1970-01-01 00:00:00 +0000 (which was a Thursday)-in1970 :: Char -> String -> Bool-in1970 'j' "366" = False -- 1970 was not a leap year-in1970 'U' "53" = False -- last day of 1970 was Sunday-start-week 52-in1970 'W' "53" = False -- last day of 1970 was Monday-start-week 52-in1970 _ _ = True+in1970 :: Maybe String -> Char -> String -> Maybe String+in1970 _ 'j' "366" = Nothing -- 1970 was not a leap year+in1970 _ 'U' "53" = Nothing -- last day of 1970 was Sunday-start-week 52+in1970 _ 'W' "53" = Nothing -- last day of 1970 was Monday-start-week 52+in1970 (Just s) 'S' "60" = Just s -- no leap second without other data+in1970 _ _ s = Just s  -- format t == format (parse (format t)) prop_format_parse_format ::-       forall t. (FormatTime t, ParseTime t)+       forall t. (HasFormatCodes t, FormatTime t, ParseTime t)     => Proxy t     -> FormatCode ParseAndFormat t     -> t     -> Result prop_format_parse_format _ fc v = let     s1 = formatCode fc v-    ms1 =-        if in1970 (fcSpecifier fc) s1-            then Just s1-            else Nothing+    ms1 = in1970 (fmap (formatCode fc) (incompleteS :: Maybe t)) (fcSpecifier fc) s1     mv2 :: Maybe t     mv2 = parseCode fc s1     ms2 = fmap (formatCode fc) mv2@@ -459,6 +467,7 @@  instance HasFormatCodes UTCTime where     allFormatCodes _ = [(False, s) | s <- "cs"] ++ allFormatCodes (Proxy :: Proxy LocalTime)+    incompleteS = Just $ UTCTime (fromGregorian 2000 1 1) 0  instance HasFormatCodes UniversalTime where     allFormatCodes _ = allFormatCodes (Proxy :: Proxy LocalTime)@@ -503,6 +512,7 @@ typedTests :: (forall t. (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result) -> [TestTree] typedTests prop =     [ nameTest "Day" $ tgroup dayFormats prop+    , nameTest "Month" $ tgroup monthFormats prop     , nameTest "TimeOfDay" $ tgroup timeOfDayFormats prop     , nameTest "LocalTime" $ tgroup localTimeFormats prop     , nameTest "TimeZone" $ tgroup timeZoneFormats prop@@ -530,6 +540,27 @@     , f "UniversalTime" (Proxy :: Proxy UniversalTime)     ] +allLeapSecondTypes ::+       (forall t. (Eq t, Show t, Arbitrary t, FormatTime t, ParseTime t, HasFormatCodes t) => String -> t -> r)+    -> [r]+allLeapSecondTypes f = let+    day :: Day+    day = fromGregorian 2000 01 01+    lsTimeOfDay :: TimeOfDay+    lsTimeOfDay = TimeOfDay 23 59 60.5+    lsLocalTime :: LocalTime+    lsLocalTime = LocalTime day lsTimeOfDay+    lsZonedTime :: ZonedTime+    lsZonedTime = ZonedTime lsLocalTime utc+    lsUTCTime :: UTCTime+    lsUTCTime = UTCTime day 86400.5+    in+    [ f "TimeOfDay" lsTimeOfDay+    , f "LocalTime" lsLocalTime+    , f "ZonedTime" lsZonedTime+    , f "UTCTime" lsUTCTime+    ]+ parseEmptyTest ::        forall t. ParseTime t     => Proxy t@@ -543,9 +574,12 @@ parseEmptyTests = nameTest "parse empty" $ allTypes $ \name p -> nameTest name $ parseEmptyTest p  formatParseFormatTests :: TestTree-formatParseFormatTests =-    localOption (QuickCheckTests 50000) $-    nameTest "format_parse_format" $ allTypes $ \name p -> nameTest name $ prop_format_parse_format p+formatParseFormatTests = nameTest "format_parse_format"+    [+        localOption (QuickCheckTests 50000) $+        nameTest "general" $ allTypes $ \name p -> nameTest name $ prop_format_parse_format p,+        nameTest "leapsecond" $ allLeapSecondTypes $ \name t -> nameTest name $ \fc -> prop_format_parse_format Proxy fc t+    ]  badInputTests :: TestTree badInputTests =@@ -567,12 +601,19 @@     nameTest         "read_show"         [ nameTest "Day" (prop_read_show :: Day -> Result)+        , nameTest "Month" (prop_read_show :: Month -> Result)+        , nameTest "QuarterOfYear" (prop_read_show :: QuarterOfYear -> Result)+        , nameTest "Quarter" (prop_read_show :: Quarter -> Result)         , nameTest "TimeOfDay" (prop_read_show :: TimeOfDay -> Result)         , nameTest "LocalTime" (prop_read_show :: LocalTime -> Result)         , nameTest "TimeZone" (prop_read_show :: TimeZone -> Result)         , nameTest "ZonedTime" (prop_read_show :: ZonedTime -> Result)         , nameTest "UTCTime" (prop_read_show :: UTCTime -> Result)+        , nameTest "UTCTime (zoned)" prop_read_show_ZonedUTC+        , nameTest "UTCTime (local)" prop_read_show_LocalUTC         , nameTest "UniversalTime" (prop_read_show :: UniversalTime -> Result)+        , nameTest "NominalDiffTime" (prop_read_show :: NominalDiffTime -> Result)+        , nameTest "DiffTime" (prop_read_show :: DiffTime -> Result)     --nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result),     --nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> Result)         ]@@ -620,8 +661,12 @@         , "%Y-%B-%d"         , "%Y-%b-%d"         , "%Y-%h-%d"+        , "%C-%y-%B-%d"+        , "%C-%y-%b-%d"+        , "%C-%y-%h-%d"      -- ordinal dates         , "%Y-%j"+        , "%C-%y-%j"      -- ISO week dates         , "%G-%V-%u"         , "%G-%V-%a"@@ -644,6 +689,27 @@         , "%Y-%A-w%W"         , "%A week %U, %Y"         , "%A week %W, %Y"+        ]++monthFormats :: [FormatString Month]+monthFormats =+    map FormatString+     -- numeric year, month+        [ "%Y-%m"+        , "%Y%m"+        , "%C%y%m"+        , "%Y %m"+        , "%m/%Y"+        , "%m/%Y"+        , "%Y/%m"+        , "%C %y %m"+     -- month names+        , "%Y-%B"+        , "%Y-%b"+        , "%Y-%h"+        , "%C-%y-%B"+        , "%C-%y-%b"+        , "%C-%y-%h"         ]  timeOfDayFormats :: [FormatString TimeOfDay]
time.cabal view
@@ -1,5 +1,5 @@ name:           time-version:        1.10+version:        1.11 stability:      stable license:        BSD3 license-file:   LICENSE@@ -12,7 +12,13 @@ category:       Time build-type:     Configure cabal-version:  >=1.10-tested-with:    GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+tested-with:+    GHC == 8.0.2,+    GHC == 8.2.2,+    GHC == 8.4.4,+    GHC == 8.6.5,+    GHC == 8.8.4,+    GHC == 8.10.2 x-follows-version-policy:  extra-source-files:@@ -41,6 +47,8 @@         Rank2Types         DeriveDataTypeable         StandaloneDeriving+        PatternSynonyms+        ViewPatterns         CPP     ghc-options: -Wall -fwarn-tabs     c-sources: lib/cbits/HsTime.c@@ -56,6 +64,8 @@         Data.Time.Calendar.WeekDate,         Data.Time.Calendar.Julian,         Data.Time.Calendar.Easter,+        Data.Time.Calendar.Month,+        Data.Time.Calendar.Quarter,         Data.Time.Clock,         Data.Time.Clock.System,         Data.Time.Clock.POSIX,@@ -67,6 +77,7 @@         Data.Time     other-modules:         Data.Format+        Data.Time.Calendar.Types,         Data.Time.Calendar.Private,         Data.Time.Calendar.Days,         Data.Time.Calendar.Gregorian,@@ -144,6 +155,7 @@         Test.Arbitrary         Test.Calendar.AddDays         Test.Calendar.AddDaysRef+        Test.Calendar.CalendarProps         Test.Calendar.Calendars         Test.Calendar.CalendarsRef         Test.Calendar.ClipDates@@ -204,3 +216,15 @@         Test.TestUtil         Test.Format.Format         Test.LocalTime.TimeZone++benchmark time-bench+    type: exitcode-stdio-1.0+    hs-source-dirs: benchmark+    default-language: Haskell2010+    ghc-options: -Wall -fwarn-tabs+    build-depends:+        base,+        deepseq,+        time,+        criterion+    main-is: Main.hs