packages feed

time 1.5.0.1 → 1.6

raw patch · 50 files changed

+1190/−813 lines, 50 filesdep ~basedep ~time

Dependency ranges changed: base, time

Files

+ changelog.md view
@@ -0,0 +1,17 @@+# Change Log++## [1.6]++### Added+- FormatTime, ParseTime, Show and Read instances for UniversalTime+- diffTimeToPicoseconds+- this change log++### Changed+- Use clock_gettime where available+- Read and Show instances exported in the same module as their types+- Fixed bug in fromSundayStartWeekValid+- Parsing functions now reject invalid dates+- Various documentation fixes++## [1.5.0.1]
configure view
@@ -3434,6 +3434,18 @@ done  +for ac_func in clock_gettime+do :+  ac_fn_c_check_func "$LINENO" "clock_gettime" "ac_cv_func_clock_gettime"+if test "x$ac_cv_func_clock_gettime" = xyes; then :+  cat >>confdefs.h <<_ACEOF+#define HAVE_CLOCK_GETTIME 1+_ACEOF++fi+done++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 $as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } if ${ac_cv_struct_tm+:} false; then :
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell time package], [1.4.0.2], [ashley@semantic.org], [time])+AC_INIT([Haskell time package], [1.6], [ashley@semantic.org], [time])  # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h])@@ -14,6 +14,8 @@  AC_CHECK_HEADERS([time.h]) AC_CHECK_FUNCS([gmtime_r localtime_r])++AC_CHECK_FUNCS([clock_gettime])  AC_STRUCT_TM AC_STRUCT_TIMEZONE
lib/Data/Time.hs view
@@ -1,9 +1,9 @@ module Data.Time (-	module Data.Time.Calendar,-	module Data.Time.Clock,-	module Data.Time.LocalTime,-	module Data.Time.Format+    module Data.Time.Calendar,+    module Data.Time.Clock,+    module Data.Time.LocalTime,+    module Data.Time.Format ) where  import Data.Time.Calendar
lib/Data/Time/Calendar.hs view
@@ -1,8 +1,9 @@ module Data.Time.Calendar (-	module Data.Time.Calendar.Days,-	module Data.Time.Calendar.Gregorian+    module Data.Time.Calendar.Days,+    module Data.Time.Calendar.Gregorian ) where  import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian+import Data.Time.Format()
lib/Data/Time/Calendar/Days.hs view
@@ -3,8 +3,8 @@ -- #hide module Data.Time.Calendar.Days (-	-- * Days-	Day(..),addDays,diffDays+    -- * Days+    Day(..),addDays,diffDays ) where  import Control.DeepSeq@@ -24,51 +24,28 @@     )  instance NFData Day where-	rnf (ModifiedJulianDay a) = rnf a+    rnf (ModifiedJulianDay a) = rnf a  -- necessary because H98 doesn't have "cunning newtype" derivation instance Enum Day where-	succ (ModifiedJulianDay a) = ModifiedJulianDay (succ a)-	pred (ModifiedJulianDay a) = ModifiedJulianDay (pred a)-	toEnum = ModifiedJulianDay . toEnum-	fromEnum (ModifiedJulianDay a) = fromEnum a-	enumFrom (ModifiedJulianDay a) = fmap ModifiedJulianDay (enumFrom a)-	enumFromThen (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromThen a b)-	enumFromTo (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromTo a b)-	enumFromThenTo (ModifiedJulianDay a) (ModifiedJulianDay b) (ModifiedJulianDay c) = fmap ModifiedJulianDay (enumFromThenTo a b c)+    succ (ModifiedJulianDay a) = ModifiedJulianDay (succ a)+    pred (ModifiedJulianDay a) = ModifiedJulianDay (pred a)+    toEnum = ModifiedJulianDay . toEnum+    fromEnum (ModifiedJulianDay a) = fromEnum a+    enumFrom (ModifiedJulianDay a) = fmap ModifiedJulianDay (enumFrom a)+    enumFromThen (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromThen a b)+    enumFromTo (ModifiedJulianDay a) (ModifiedJulianDay b) = fmap ModifiedJulianDay (enumFromTo a b)+    enumFromThenTo (ModifiedJulianDay a) (ModifiedJulianDay b) (ModifiedJulianDay c) = fmap ModifiedJulianDay (enumFromThenTo a b c)  -- necessary because H98 doesn't have "cunning newtype" derivation instance Ix Day where-	range (ModifiedJulianDay a,ModifiedJulianDay b) = fmap ModifiedJulianDay (range (a,b))-	index (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = index (a,b) c-	inRange (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = inRange (a,b) c-	rangeSize (ModifiedJulianDay a,ModifiedJulianDay b) = rangeSize (a,b)+    range (ModifiedJulianDay a,ModifiedJulianDay b) = fmap ModifiedJulianDay (range (a,b))+    index (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = index (a,b) c+    inRange (ModifiedJulianDay a,ModifiedJulianDay b) (ModifiedJulianDay c) = inRange (a,b) c+    rangeSize (ModifiedJulianDay a,ModifiedJulianDay b) = rangeSize (a,b)  addDays :: Integer -> Day -> Day addDays n (ModifiedJulianDay a) = ModifiedJulianDay (a + n)  diffDays :: Day -> Day -> Integer diffDays (ModifiedJulianDay a) (ModifiedJulianDay b) = a - b--{--instance Show Day where-	show (ModifiedJulianDay d) = "MJD " ++ (show d)---- necessary because H98 doesn't have "cunning newtype" derivation-instance Num Day where-	(ModifiedJulianDay a) + (ModifiedJulianDay b) = ModifiedJulianDay (a + b)-	(ModifiedJulianDay a) - (ModifiedJulianDay b) = ModifiedJulianDay (a - b)-	(ModifiedJulianDay a) * (ModifiedJulianDay b) = ModifiedJulianDay (a * b)-	negate (ModifiedJulianDay a) = ModifiedJulianDay (negate a)-	abs (ModifiedJulianDay a) = ModifiedJulianDay (abs a)-	signum (ModifiedJulianDay a) = ModifiedJulianDay (signum a)-	fromInteger = ModifiedJulianDay--instance Real Day where-	toRational (ModifiedJulianDay a) = toRational a--instance Integral Day where-	toInteger (ModifiedJulianDay a) = toInteger a-	quotRem (ModifiedJulianDay a) (ModifiedJulianDay b) = (ModifiedJulianDay c,ModifiedJulianDay d) where-		(c,d) = quotRem a b--}
lib/Data/Time/Calendar/Easter.hs view
@@ -1,12 +1,12 @@ module Data.Time.Calendar.Easter-	(-	sundayAfter,-	orthodoxPaschalMoon,orthodoxEaster,-	gregorianPaschalMoon,gregorianEaster-	) where+    (+    sundayAfter,+    orthodoxPaschalMoon,orthodoxEaster,+    gregorianPaschalMoon,gregorianEaster+    ) where  -- formulae from Reingold & Dershowitz, _Calendrical Calculations_, ch. 8.-	+ import Data.Time.Calendar import Data.Time.Calendar.Julian @@ -17,8 +17,8 @@ -- | Given a year, find the Paschal full moon according to Orthodox Christian tradition orthodoxPaschalMoon :: Integer -> Day orthodoxPaschalMoon year  = addDays (- shiftedEpact) (fromJulian jyear 4 19) where-	shiftedEpact = mod (14 + 11 * (mod year 19)) 30-	jyear = if year > 0 then year else year - 1+    shiftedEpact = mod (14 + 11 * (mod year 19)) 30+    jyear = if year > 0 then year else year - 1  -- | Given a year, find Easter according to Orthodox Christian tradition orthodoxEaster :: Integer -> Day@@ -27,9 +27,9 @@ -- | Given a year, find the Paschal full moon according to the Gregorian method gregorianPaschalMoon :: Integer -> Day gregorianPaschalMoon year  = addDays (- adjustedEpact) (fromGregorian year 4 19) where-	century = (div year 100) + 1-	shiftedEpact = mod (14 + 11 * (mod year 19) - (div (3 * century) 4) + (div (5 + 8 * century) 25)) 30-	adjustedEpact = if shiftedEpact == 0 || ((shiftedEpact == 1) && (mod year 19 < 10)) then shiftedEpact + 1 else shiftedEpact+    century = (div year 100) + 1+    shiftedEpact = mod (14 + 11 * (mod year 19) - (div (3 * century) 4) + (div (5 + 8 * century) 25)) 30+    adjustedEpact = if shiftedEpact == 0 || ((shiftedEpact == 1) && (mod year 19 < 10)) then shiftedEpact + 1 else shiftedEpact  -- | Given a year, find Easter according to the Gregorian method gregorianEaster :: Integer -> Day
lib/Data/Time/Calendar/Gregorian.hs view
@@ -3,16 +3,16 @@ -- #hide module Data.Time.Calendar.Gregorian (-	-- * Gregorian calendar-	toGregorian,fromGregorian,fromGregorianValid,showGregorian,gregorianMonthLength,+    -- * Gregorian calendar+    toGregorian,fromGregorian,fromGregorianValid,showGregorian,gregorianMonthLength, -	-- calendrical arithmetic+    -- calendrical arithmetic     -- e.g. "one month after March 31st"-	addGregorianMonthsClip,addGregorianMonthsRollOver,-	addGregorianYearsClip,addGregorianYearsRollOver,+    addGregorianMonthsClip,addGregorianMonthsRollOver,+    addGregorianYearsClip,addGregorianYearsRollOver, -	-- re-exported from OrdinalDate-	isLeapYear+    -- re-exported from OrdinalDate+    isLeapYear ) where  import Data.Time.Calendar.MonthDay@@ -23,8 +23,8 @@ -- | 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) toGregorian date = (year,month,day) where-	(year,yd) = toOrdinalDate date-	(month,day) = dayOfYearToMonthAndDay (isLeapYear year) yd+    (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). -- Invalid values will be clipped to the correct range, month first, then day.@@ -35,13 +35,13 @@ -- Invalid values will return Nothing fromGregorianValid :: Integer -> Int -> Int -> Maybe Day fromGregorianValid year month day = do-	doy <- monthAndDayToDayOfYearValid (isLeapYear year) month day-	fromOrdinalDateValid year doy+    doy <- monthAndDayToDayOfYearValid (isLeapYear year) month day+    fromOrdinalDateValid year doy  -- | show in ISO 8601 format (yyyy-mm-dd) showGregorian :: Day -> String showGregorian date = (show4 (Just '0') y) ++ "-" ++ (show2 (Just '0') m) ++ "-" ++ (show2 (Just '0') d) where-	(y,m,d) = toGregorian date+    (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@@ -52,20 +52,20 @@  addGregorianMonths :: Integer -> Day -> (Integer,Int,Int) addGregorianMonths n day = (y',m',d) where-	(y,m,d) = toGregorian day-	(y',m') = rolloverMonths (y,fromIntegral m + n)+    (y,m,d) = toGregorian day+    (y',m') = rolloverMonths (y,fromIntegral m + n)  -- | Add months, with days past the last day of the month clipped to the last day. -- For instance, 2005-01-30 + 1 month = 2005-02-28. addGregorianMonthsClip :: Integer -> Day -> Day addGregorianMonthsClip n day = fromGregorian y m d where-	(y,m,d) = addGregorianMonths n day+    (y,m,d) = addGregorianMonths n day  -- | Add months, with days past the last day of the month rolling over to the next month. -- For instance, 2005-01-30 + 1 month = 2005-03-02. addGregorianMonthsRollOver :: Integer -> Day -> Day addGregorianMonthsRollOver n day = addDays (fromIntegral d - 1) (fromGregorian y m 1) where-	(y,m,d) = addGregorianMonths n day+    (y,m,d) = addGregorianMonths n day  -- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary. -- For instance, 2004-02-29 + 2 years = 2006-02-28.@@ -79,4 +79,4 @@  -- orphan instance instance Show Day where-	show = showGregorian+    show = showGregorian
lib/Data/Time/Calendar/Julian.hs view
@@ -1,13 +1,13 @@ module Data.Time.Calendar.Julian (-	module Data.Time.Calendar.JulianYearDay,+    module Data.Time.Calendar.JulianYearDay, -	toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength,+    toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength, -	-- calendrical arithmetic+    -- calendrical arithmetic     -- e.g. "one month after March 31st"-	addJulianMonthsClip,addJulianMonthsRollOver,-	addJulianYearsClip,addJulianYearsRollOver+    addJulianMonthsClip,addJulianMonthsRollOver,+    addJulianYearsClip,addJulianYearsRollOver ) where  import Data.Time.Calendar.MonthDay@@ -18,8 +18,8 @@ -- | 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) toJulian date = (year,month,day) where-	(year,yd) = toJulianYearAndDay date-	(month,day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd+    (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). -- Invalid values will be clipped to the correct range, month first, then day.@@ -30,13 +30,13 @@ -- Invalid values will return Nothing. fromJulianValid :: Integer -> Int -> Int -> Maybe Day fromJulianValid year month day = do-	doy <- monthAndDayToDayOfYearValid (isJulianLeapYear year) month day-	fromJulianYearAndDayValid year doy+    doy <- monthAndDayToDayOfYearValid (isJulianLeapYear year) month day+    fromJulianYearAndDayValid year doy  -- | show in ISO 8601 format (yyyy-mm-dd) showJulian :: Day -> String showJulian date = (show4 (Just '0') y) ++ "-" ++ (show2 (Just '0') m) ++ "-" ++ (show2 (Just '0') d) where-	(y,m,d) = toJulian date+    (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@@ -47,20 +47,20 @@  addJulianMonths :: Integer -> Day -> (Integer,Int,Int) addJulianMonths n day = (y',m',d) where-	(y,m,d) = toJulian day-	(y',m') = rolloverMonths (y,fromIntegral m + n)+    (y,m,d) = toJulian day+    (y',m') = rolloverMonths (y,fromIntegral m + n)  -- | Add months, with days past the last day of the month clipped to the last day. -- For instance, 2005-01-30 + 1 month = 2005-02-28. addJulianMonthsClip :: Integer -> Day -> Day addJulianMonthsClip n day = fromJulian y m d where-	(y,m,d) = addJulianMonths n day+    (y,m,d) = addJulianMonths n day  -- | Add months, with days past the last day of the month rolling over to the next month. -- For instance, 2005-01-30 + 1 month = 2005-03-02. addJulianMonthsRollOver :: Integer -> Day -> Day addJulianMonthsRollOver n day = addDays (fromIntegral d - 1) (fromJulian y m 1) where-	(y,m,d) = addJulianMonths n day+    (y,m,d) = addJulianMonths n day  -- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary. -- For instance, 2004-02-29 + 2 years = 2006-02-28.
lib/Data/Time/Calendar/JulianYearDay.hs view
@@ -1,9 +1,9 @@ -- #hide module Data.Time.Calendar.JulianYearDay-	(-	-- * Year and day format-	module Data.Time.Calendar.JulianYearDay-	) where+    (+    -- * Year and day format+    module Data.Time.Calendar.JulianYearDay+    ) where  import Data.Time.Calendar.Days import Data.Time.Calendar.Private@@ -12,34 +12,34 @@ -- 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) toJulianYearAndDay (ModifiedJulianDay mjd) = (year,yd) where-	a = mjd + 678577-	quad = div a 1461-	d = mod a 1461-	y = min (div d 365) 3-	yd = fromInteger (d - (y * 365) + 1)-	year = quad * 4 + y + 1+    a = mjd + 678577+    quad = div a 1461+    d = mod a 1461+    y = min (div d 365) 3+    yd = fromInteger (d - (y * 365) + 1)+    year = quad * 4 + y + 1  -- | 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 day = ModifiedJulianDay mjd where-	y = year - 1-	mjd = (fromIntegral (clip 1 (if isJulianLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - 678578+    y = year - 1+    mjd = (fromIntegral (clip 1 (if isJulianLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - 678578  -- | convert from proleptic Julian year and day format. -- Invalid day numbers will return Nothing fromJulianYearAndDayValid :: Integer -> Int -> Maybe Day fromJulianYearAndDayValid year day = do-	day' <- clipValid 1 (if isJulianLeapYear year then 366 else 365) day-	let-		y = year - 1-		mjd = (fromIntegral day') + (365 * y) + (div y 4) - 678578-	return (ModifiedJulianDay mjd)+    day' <- clipValid 1 (if isJulianLeapYear year then 366 else 365) day+    let+        y = year - 1+        mjd = (fromIntegral day') + (365 * y) + (div y 4) - 678578+    return (ModifiedJulianDay mjd)  -- | show in proleptic Julian year and day format (yyyy-ddd) showJulianYearAndDay :: Day -> String showJulianYearAndDay date = (show4 (Just '0') y) ++ "-" ++ (show3 (Just '0') d) where-	(y,d) = toJulianYearAndDay date+    (y,d) = toJulianYearAndDay date  -- | Is this year a leap year according to the proleptic Julian calendar? isJulianLeapYear :: Integer -> Bool
lib/Data/Time/Calendar/MonthDay.hs view
@@ -1,7 +1,7 @@ module Data.Time.Calendar.MonthDay-	(-	monthAndDayToDayOfYear,monthAndDayToDayOfYearValid,dayOfYearToMonthAndDay,monthLength-	) where+    (+    monthAndDayToDayOfYear,monthAndDayToDayOfYearValid,dayOfYearToMonthAndDay,monthLength+    ) where  import Data.Time.Calendar.Private @@ -9,22 +9,22 @@ -- First arg is leap year flag monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where-	month' = clip 1 12 month-	day' = fromIntegral (clip 1 (monthLength' isLeap month') day)-	month'' = fromIntegral month'-	k = if month' <= 2 then 0 else if isLeap then -1 else -2+    month' = clip 1 12 month+    day' = fromIntegral (clip 1 (monthLength' isLeap month') day)+    month'' = fromIntegral month'+    k = if month' <= 2 then 0 else if isLeap then -1 else -2  -- | 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 isLeap month day = do-	month' <- clipValid 1 12 month-	day' <- clipValid 1 (monthLength' isLeap month') day-	let-		day'' = fromIntegral day'-		month'' = fromIntegral month'-		k = if month' <= 2 then 0 else if isLeap then -1 else -2-	return ((div (367 * month'' - 362) 12) + k + day'')+    month' <- clipValid 1 12 month+    day' <- clipValid 1 (monthLength' isLeap month') day+    let+        day'' = fromIntegral day'+        month'' = fromIntegral month'+        k = if month' <= 2 then 0 else if isLeap then -1 else -2+    return ((div (367 * month'' - 362) 12) + k + day'')  -- | convert day of year in the Gregorian or Julian calendars to month and day. -- First arg is leap year flag@@ -44,6 +44,6 @@ monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1)  monthLengths :: Bool -> [Int]-monthLengths isleap = -	[31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]-	--J        F                   M  A  M  J  J  A  S  O  N  D+monthLengths isleap =+    [31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]+    --J        F                   M  A  M  J  J  A  S  O  N  D
lib/Data/Time/Calendar/OrdinalDate.hs view
@@ -8,38 +8,38 @@ -- 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) toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where-	a = mjd + 678575-	quadcent = div a 146097-	b = mod a 146097-	cent = min (div b 36524) 3-	c = b - (cent * 36524)-	quad = div c 1461-	d = mod c 1461-	y = min (div d 365) 3-	yd = fromInteger (d - (y * 365) + 1)-	year = quadcent * 400 + cent * 100 + quad * 4 + y + 1+    a = mjd + 678575+    quadcent = div a 146097+    b = mod a 146097+    cent = min (div b 36524) 3+    c = b - (cent * 36524)+    quad = div c 1461+    d = mod c 1461+    y = min (div d 365) 3+    yd = fromInteger (d - (y * 365) + 1)+    year = quadcent * 400 + cent * 100 + quad * 4 + y + 1  -- | 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 day = ModifiedJulianDay mjd where-	y = year - 1-	mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576+    y = year - 1+    mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576  -- | convert from ISO 8601 Ordinal Date format. -- Invalid day numbers return Nothing fromOrdinalDateValid :: Integer -> Int -> Maybe Day fromOrdinalDateValid year day = do-	day' <- clipValid 1 (if isLeapYear year then 366 else 365) day-	let-		y = year - 1-		mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576-	return (ModifiedJulianDay mjd)+    day' <- clipValid 1 (if isLeapYear year then 366 else 365) day+    let+        y = year - 1+        mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576+    return (ModifiedJulianDay mjd)  -- | show in ISO 8601 Ordinal Date format (yyyy-ddd) showOrdinalDate :: Day -> String showOrdinalDate date = (show4 (Just '0') y) ++ "-" ++ (show3 (Just '0') d) where-	(y,d) = toOrdinalDate date+    (y,d) = toOrdinalDate date  -- | Is this year a leap year according to the proleptic Gregorian calendar? isLeapYear :: Integer -> Bool@@ -50,78 +50,121 @@ -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime'). mondayStartWeek :: Day -> (Int,Int) mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where-	yd = snd (toOrdinalDate date)-	d = (toModifiedJulianDay date) + 2-	k = d - (toInteger yd)+    yd = snd (toOrdinalDate date)+    d = (toModifiedJulianDay date) + 2+    k = d - (toInteger yd)  -- | 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 date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where-	yd = snd (toOrdinalDate date)-	d = (toModifiedJulianDay date) + 3-	k = d - (toInteger yd)+    yd = snd (toOrdinalDate date)+    d = (toModifiedJulianDay date) + 3+    k = d - (toInteger yd)  -- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year, -- the number of the Monday-starting week, and the day of the week.--- The first Monday is the first day of week 1, any earlier days in the year +-- 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.-                    -> Int     -- ^ Day of week. +                    -> Int     -- ^ 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-fromMondayStartWeek y w d = ModifiedJulianDay (firstDay + yd)-    where yd = firstMonday + 7 * toInteger (w-1) + toInteger d - 1-          -- first day of the year-          firstDay = toModifiedJulianDay (fromOrdinalDate y 1)-          -- 0-based year day of first monday of the year-          firstMonday = (5 - firstDay) `mod` 7+fromMondayStartWeek year w d = let+    -- first day of the year+    firstDay = fromOrdinalDate year 1 +    -- 0-based year day of first monday of the year+    zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7++    -- 0-based week of year+    zbWeek = w - 1++    -- 0-based day of week+    zbDay = d - 1++    -- 0-based day in year+    zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay++    in addDays zbYearDay firstDay+ fromMondayStartWeekValid :: Integer -- ^ Year.-                    -> Int     -- ^ Monday-starting week number.-                    -> Int     -- ^ Day of week. +                    -> Int     -- ^ 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 fromMondayStartWeekValid year w d = do-	d' <- clipValid 1 7 d-	-- first day of the year-	let firstDay = toModifiedJulianDay (fromOrdinalDate year 1)-	-- 0-based year day of first monday of the year-	let firstMonday = (5 - firstDay) `mod` 7-	let yd = firstMonday + 7 * toInteger (w-1) + toInteger d'-	yd' <- clipValid 1 (if isLeapYear year then 366 else 365) yd-	return (ModifiedJulianDay (firstDay - 1 + yd'))+    d' <- clipValid 1 7 d+    let+        -- first day of the year+        firstDay = fromOrdinalDate year 1 +        -- 0-based week of year+        zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7++        -- 0-based week number+        zbWeek = w - 1++        -- 0-based day of week+        zbDay = d' - 1++        -- 0-based day in year+        zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay++    zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay+    return $ addDays zbYearDay' firstDay+ -- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and -- the number of the day of a Sunday-starting week.--- The first Sunday is the first day of week 1, any earlier days in the +-- 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.+                    -> Int     -- ^ 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-fromSundayStartWeek y w d = ModifiedJulianDay (firstDay + yd)-    where yd = firstSunday + 7 * toInteger (w-1) + toInteger d-          -- first day of the year-          firstDay = toModifiedJulianDay (fromOrdinalDate y 1)-          -- 0-based year day of first sunday of the year-          firstSunday = (4 - firstDay) `mod` 7+fromSundayStartWeek year w d = let+    -- first day of the year+    firstDay = fromOrdinalDate year 1 +    -- 0-based year day of first monday of the year+    zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7++    -- 0-based week of year+    zbWeek = w - 1++    -- 0-based day of week+    zbDay = d++    -- 0-based day in year+    zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay++    in addDays zbYearDay firstDay+ fromSundayStartWeekValid :: Integer -- ^ Year.-                    -> Int     -- ^ Monday-starting week number.-                    -> Int     -- ^ Day of week. -                               -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').+                    -> Int     -- ^ 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-fromSundayStartWeekValid year w d = do-	d' <- clipValid 1 7 d-	-- first day of the year-	let firstDay = toModifiedJulianDay (fromOrdinalDate year 1)-	-- 0-based year day of first sunday of the year-	let firstMonday = (4 - firstDay) `mod` 7-	let yd = firstMonday + 7 * toInteger (w-1) + toInteger d'-	yd' <- clipValid 1 (if isLeapYear year then 366 else 365) yd-	return (ModifiedJulianDay (firstDay - 1 + yd'))+fromSundayStartWeekValid year w d =  do+    d' <- clipValid 0 6 d+    let+        -- first day of the year+        firstDay = fromOrdinalDate year 1 +        -- 0-based week of year+        zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7++        -- 0-based week number+        zbWeek = w - 1++        -- 0-based day of week+        zbDay = d'++        -- 0-based day in year+        zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay++    zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay+    return $ addDays zbYearDay' firstDay
lib/Data/Time/Calendar/Private.hs view
@@ -21,7 +21,7 @@ showPaddedMin _ Nothing i = show i showPaddedMin pl opt i | i < 0 = '-':(showPaddedMin pl opt (negate i)) showPaddedMin pl (Just c) i =-  let s = show i in +  let s = show i in     padN (pl - (length s)) c s  show2 :: (Num t,Ord t,Show t) => NumericPadOption -> t -> String
lib/Data/Time/Calendar/WeekDate.hs view
@@ -10,43 +10,43 @@ -- 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)-	+    (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)+ -- | 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+        k = toModifiedJulianDay (fromOrdinalDate y 6)+        longYear = case toWeekDate (fromOrdinalDate y 365) of+            (_,53,_) -> True+            _ -> False  -- | 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))+    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))  -- | show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\"). showWeekDate :: Day -> String showWeekDate date = (show4 (Just '0') y) ++ "-W" ++ (show2 (Just '0') w) ++ "-" ++ (show d) where-	(y,w,d) = toWeekDate date+    (y,w,d) = toWeekDate date
lib/Data/Time/Clock.hs view
@@ -1,18 +1,15 @@ -- | Types and functions for UTC and UT1 module Data.Time.Clock (-	module Data.Time.Clock.Scale,-	module Data.Time.Clock.UTC,-	module Data.Time.Clock.UTCDiff,-	module Data.Time.Clock+    module Data.Time.Clock.Scale,+    module Data.Time.Clock.UTC,+    module Data.Time.Clock.UTCDiff,+    getCurrentTime ) where  import Data.Time.Clock.Scale import Data.Time.Clock.UTCDiff import Data.Time.Clock.UTC import Data.Time.Clock.POSIX-import Control.Monad---- | Get the current UTC time from the system clock.-getCurrentTime :: IO UTCTime-getCurrentTime = liftM posixSecondsToUTCTime getPOSIXTime+import Data.Time.Format.Parse()+import Data.Time.LocalTime()
+ lib/Data/Time/Clock/CTimespec.hsc view
@@ -0,0 +1,41 @@+-- #hide+module Data.Time.Clock.CTimespec where++#include "HsTimeConfig.h"++#if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME++#if __GLASGOW_HASKELL__ >= 709+import Foreign+#else+import Foreign.Safe+#endif+import Foreign.C++#include <time.h>++data CTimespec = MkCTimespec CTime CLong++instance Storable CTimespec where+    sizeOf _ = #{size struct timespec}+    alignment _ = alignment (undefined :: CLong)+    peek p = do+        s  <- #{peek struct timespec, tv_sec } p+        ns <- #{peek struct timespec, tv_nsec} p+        return (MkCTimespec s ns)+    poke p (MkCTimespec s ns) = do+        #{poke struct timespec, tv_sec } p s+        #{poke struct timespec, tv_nsec} p ns++foreign import ccall unsafe "time.h clock_gettime"+    clock_gettime :: #{type clockid_t} -> Ptr CTimespec -> IO CInt++-- | Get the current POSIX time from the system clock.+getCTimespec :: IO CTimespec+getCTimespec = alloca (\ptspec -> do+    throwErrnoIfMinus1_ "clock_gettime" $+        clock_gettime #{const CLOCK_REALTIME} ptspec+    peek ptspec+    )++#endif
lib/Data/Time/Clock/CTimeval.hs view
@@ -4,7 +4,7 @@ #ifndef mingw32_HOST_OS -- All Unix-specific, this -#if __GLASGOW_HASKELL__ >= 709+#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 import Foreign #else import Foreign.Safe@@ -14,23 +14,23 @@ data CTimeval = MkCTimeval CLong CLong  instance Storable CTimeval where-	sizeOf _ = (sizeOf (undefined :: CLong)) * 2-	alignment _ = alignment (undefined :: CLong)-	peek p = do-		s   <- peekElemOff (castPtr p) 0-		mus <- peekElemOff (castPtr p) 1-		return (MkCTimeval s mus)-	poke p (MkCTimeval s mus) = do-		pokeElemOff (castPtr p) 0 s-		pokeElemOff (castPtr p) 1 mus+    sizeOf _ = (sizeOf (undefined :: CLong)) * 2+    alignment _ = alignment (undefined :: CLong)+    peek p = do+        s   <- peekElemOff (castPtr p) 0+        mus <- peekElemOff (castPtr p) 1+        return (MkCTimeval s mus)+    poke p (MkCTimeval s mus) = do+        pokeElemOff (castPtr p) 0 s+        pokeElemOff (castPtr p) 1 mus  foreign import ccall unsafe "time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt  -- | Get the current POSIX time from the system clock. getCTimeval :: IO CTimeval getCTimeval = with (MkCTimeval 0 0) (\ptval -> do-	throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptval nullPtr-	peek ptval-	)+    throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptval nullPtr+    peek ptval+    )  #endif
lib/Data/Time/Clock/POSIX.hs view
@@ -2,7 +2,7 @@ -- Most people won't need this module. module Data.Time.Clock.POSIX (-	posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime+    posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime ) where  import Data.Time.Clock.UTC@@ -10,9 +10,14 @@ import Data.Fixed import Control.Monad +#include "HsTimeConfig.h"+ #ifdef mingw32_HOST_OS-import Data.Word	( Word64)+import Data.Word    ( Word64) import System.Win32.Time+#elif HAVE_CLOCK_GETTIME+import Data.Time.Clock.CTimespec+import Foreign.C.Types (CTime(..)) #else import Data.Time.Clock.CTimeval #endif@@ -22,7 +27,7 @@ posixDayLength = 86400  -- | POSIX time is the nominal time since 1970-01-01 00:00 UTC--- +-- -- To convert from a 'Foreign.C.CTime' or 'System.Posix.EpochTime', use 'realToFrac'. -- type POSIXTime = NominalDiffTime@@ -32,7 +37,7 @@  posixSecondsToUTCTime :: POSIXTime -> UTCTime posixSecondsToUTCTime i = let-	(d,t) = divMod' i posixDayLength+    (d,t) = divMod' i posixDayLength  in UTCTime (addDays d unixEpochDay) (realToFrac t)  utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime@@ -55,6 +60,15 @@ win32_epoch_adjust :: Word64 win32_epoch_adjust = 116444736000000000 +#elif HAVE_CLOCK_GETTIME++-- Use hi-res POSIX time+ctimespecToPosixSeconds :: CTimespec -> POSIXTime+ctimespecToPosixSeconds (MkCTimespec (CTime s) ns) =+    (fromIntegral s) + (fromIntegral ns) / 1000000000++getPOSIXTime = liftM ctimespecToPosixSeconds getCTimespec+ #else  -- Use POSIX time@@ -64,3 +78,7 @@ getPOSIXTime = liftM ctimevalToPosixSeconds getCTimeval  #endif++-- | Get the current UTC time from the system clock.+getCurrentTime :: IO UTCTime+getCurrentTime = liftM posixSecondsToUTCTime getPOSIXTime
lib/Data/Time/Clock/Scale.hs view
@@ -1,16 +1,20 @@+#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+#endif {-# OPTIONS -fno-warn-unused-imports #-} #include "HsConfigure.h" -- #hide module Data.Time.Clock.Scale (-	-- * Universal Time-	-- | Time as measured by the earth.-	UniversalTime(..),+    -- * Universal Time+    -- | Time as measured by the earth.+    UniversalTime(..), -	-- * Absolute intervals-	DiffTime,-        secondsToDiffTime, picosecondsToDiffTime+    -- * Absolute intervals+    DiffTime,+    secondsToDiffTime,+    picosecondsToDiffTime,+    diffTimeToPicoseconds, ) where  import Control.DeepSeq@@ -33,7 +37,7 @@  -- necessary because H98 doesn't have "cunning newtype" derivation instance NFData UniversalTime where-	rnf (ModJulianDate a) = rnf a+    rnf (ModJulianDate a) = rnf a  -- | This is a length of time, as measured by a clock. -- Conversion functions will treat it as seconds.@@ -55,37 +59,37 @@  -- necessary because H98 doesn't have "cunning newtype" derivation instance Enum DiffTime where-	succ (MkDiffTime a) = MkDiffTime (succ a)-	pred (MkDiffTime a) = MkDiffTime (pred a)-	toEnum = MkDiffTime . toEnum-	fromEnum (MkDiffTime a) = fromEnum a-	enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a)-	enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b)-	enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b)-	enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c)+    succ (MkDiffTime a) = MkDiffTime (succ a)+    pred (MkDiffTime a) = MkDiffTime (pred a)+    toEnum = MkDiffTime . toEnum+    fromEnum (MkDiffTime a) = fromEnum a+    enumFrom (MkDiffTime a) = fmap MkDiffTime (enumFrom a)+    enumFromThen (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromThen a b)+    enumFromTo (MkDiffTime a) (MkDiffTime b) = fmap MkDiffTime (enumFromTo a b)+    enumFromThenTo (MkDiffTime a) (MkDiffTime b) (MkDiffTime c) = fmap MkDiffTime (enumFromThenTo a b c)  instance Show DiffTime where-	show (MkDiffTime t) = (showFixed True t) ++ "s"+    show (MkDiffTime t) = (showFixed True t) ++ "s"  -- necessary because H98 doesn't have "cunning newtype" derivation instance Num DiffTime where-	(MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b)-	(MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b)-	(MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b)-	negate (MkDiffTime a) = MkDiffTime (negate a)-	abs (MkDiffTime a) = MkDiffTime (abs a)-	signum (MkDiffTime a) = MkDiffTime (signum a)-	fromInteger i = MkDiffTime (fromInteger i)+    (MkDiffTime a) + (MkDiffTime b) = MkDiffTime (a + b)+    (MkDiffTime a) - (MkDiffTime b) = MkDiffTime (a - b)+    (MkDiffTime a) * (MkDiffTime b) = MkDiffTime (a * b)+    negate (MkDiffTime a) = MkDiffTime (negate a)+    abs (MkDiffTime a) = MkDiffTime (abs a)+    signum (MkDiffTime a) = MkDiffTime (signum a)+    fromInteger i = MkDiffTime (fromInteger i)  -- necessary because H98 doesn't have "cunning newtype" derivation instance Real DiffTime where-	toRational (MkDiffTime a) = toRational a+    toRational (MkDiffTime a) = toRational a  -- necessary because H98 doesn't have "cunning newtype" derivation instance Fractional DiffTime where-	(MkDiffTime a) / (MkDiffTime b) = MkDiffTime (a / b)-	recip (MkDiffTime a) = MkDiffTime (recip a)-	fromRational r = MkDiffTime (fromRational r)+    (MkDiffTime a) / (MkDiffTime b) = MkDiffTime (a / b)+    recip (MkDiffTime a) = MkDiffTime (recip a)+    fromRational r = MkDiffTime (fromRational r)  -- necessary because H98 doesn't have "cunning newtype" derivation instance RealFrac DiffTime where@@ -101,10 +105,13 @@  -- | Create a 'DiffTime' from a number of picoseconds. picosecondsToDiffTime :: Integer -> DiffTime-picosecondsToDiffTime x = fromRational (x % 1000000000000)+picosecondsToDiffTime x = MkDiffTime (MkFixed x) +-- | Get the number of picoseconds in a 'DiffTime'.+diffTimeToPicoseconds :: DiffTime -> Integer+diffTimeToPicoseconds (MkDiffTime (MkFixed x)) = x+ {-# RULES "realToFrac/DiffTime->Pico"              realToFrac = \ (MkDiffTime ps) -> ps "realToFrac/Pico->DiffTime"              realToFrac = MkDiffTime   #-}-
lib/Data/Time/Clock/TAI.hs view
@@ -3,16 +3,16 @@ -- | TAI and leap-second tables for converting to UTC: most people won't need this module. module Data.Time.Clock.TAI (-	-- TAI arithmetic-	AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime,+    -- TAI arithmetic+    AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime, -	-- leap-second table type-	LeapSecondTable,+    -- leap-second table type+    LeapSecondTable, -	-- conversion between UTC and TAI with table-	utcDayLength,utcToTAITime,taiToUTCTime,+    -- conversion between UTC and TAI with table+    utcDayLength,utcToTAITime,taiToUTCTime, -	parseTAIUTCDATFile+    parseTAIUTCDATFile ) where  import Data.Time.LocalTime@@ -37,10 +37,10 @@     )  instance NFData AbsoluteTime where-	rnf (MkAbsoluteTime a) = rnf a+    rnf (MkAbsoluteTime a) = rnf a  instance Show AbsoluteTime where-	show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently+    show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently  -- | The epoch of TAI, which is 1858-11-17 00:00:00 TAI. taiEpoch :: AbsoluteTime@@ -63,80 +63,80 @@ utcDayLength table day = realToFrac (86400 + (table (addDays 1 day)) - (table day))  dayStart :: LeapSecondTable -> Day -> AbsoluteTime-dayStart table day = MkAbsoluteTime	(realToFrac ((toModifiedJulianDay day) * 86400 + (table day)))+dayStart table day = MkAbsoluteTime    (realToFrac ((toModifiedJulianDay day) * 86400 + (table day)))  utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime utcToTAITime table (UTCTime day dtime) = MkAbsoluteTime (t + dtime) where-	MkAbsoluteTime t = dayStart table day+    MkAbsoluteTime t = dayStart table day  taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime taiToUTCTime table abstime = stable (ModifiedJulianDay (div' (unAbsoluteTime abstime) 86400)) where-	stable day = if (day == day') then UTCTime day dtime else stable day' where-		dayt = dayStart table day-		dtime = diffAbsoluteTime abstime dayt-		day' = addDays (div' dtime (utcDayLength table day)) day+    stable day = if (day == day') then UTCTime day dtime else stable day' where+        dayt = dayStart table day+        dtime = diffAbsoluteTime abstime dayt+        day' = addDays (div' dtime (utcDayLength table day)) day  -- | Parse the contents of a tai-utc.dat file. -- This does not do any kind of validation and will return a bad table for input -- not in the correct format. parseTAIUTCDATFile :: String -> LeapSecondTable parseTAIUTCDATFile ss = offsetlist 0 (parse (lines ss)) where-	offsetlist :: Integer -> [(Day,Integer)] -> LeapSecondTable-	offsetlist i [] _ = i-	offsetlist i ((d0,_):_) d | d < d0 = i-	offsetlist _ ((_,i0):xx) d = offsetlist i0 xx d-	-	parse :: [String] -> [(Day,Integer)]-	parse [] = []-	parse (a:as) = let-		ps = parse as-	 in case matchLine a of-		Just di -> di:ps-		Nothing -> ps-	-	matchLine :: String -> Maybe (Day,Integer)-	matchLine s = do-		check0S s-		(d,s') <- findJD s-		i <- findOffset s'-		return (d,i)-	-	-- a bit fragile-	check0S :: String -> Maybe ()-	check0S "X 0.0      S" = Just ()-	check0S [] = Nothing-	check0S (_:cs) = check0S cs-	-	findJD :: String -> Maybe (Day,String)-	findJD ('=':'J':'D':s) = do-		d <- getInteger '5' s-		return (ModifiedJulianDay (d - 2400000),s)-	findJD [] = Nothing-	findJD (_:cs) = findJD cs-	-	findOffset :: String -> Maybe Integer-	findOffset ('T':'A':'I':'-':'U':'T':'C':'=':s) = getInteger '0' s-	findOffset [] = Nothing-	findOffset (_:cs) = findOffset cs-	-	getInteger :: Char -> String -> Maybe Integer-	getInteger p s = do-		digits <- getDigits p s-		fromDigits 0 digits-	-	getDigits :: Char -> String -> Maybe String-	getDigits p (' ':s) = getDigits p s-	getDigits p (c:cs) | c >= '0' && c <= '9' = do-		s <- getDigits p cs-		return (c:s)-	getDigits p ('.':p1:_) = if p == p1 then Just [] else Nothing-	getDigits _ _ = Nothing-		-	-	fromDigits :: Integer -> String -> Maybe Integer-	fromDigits i [] = Just i-	fromDigits i (c:cs) | c >= '0' && c <= '9' = fromDigits ((i * 10) + (fromIntegral ((fromEnum c) - (fromEnum '0')))) cs-	fromDigits _ _ = Nothing+    offsetlist :: Integer -> [(Day,Integer)] -> LeapSecondTable+    offsetlist i [] _ = i+    offsetlist i ((d0,_):_) d | d < d0 = i+    offsetlist _ ((_,i0):xx) d = offsetlist i0 xx d++    parse :: [String] -> [(Day,Integer)]+    parse [] = []+    parse (a:as) = let+        ps = parse as+     in case matchLine a of+        Just di -> di:ps+        Nothing -> ps++    matchLine :: String -> Maybe (Day,Integer)+    matchLine s = do+        check0S s+        (d,s') <- findJD s+        i <- findOffset s'+        return (d,i)++    -- a bit fragile+    check0S :: String -> Maybe ()+    check0S "X 0.0      S" = Just ()+    check0S [] = Nothing+    check0S (_:cs) = check0S cs++    findJD :: String -> Maybe (Day,String)+    findJD ('=':'J':'D':s) = do+        d <- getInteger '5' s+        return (ModifiedJulianDay (d - 2400000),s)+    findJD [] = Nothing+    findJD (_:cs) = findJD cs++    findOffset :: String -> Maybe Integer+    findOffset ('T':'A':'I':'-':'U':'T':'C':'=':s) = getInteger '0' s+    findOffset [] = Nothing+    findOffset (_:cs) = findOffset cs++    getInteger :: Char -> String -> Maybe Integer+    getInteger p s = do+        digits <- getDigits p s+        fromDigits 0 digits++    getDigits :: Char -> String -> Maybe String+    getDigits p (' ':s) = getDigits p s+    getDigits p (c:cs) | c >= '0' && c <= '9' = do+        s <- getDigits p cs+        return (c:s)+    getDigits p ('.':p1:_) = if p == p1 then Just [] else Nothing+    getDigits _ _ = Nothing+++    fromDigits :: Integer -> String -> Maybe Integer+    fromDigits i [] = Just i+    fromDigits i (c:cs) | c >= '0' && c <= '9' = fromDigits ((i * 10) + (fromIntegral ((fromEnum c) - (fromEnum '0')))) cs+    fromDigits _ _ = Nothing  -- typical line format: -- 1972 JAN  1 =JD 2441317.5  TAI-UTC=  10.0       S + (MJD - 41317.) X 0.0      S
lib/Data/Time/Clock/UTC.hs view
@@ -1,19 +1,21 @@ {-# OPTIONS -fno-warn-unused-imports #-}+#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}+#endif #include "HsConfigure.h" -- #hide module Data.Time.Clock.UTC (-	-- * 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+    -- * 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 ) where  import Control.DeepSeq@@ -29,10 +31,10 @@ -- It consists of the day number, and a time offset from midnight. -- Note that if a day has a leap second added to it, it will have 86401 seconds. data UTCTime = UTCTime {-	-- | the day-	utctDay :: Day,-	-- | the time from midnight, 0 <= t < 86401s (because of leap-seconds)-	utctDayTime :: DiffTime+    -- | the day+    utctDay :: Day,+    -- | the time from midnight, 0 <= t < 86401s (because of leap-seconds)+    utctDayTime :: DiffTime } #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types@@ -43,15 +45,15 @@ #endif  instance NFData UTCTime where-	rnf (UTCTime d t) = d `deepseq` t `deepseq` ()+    rnf (UTCTime d t) = d `deepseq` t `deepseq` ()  instance Eq UTCTime where-	(UTCTime da ta) == (UTCTime db tb) = (da == db) && (ta == tb)+    (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+    compare (UTCTime da ta) (UTCTime db tb) = case (compare da db) of+        EQ -> compare ta tb+        cmp -> cmp  -- | This is a length of time, as measured by UTC. -- Conversion functions will treat it as seconds.@@ -74,46 +76,46 @@         rnf ndt = seq ndt ()  instance Enum NominalDiffTime where-	succ (MkNominalDiffTime a) = MkNominalDiffTime (succ a)-	pred (MkNominalDiffTime a) = MkNominalDiffTime (pred a)-	toEnum = MkNominalDiffTime . toEnum-	fromEnum (MkNominalDiffTime a) = fromEnum a-	enumFrom (MkNominalDiffTime a) = fmap MkNominalDiffTime (enumFrom a)-	enumFromThen (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromThen a b)-	enumFromTo (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromTo a b)-	enumFromThenTo (MkNominalDiffTime a) (MkNominalDiffTime b) (MkNominalDiffTime c) = fmap MkNominalDiffTime (enumFromThenTo a b c)+    succ (MkNominalDiffTime a) = MkNominalDiffTime (succ a)+    pred (MkNominalDiffTime a) = MkNominalDiffTime (pred a)+    toEnum = MkNominalDiffTime . toEnum+    fromEnum (MkNominalDiffTime a) = fromEnum a+    enumFrom (MkNominalDiffTime a) = fmap MkNominalDiffTime (enumFrom a)+    enumFromThen (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromThen a b)+    enumFromTo (MkNominalDiffTime a) (MkNominalDiffTime b) = fmap MkNominalDiffTime (enumFromTo a b)+    enumFromThenTo (MkNominalDiffTime a) (MkNominalDiffTime b) (MkNominalDiffTime c) = fmap MkNominalDiffTime (enumFromThenTo a b c)  instance Show NominalDiffTime where-	show (MkNominalDiffTime t) = (showFixed True t) ++ "s"+    show (MkNominalDiffTime t) = (showFixed True t) ++ "s"  -- necessary because H98 doesn't have "cunning newtype" derivation instance Num NominalDiffTime where-	(MkNominalDiffTime a) + (MkNominalDiffTime b) = MkNominalDiffTime (a + b)-	(MkNominalDiffTime a) - (MkNominalDiffTime b) = MkNominalDiffTime (a - b)-	(MkNominalDiffTime a) * (MkNominalDiffTime b) = MkNominalDiffTime (a * b)-	negate (MkNominalDiffTime a) = MkNominalDiffTime (negate a)-	abs (MkNominalDiffTime a) = MkNominalDiffTime (abs a)-	signum (MkNominalDiffTime a) = MkNominalDiffTime (signum a)-	fromInteger i = MkNominalDiffTime (fromInteger i)+    (MkNominalDiffTime a) + (MkNominalDiffTime b) = MkNominalDiffTime (a + b)+    (MkNominalDiffTime a) - (MkNominalDiffTime b) = MkNominalDiffTime (a - b)+    (MkNominalDiffTime a) * (MkNominalDiffTime b) = MkNominalDiffTime (a * b)+    negate (MkNominalDiffTime a) = MkNominalDiffTime (negate a)+    abs (MkNominalDiffTime a) = MkNominalDiffTime (abs a)+    signum (MkNominalDiffTime a) = MkNominalDiffTime (signum a)+    fromInteger i = MkNominalDiffTime (fromInteger i)  -- necessary because H98 doesn't have "cunning newtype" derivation instance Real NominalDiffTime where-	toRational (MkNominalDiffTime a) = toRational a+    toRational (MkNominalDiffTime a) = toRational a  -- necessary because H98 doesn't have "cunning newtype" derivation instance Fractional NominalDiffTime where-	(MkNominalDiffTime a) / (MkNominalDiffTime b) = MkNominalDiffTime (a / b)-	recip (MkNominalDiffTime a) = MkNominalDiffTime (recip a)-	fromRational r = MkNominalDiffTime (fromRational r)+    (MkNominalDiffTime a) / (MkNominalDiffTime b) = MkNominalDiffTime (a / b)+    recip (MkNominalDiffTime a) = MkNominalDiffTime (recip a)+    fromRational r = MkNominalDiffTime (fromRational r)  -- necessary because H98 doesn't have "cunning newtype" derivation instance RealFrac NominalDiffTime where-	properFraction (MkNominalDiffTime a) = (i,MkNominalDiffTime f) where-		(i,f) = properFraction a-	truncate (MkNominalDiffTime a) = truncate a-	round (MkNominalDiffTime a) = round a-	ceiling (MkNominalDiffTime a) = ceiling a-	floor (MkNominalDiffTime a) = floor a+    properFraction (MkNominalDiffTime a) = (i,MkNominalDiffTime f) where+        (i,f) = properFraction a+    truncate (MkNominalDiffTime a) = truncate a+    round (MkNominalDiffTime a) = round a+    ceiling (MkNominalDiffTime a) = ceiling a+    floor (MkNominalDiffTime a) = floor a  {-# RULES "realToFrac/DiffTime->NominalDiffTime"   realToFrac = \ dt -> MkNominalDiffTime (realToFrac dt)@@ -122,4 +124,3 @@ "realToFrac/NominalDiffTime->Pico"       realToFrac = \ (MkNominalDiffTime ps) -> ps "realToFrac/Pico->NominalDiffTime"       realToFrac = MkNominalDiffTime   #-}-
lib/Data/Time/Format.hs view
@@ -1,17 +1,22 @@ module Data.Time.Format-	(-	-- * UNIX-style formatting-	NumericPadOption,FormatTime(..),formatTime,-	module Data.Time.Format.Parse-	) where+    (+    -- * UNIX-style formatting+    NumericPadOption,FormatTime(..),formatTime,+    module Data.Time.Format.Parse+    ) where  import Data.Time.Format.Parse-import Data.Time.LocalTime++import Data.Time.LocalTime.TimeZone+import Data.Time.LocalTime.TimeOfDay+import Data.Time.LocalTime.LocalTime+import Data.Time.Calendar.Days+import Data.Time.Calendar.Gregorian import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate-import Data.Time.Calendar import Data.Time.Calendar.Private-import Data.Time.Clock+import Data.Time.Clock.Scale+import Data.Time.Clock.UTC import Data.Time.Clock.POSIX  import Data.Maybe@@ -20,15 +25,15 @@  -- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html> class FormatTime t where-	formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> t -> String)+    formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> t -> String)  formatChar :: (FormatTime t) => Char -> TimeLocale -> Maybe NumericPadOption -> t -> String formatChar '%' _ _ _ = "%" formatChar 't' _ _ _ = "\t" formatChar 'n' _ _ _ = "\n" formatChar c locale mpado t = case (formatCharacter c) of-	Just f -> f locale mpado t-	_ -> ""+    Just f -> f locale mpado t+    _ -> ""  -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'. --@@ -58,11 +63,11 @@ -- -- [@%Z@] timezone name ----- For 'LocalTime' (and 'ZonedTime' and 'UTCTime'):+-- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@) ----- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'):+-- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%R@] same as @%H:%M@ --@@ -96,11 +101,11 @@ -- For 'UTCTime' and 'ZonedTime': -- -- [@%s@] number of whole seconds since the Unix epoch. For times before--- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@ +-- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@ -- the decimals are positive, not negative. For example, 0.9 seconds -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@. ----- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'):+-- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%D@] same as @%m\/%d\/%y@ --@@ -108,7 +113,7 @@ -- -- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@) ----- [@%Y@] year, no padding. Note @%0y@ and @%_y@ pad to four chars+-- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars -- -- [@%y@] year of century, 0-padded to two chars, @00@ - @99@ --@@ -156,91 +161,94 @@ formatTime locale (c:cs) t = c:(formatTime locale cs t)  instance FormatTime LocalTime where-	formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale))-	formatCharacter c = case (formatCharacter c) of-		Just f -> Just (\locale mpado dt -> f locale mpado (localDay dt))-		Nothing -> case (formatCharacter c) of-			Just f -> Just (\locale mpado dt -> f locale mpado (localTimeOfDay dt))-			Nothing -> Nothing+    formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale))+    formatCharacter c = case (formatCharacter c) of+        Just f -> Just (\locale mpado dt -> f locale mpado (localDay dt))+        Nothing -> case (formatCharacter c) of+            Just f -> Just (\locale mpado dt -> f locale mpado (localTimeOfDay dt))+            Nothing -> Nothing  instance FormatTime TimeOfDay where-	-- Aggregate-	formatCharacter 'R' = Just (\locale _ -> formatTime locale "%H:%M")-	formatCharacter 'T' = Just (\locale _ -> formatTime locale "%H:%M:%S")-	formatCharacter 'X' = Just (\locale _ -> formatTime locale (timeFmt locale))-	formatCharacter 'r' = Just (\locale _ -> formatTime locale (time12Fmt locale))-	-- AM/PM-	formatCharacter 'P' = Just (\locale _ day -> map toLower ((if (todHour day) < 12 then fst else snd) (amPm locale)))-	formatCharacter 'p' = Just (\locale _ day -> (if (todHour day) < 12 then fst else snd) (amPm locale))-	-- Hour-	formatCharacter 'H' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todHour)-	formatCharacter 'I' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour)-	formatCharacter 'k' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . todHour)-	formatCharacter 'l' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour)-	-- Minute-	formatCharacter 'M' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todMin)-	-- Second-	formatCharacter 'S' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt) :: Int -> String) . truncate . todSec)-	formatCharacter 'q' = Just (\_ _ -> drop 1 . dropWhile (/='.') . showFixed False . todSec)-	formatCharacter 'Q' = Just (\_ _ -> dropWhile (/='.') . showFixed True . todSec)+    -- Aggregate+    formatCharacter 'R' = Just (\locale _ -> formatTime locale "%H:%M")+    formatCharacter 'T' = Just (\locale _ -> formatTime locale "%H:%M:%S")+    formatCharacter 'X' = Just (\locale _ -> formatTime locale (timeFmt locale))+    formatCharacter 'r' = Just (\locale _ -> formatTime locale (time12Fmt locale))+    -- AM/PM+    formatCharacter 'P' = Just (\locale _ day -> map toLower ((if (todHour day) < 12 then fst else snd) (amPm locale)))+    formatCharacter 'p' = Just (\locale _ day -> (if (todHour day) < 12 then fst else snd) (amPm locale))+    -- Hour+    formatCharacter 'H' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todHour)+    formatCharacter 'I' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour)+    formatCharacter 'k' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . todHour)+    formatCharacter 'l' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour)+    -- Minute+    formatCharacter 'M' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todMin)+    -- Second+    formatCharacter 'S' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt) :: Int -> String) . truncate . todSec)+    formatCharacter 'q' = Just (\_ _ -> drop 1 . dropWhile (/='.') . showFixed False . todSec)+    formatCharacter 'Q' = Just (\_ _ -> dropWhile (/='.') . showFixed True . todSec) -	-- Default-	formatCharacter _   = Nothing+    -- Default+    formatCharacter _   = Nothing  instance FormatTime ZonedTime where-	formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale))-	formatCharacter 's' = Just (\_ _ zt -> show (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer))-	formatCharacter c = case (formatCharacter c) of-		Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeToLocalTime dt))-		Nothing -> case (formatCharacter c) of-			Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeZone dt))-			Nothing -> Nothing+    formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale))+    formatCharacter 's' = Just (\_ _ zt -> show (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer))+    formatCharacter c = case (formatCharacter c) of+        Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeToLocalTime dt))+        Nothing -> case (formatCharacter c) of+            Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeZone dt))+            Nothing -> Nothing  instance FormatTime TimeZone where-	formatCharacter 'z' = Just (\_ opt -> timeZoneOffsetString' (fromMaybe (Just '0') opt))-	formatCharacter 'Z' = +    formatCharacter 'z' = Just (\_ opt -> timeZoneOffsetString' (fromMaybe (Just '0') opt))+    formatCharacter 'Z' =             Just (\_ opt z -> let n = timeZoneName z                            in if null n then timeZoneOffsetString' (fromMaybe (Just '0') opt) z else n)-	formatCharacter _ = Nothing+    formatCharacter _ = Nothing  instance FormatTime Day where-	-- Aggregate-	formatCharacter 'D' = Just (\locale _ -> formatTime locale "%m/%d/%y")-	formatCharacter 'F' = Just (\locale _ -> formatTime locale "%Y-%m-%d")-	formatCharacter 'x' = Just (\locale _ -> formatTime locale (dateFmt locale))+    -- Aggregate+    formatCharacter 'D' = Just (\locale _ -> formatTime locale "%m/%d/%y")+    formatCharacter 'F' = Just (\locale _ -> formatTime locale "%Y-%m-%d")+    formatCharacter 'x' = Just (\locale _ -> formatTime locale (dateFmt locale)) -	-- Year Count-	formatCharacter 'Y' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . fst . toOrdinalDate)-	formatCharacter 'y' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . fst . toOrdinalDate)-	formatCharacter 'C' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . fst . toOrdinalDate)-	-- Month of Year-	formatCharacter 'B' = Just (\locale _ -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)-	formatCharacter 'b' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)-	formatCharacter 'h' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)-	formatCharacter 'm' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,m,_) -> m) . toGregorian)-	-- Day of Month-	formatCharacter 'd' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,_,d) -> d) . toGregorian)-	formatCharacter 'e' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\(_,_,d) -> d) . toGregorian)-	-- Day of Year-	formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate)+    -- Year Count+    formatCharacter 'Y' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . fst . toOrdinalDate)+    formatCharacter 'y' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . fst . toOrdinalDate)+    formatCharacter 'C' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . fst . toOrdinalDate)+    -- Month of Year+    formatCharacter 'B' = Just (\locale _ -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)+    formatCharacter 'b' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)+    formatCharacter 'h' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian)+    formatCharacter 'm' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,m,_) -> m) . toGregorian)+    -- Day of Month+    formatCharacter 'd' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,_,d) -> d) . toGregorian)+    formatCharacter 'e' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\(_,_,d) -> d) . toGregorian)+    -- Day of Year+    formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate) -	-- ISO 8601 Week Date-	formatCharacter 'G' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . (\(y,_,_) -> y) . toWeekDate)-	formatCharacter 'g' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . (\(y,_,_) -> y) . toWeekDate)-	formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . (\(y,_,_) -> y) . toWeekDate)+    -- ISO 8601 Week Date+    formatCharacter 'G' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . (\(y,_,_) -> y) . toWeekDate)+    formatCharacter 'g' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . (\(y,_,_) -> y) . toWeekDate)+    formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . (\(y,_,_) -> y) . toWeekDate) -	formatCharacter 'V' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,w,_) -> w) . toWeekDate)-	formatCharacter 'u' = Just (\_ _ -> show . (\(_,_,d) -> d) . toWeekDate)+    formatCharacter 'V' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,w,_) -> w) . toWeekDate)+    formatCharacter 'u' = Just (\_ _ -> show . (\(_,_,d) -> d) . toWeekDate) -	-- Day of week-	formatCharacter 'a' = Just (\locale _ -> snd . ((wDays locale) !!) . snd . sundayStartWeek)-	formatCharacter 'A' = Just (\locale _ -> fst . ((wDays locale) !!) . snd . sundayStartWeek)-	formatCharacter 'U' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . sundayStartWeek)-	formatCharacter 'w' = Just (\_ _ -> show . snd . sundayStartWeek)-	formatCharacter 'W' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . mondayStartWeek)-	-	-- Default-	formatCharacter _   = Nothing+    -- Day of week+    formatCharacter 'a' = Just (\locale _ -> snd . ((wDays locale) !!) . snd . sundayStartWeek)+    formatCharacter 'A' = Just (\locale _ -> fst . ((wDays locale) !!) . snd . sundayStartWeek)+    formatCharacter 'U' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . sundayStartWeek)+    formatCharacter 'w' = Just (\_ _ -> show . snd . sundayStartWeek)+    formatCharacter 'W' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . mondayStartWeek) +    -- Default+    formatCharacter _   = Nothing+ instance FormatTime UTCTime where-	formatCharacter c = fmap (\f locale mpado t -> f locale mpado (utcToZonedTime utc t)) (formatCharacter c)+    formatCharacter c = fmap (\f locale mpado t -> f locale mpado (utcToZonedTime utc t)) (formatCharacter c)++instance FormatTime UniversalTime where+    formatCharacter c = fmap (\f locale mpado t -> f locale mpado (ut1ToLocalTime 0 t)) (formatCharacter c)
lib/Data/Time/Format/Locale.hs view
@@ -11,7 +11,8 @@     ) where -import Data.Time.LocalTime+import Data.Time.LocalTime.TimeZone+  data TimeLocale = TimeLocale {         -- |full and abbreviated week days, starting with Sunday
lib/Data/Time/Format/Parse.hs view
@@ -14,12 +14,18 @@     module Data.Time.Format.Locale     ) where +import Text.Read(readMaybe) import Data.Time.Clock.POSIX-import Data.Time.Clock-import Data.Time.Calendar+import Data.Time.Clock.Scale+import Data.Time.Clock.UTC+import Data.Time.Calendar.Days+import Data.Time.Calendar.Gregorian import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.WeekDate-import Data.Time.LocalTime+import Data.Time.Calendar.Private(clipValid)+import Data.Time.LocalTime.TimeZone+import Data.Time.LocalTime.TimeOfDay+import Data.Time.LocalTime.LocalTime  #if LANGUAGE_Rank2Types import Control.Monad@@ -62,7 +68,7 @@     buildTime :: TimeLocale -- ^ The time locale.               -> [(Char,String)] -- ^ Pairs of format characters and the                                  -- corresponding part of the input.-              -> t+              -> Maybe t  #if LANGUAGE_Rank2Types -- | Parses a time value given a format string.@@ -138,7 +144,11 @@              TimeLocale -- ^ Time locale.           -> String     -- ^ Format string           -> ReadP t-readPOnlyTime l f = liftM (buildTime l) (parseInput l (parseFormat l f))+readPOnlyTime l f = do+    mt <- liftM (buildTime l) (parseInput l (parseFormat l f))+    case mt of+        Just t -> return t+        Nothing -> pfail  {-# DEPRECATED parseTime "use \"parseTimeM True\" instead" #-} parseTime :: ParseTime t =>@@ -316,91 +326,194 @@ data WeekType = ISOWeek | SundayWeek | MondayWeek  instance ParseTime Day where-    buildTime l = buildDay . concatMap (uncurry f)-     where-      f c x =-        case c of-          -- %C: century (all but the last two digits of the year), 00 - 99-          'C' -> [Century (read x)]-          -- %f century (all but the last two digits of the year), 00 - 99-          'f' -> [Century (read x)]-          -- %Y: year-          'Y' -> let y = read x in [Century (y `div` 100), CenturyYear (y `mod` 100)]-          -- %G: year for Week Date format-          'G' -> let y = read x in [Century (y `div` 100), CenturyYear (y `mod` 100)]-          -- %y: last two digits of year, 00 - 99-          'y' -> [CenturyYear (read x)]-          -- %g: last two digits of year for Week Date format, 00 - 99-          'g' -> [CenturyYear (read x)]-          -- %B: month name, long form (fst from months locale), January - December-          'B' -> [YearMonth (1 + fromJust (elemIndex (up x) (map (up . fst) (months l))))]-          -- %b: month name, short form (snd from months locale), Jan - Dec-          'b' -> [YearMonth (1 + fromJust (elemIndex (up x) (map (up . snd) (months l))))]-          -- %m: month of year, leading 0 as needed, 01 - 12-          'm' -> [YearMonth (read x)]-          -- %d: day of month, leading 0 as needed, 01 - 31-          'd' -> [MonthDay (read x)]-          -- %e: day of month, leading space as needed, 1 - 31-          'e' -> [MonthDay (read x)]-          -- %V: week for Week Date format, 01 - 53-          'V' -> [YearWeek ISOWeek (read x)]-          -- %U: week number of year, where weeks start on Sunday (as sundayStartWeek), 01 - 53-          'U' -> [YearWeek SundayWeek (read x)]-          -- %W: week number of year, where weeks start on Monday (as mondayStartWeek), 01 - 53-          'W' -> [YearWeek MondayWeek (read x)]-          -- %u: day for Week Date format, 1 - 7-          'u' -> [WeekDay (read x)]-          -- %a: day of week, short form (snd from wDays locale), Sun - Sat-          'a' -> [WeekDay (1 + (fromJust (elemIndex (up x) (map (up . snd) (wDays l))) + 6) `mod` 7)]-          -- %A: day of week, long form (fst from wDays locale), Sunday - Saturday-          'A' -> [WeekDay (1 + (fromJust (elemIndex (up x) (map (up . fst) (wDays l))) + 6) `mod` 7)]-          -- %w: day of week number, 0 (= Sunday) - 6 (= Saturday)-          'w' -> [WeekDay (((read x + 6) `mod` 7) + 1)]-          -- %j: day of year for Ordinal Date format, 001 - 366-          'j' -> [YearDay (read x)]-          _   -> []+    buildTime l = let -      buildDay cs = rest cs-        where-        y = let+        -- '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 (up x) $ fmap up 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)+            y = let                 d = safeLast 70 [x | CenturyYear x <- cs]                 c = safeLast (if d >= 69 then 19 else 20) [x | Century x <- cs]-             in 100 * c + d+                in 100 * c + d+            rest (YearMonth m:_) = let+                d = safeLast 1 [x | MonthDay 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]+                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] -        rest (YearMonth m:_)  = let d = safeLast 1 [x | MonthDay x <- cs]-                             in fromGregorian y m d-        rest (YearDay d:_) = fromOrdinalDate y d-        rest (YearWeek wt w:_) = let d = safeLast 4 [x | WeekDay x <- cs]-                              in case wt of-                                   ISOWeek    -> fromWeekDate y w d-                                   SundayWeek -> fromSundayStartWeek y w (d `mod` 7)-                                   MondayWeek -> fromMondayStartWeek y w d-        rest (_:xs)        = rest xs-        rest []            = rest [YearMonth 1]+            in rest cs -      safeLast x xs = last (x:xs)+        in \pairs -> do+            components <- mapM (uncurry f) pairs+            buildDay $ concat components +mfoldl :: (Monad m) => (a -> b -> m a) -> m a -> [b] -> m a+mfoldl f = let+    mf ma b = do+        a <- ma+        f a b+    in foldl mf+ instance ParseTime TimeOfDay where-    buildTime l = foldl f midnight-        where-          f t@(TimeOfDay h m s) (c,x) =-              case c of-                'P' -> if up x == fst (amPm l) then am else pm-                'p' -> if up x == fst (amPm l) then am else pm-                'H' -> TimeOfDay (read x) m s-                'I' -> TimeOfDay (read x) m s-                'k' -> TimeOfDay (read x) m s-                'l' -> TimeOfDay (read x) m s-                'M' -> TimeOfDay h (read x) s-                'S' -> TimeOfDay h m (fromInteger (read x))-                'q' -> TimeOfDay h m (mkPico (truncate s) (read x))-                'Q' -> if null x then t-                        else let ps = read $ take 12 $ rpad 12 '0' $ drop 1 x-                              in TimeOfDay h m (mkPico (truncate s) ps)-                _   -> t-            where am = TimeOfDay (h `mod` 12) m s-                  pm = TimeOfDay (if h < 12 then h + 12 else h) m s+    buildTime l = let+        f t@(TimeOfDay h m s) (c,x) = let+            ra :: (Read a) => Maybe a+            ra = readMaybe x +            getAmPm = let+                upx = up 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++            in case c of+                'P' -> getAmPm+                'p' -> getAmPm+                'H' -> do+                    a <- ra+                    return $ TimeOfDay a m s+                'I' -> do+                    a <- ra+                    return $ TimeOfDay a m s+                'k' -> do+                    a <- ra+                    return $ TimeOfDay a m s+                'l' -> do+                    a <- ra+                    return $ TimeOfDay a m s+                'M' -> do+                    a <- ra+                    return $ TimeOfDay h a s+                'S' -> do+                    a <- ra+                    return $ TimeOfDay h m (fromInteger a)+                'q' -> do+                    a <- ra+                    return $ TimeOfDay h m (mkPico (truncate s) a)+                'Q' -> if null x then Just t else do+                    ps <- readMaybe $ take 12 $ rpad 12 '0' $ drop 1 x+                    return $ TimeOfDay h m (mkPico (truncate s) ps)+                _   -> Just t++        in mfoldl f (Just midnight)+ rpad :: Int -> a -> [a] -> [a] rpad n c xs = xs ++ replicate (n - length xs) c @@ -408,7 +521,7 @@ mkPico i f = fromInteger i + fromRational (f % 1000000000000)  instance ParseTime LocalTime where-    buildTime l xs = LocalTime (buildTime l xs) (buildTime l xs)+    buildTime l xs = LocalTime <$> (buildTime l xs) <*> (buildTime l xs)  enumDiff :: (Enum a) => a -> a -> Int enumDiff a b = (fromEnum a) - (fromEnum b)@@ -422,48 +535,63 @@ getMilZoneHours 'Z' = Just 0 getMilZoneHours _ = Nothing +getMilZone :: Char -> Maybe TimeZone+getMilZone c = let+    yc = toUpper c+    in do+        hours <- getMilZoneHours yc+        return $ TimeZone (hours * 60) False [yc]++getKnownTimeZone :: TimeLocale -> String -> Maybe TimeZone+getKnownTimeZone locale x = find (\tz -> up x == timeZoneName tz) (knownTimeZones locale)+ instance ParseTime TimeZone where-    buildTime l = foldl f (minutesToTimeZone 0)-      where-        f t@(TimeZone offset dst name) (c,x) =-            case c of-              'z' -> zone-              'Z' | null x           -> t-                  | isAlpha (head x) -> let y = up x in-                      case find (\tz -> y == timeZoneName tz) (knownTimeZones l) of-                        Just tz -> tz-                        Nothing -> case y of-                            [yc] | Just hours <- getMilZoneHours yc -> TimeZone (hours * 60) False y-                            _ -> TimeZone offset dst y-                  | otherwise        -> zone-              _   -> t-          where zone = TimeZone (readTzOffset x) dst name+    buildTime l = let+        f (TimeZone _ dst name) ('z',x) | Just offset <- readTzOffset x = TimeZone offset dst name+        f t ('Z',"") = t+        f _ ('Z',x) | Just zone <- getKnownTimeZone l x = zone+        f _ ('Z',[c]) | Just zone <- getMilZone c = zone+        f (TimeZone offset dst _) ('Z',x) | isAlpha (head x) = TimeZone offset dst (up x)+        f (TimeZone _ dst name) ('Z',x) | Just offset <- readTzOffset x = TimeZone offset dst name+        f t _ = t+        in Just . foldl f (minutesToTimeZone 0) -readTzOffset :: String -> Int-readTzOffset str =-    case str of-      (s:h1:h2:':':m1:m2:[]) -> calc s h1 h2 m1 m2-      (s:h1:h2:m1:m2:[]) -> calc s h1 h2 m1 m2-      _ -> 0-    where calc s h1 h2 m1 m2 = sign * (60 * h + m)-              where sign = if s == '-' then -1 else 1-                    h = read [h1,h2]-                    m = read [m1,m2]+readTzOffset :: String -> Maybe Int+readTzOffset str = let +    getSign '+' = Just 1+    getSign '-' = Just (-1)+    getSign _ = Nothing++    calc s h1 h2 m1 m2 = do+        sign <- getSign s+        h <- readMaybe [h1,h2]+        m <- readMaybe [m1,m2]+        return $ sign * (60 * h + m)++    in case str of+        (s:h1:h2:':':m1:m2:[]) -> calc s h1 h2 m1 m2+        (s:h1:h2:m1:m2:[]) -> calc s h1 h2 m1 m2+        _ -> Nothing+ instance ParseTime ZonedTime where-    buildTime l xs = foldl f (ZonedTime (buildTime l xs) (buildTime l xs)) xs-        where-          f t@(ZonedTime (LocalTime _ tod) z) (c,x) =-              case c of-                's' -> let s = fromInteger (read x)-                           (_,ps) = properFraction (todSec tod) :: (Integer,Pico)-                           s' = s + fromRational (toRational ps)-                        in utcToZonedTime z (posixSecondsToUTCTime s')-                _   -> t+    buildTime l xs = let+        f (ZonedTime (LocalTime _ tod) z) ('s',x) = do+            a <- readMaybe x+            let+                s = fromInteger a+                (_,ps) = properFraction (todSec tod) :: (Integer,Pico)+                s' = s + fromRational (toRational ps)+            return $ utcToZonedTime z (posixSecondsToUTCTime s')+        f t _ = Just t+        in mfoldl f (ZonedTime <$> (buildTime l xs) <*> (buildTime l xs)) xs  instance ParseTime UTCTime where-    buildTime l = zonedTimeToUTC . buildTime l+    buildTime l xs = zonedTimeToUTC <$> buildTime l xs +instance ParseTime UniversalTime where+    buildTime l xs = localTimeToUT1 0 <$> buildTime l xs+ -- * Read instances for time package types  #if LANGUAGE_Rank2Types@@ -485,5 +613,7 @@  instance Read UTCTime where     readsPrec n s = [ (zonedTimeToUTC t, r) | (t,r) <- readsPrec n s ]-#endif +instance Read UniversalTime where+    readsPrec n s = [ (localTimeToUT1 0 t, r) | (t,r) <- readsPrec n s ]+#endif
lib/Data/Time/LocalTime.hs view
@@ -1,10 +1,11 @@ module Data.Time.LocalTime (-	module Data.Time.LocalTime.TimeZone,-	module Data.Time.LocalTime.TimeOfDay,-	module Data.Time.LocalTime.LocalTime+    module Data.Time.LocalTime.TimeZone,+    module Data.Time.LocalTime.TimeOfDay,+    module Data.Time.LocalTime.LocalTime ) where +import Data.Time.Format() import Data.Time.LocalTime.TimeZone import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.LocalTime
lib/Data/Time/LocalTime/LocalTime.hs view
@@ -4,19 +4,25 @@ -- #hide module Data.Time.LocalTime.LocalTime (-	-- * Local Time-	LocalTime(..),+    -- * Local Time+    LocalTime(..), -	-- converting UTC and UT1 times to LocalTime-	utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1,-	-	ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime+    -- converting UTC and UT1 times to LocalTime+    utcToLocalTime,localTimeToUTC,ut1ToLocalTime,localTimeToUT1,++    ZonedTime(..),utcToZonedTime,zonedTimeToUTC,getZonedTime,utcToLocalZonedTime ) where  import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.TimeZone-import Data.Time.Calendar-import Data.Time.Clock+import Data.Time.Calendar.Days+import Data.Time.Calendar.Gregorian++import Data.Time.Clock.Scale+import Data.Time.Clock.UTCDiff+import Data.Time.Clock.UTC+import Data.Time.Clock.POSIX+ import Control.DeepSeq import Data.Typeable #if LANGUAGE_Rank2Types@@ -28,8 +34,8 @@ -- Conversion of this (as local civil time) to UTC depends on the time zone. -- Conversion of this (as local mean time) to UT1 depends on the longitude. data LocalTime = LocalTime {-	localDay    :: Day,-	localTimeOfDay   :: TimeOfDay+    localDay    :: Day,+    localTimeOfDay   :: TimeOfDay } deriving (Eq,Ord #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types@@ -41,36 +47,40 @@     )  instance NFData LocalTime where-	rnf (LocalTime d t) = d `deepseq` t `deepseq` ()+    rnf (LocalTime d t) = d `deepseq` t `deepseq` ()  instance Show LocalTime where-	show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t)+    show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t)  -- | show a UTC time in a given time zone as a LocalTime utcToLocalTime :: TimeZone -> UTCTime -> LocalTime utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod where-	(i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt)+    (i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt)  -- | find out what UTC time a given LocalTime in a given time zone is localTimeToUTC :: TimeZone -> LocalTime -> UTCTime localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC) where-	(i,todUTC) = localToUTCTimeOfDay tz tod+    (i,todUTC) = localToUTCTimeOfDay tz tod  -- | 1st arg is observation meridian in degrees, positive is East ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime ut1ToLocalTime long (ModJulianDate date) = LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset) where-	localTime = date + long / 360 :: Rational-	localMJD = floor localTime-	localToDOffset = localTime - (fromIntegral localMJD)	+    localTime = date + long / 360 :: Rational+    localMJD = floor localTime+    localToDOffset = localTime - (fromIntegral localMJD)  -- | 1st arg is observation meridian in degrees, positive is East localTimeToUT1 :: Rational -> LocalTime -> UniversalTime localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) = ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360)) +-- orphan instance+instance Show UniversalTime where+    show t = show (ut1ToLocalTime 0 t)+ -- | A local time together with a TimeZone. data ZonedTime = ZonedTime {-	zonedTimeToLocalTime :: LocalTime,-	zonedTimeZone :: TimeZone+    zonedTimeToLocalTime :: LocalTime,+    zonedTimeZone :: TimeZone } #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types@@ -81,7 +91,7 @@ #endif  instance NFData ZonedTime where-	rnf (ZonedTime lt z) = lt `deepseq` z `deepseq` ()+    rnf (ZonedTime lt z) = lt `deepseq` z `deepseq` ()  utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime utcToZonedTime zone time = ZonedTime (utcToLocalTime zone time) zone@@ -90,20 +100,20 @@ zonedTimeToUTC (ZonedTime t zone) = localTimeToUTC zone t  instance Show ZonedTime where-	show (ZonedTime t zone) = show t ++ " " ++ show zone+    show (ZonedTime t zone) = show t ++ " " ++ show zone  -- orphan instance instance Show UTCTime where-	show t = show (utcToZonedTime utc t)+    show t = show (utcToZonedTime utc t)  getZonedTime :: IO ZonedTime getZonedTime = do-	t <- getCurrentTime-	zone <- getTimeZone t-	return (utcToZonedTime zone t)+    t <- getCurrentTime+    zone <- getTimeZone t+    return (utcToZonedTime zone t)  -- | utcToLocalZonedTime :: UTCTime -> IO ZonedTime utcToLocalZonedTime t = do-	zone <- getTimeZone t-	return (utcToZonedTime zone t)+    zone <- getTimeZone t+    return (utcToZonedTime zone t)
lib/Data/Time/LocalTime/TimeOfDay.hs view
@@ -3,16 +3,16 @@ -- #hide module Data.Time.LocalTime.TimeOfDay (-	-- * Time of day-	TimeOfDay(..),midnight,midday,makeTimeOfDayValid,-	utcToLocalTimeOfDay,localToUTCTimeOfDay,-	timeToTimeOfDay,timeOfDayToTime,-	dayFractionToTimeOfDay,timeOfDayToDayFraction+    -- * Time of day+    TimeOfDay(..),midnight,midday,makeTimeOfDayValid,+    utcToLocalTimeOfDay,localToUTCTimeOfDay,+    timeToTimeOfDay,timeOfDayToTime,+    dayFractionToTimeOfDay,timeOfDayToDayFraction ) where  import Data.Time.LocalTime.TimeZone import Data.Time.Calendar.Private-import Data.Time.Clock+import Data.Time.Clock.Scale import Control.DeepSeq import Data.Typeable import Data.Fixed@@ -22,13 +22,13 @@  -- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day. data TimeOfDay = TimeOfDay {-	-- | range 0 - 23-	todHour    :: Int,-	-- | range 0 - 59-	todMin     :: Int,-	-- | Note that 0 <= todSec < 61, accomodating leap seconds.-	-- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously-	todSec     :: Pico+    -- | range 0 - 23+    todHour    :: Int,+    -- | range 0 - 59+    todMin     :: Int,+    -- | Note that 0 <= todSec < 61, accomodating leap seconds.+    -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously+    todSec     :: Pico } deriving (Eq,Ord #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types@@ -40,7 +40,7 @@     )  instance NFData TimeOfDay where-	rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `seq` () -- FIXME: Data.Fixed had no NFData instances yet at time of writing+    rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `seq` () -- FIXME: Data.Fixed had no NFData instances yet at time of writing  -- | Hour zero midnight :: TimeOfDay@@ -51,20 +51,20 @@ midday = TimeOfDay 12 0 0  instance Show TimeOfDay where-	show (TimeOfDay h m s) = (show2 (Just '0') h) ++ ":" ++ (show2 (Just '0') m) ++ ":" ++ (show2Fixed (Just '0') s)+    show (TimeOfDay h m s) = (show2 (Just '0') h) ++ ":" ++ (show2 (Just '0') m) ++ ":" ++ (show2Fixed (Just '0') s)  makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay makeTimeOfDayValid h m s = do-	_ <- clipValid 0 23 h-	_ <- clipValid 0 59 m-	_ <- clipValid 0 60.999999999999 s-	return (TimeOfDay h m s)+    _ <- clipValid 0 23 h+    _ <- clipValid 0 59 m+    _ <- clipValid 0 60.999999999999 s+    return (TimeOfDay h m s)  -- | Convert a ToD in UTC to a ToD in some timezone, together with a day adjustment. utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay) utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where-	m' = m + timeZoneMinutes zone-	h' = h + (div m' 60)+    m' = m + timeZoneMinutes zone+    h' = h + (div m' 60)  -- | Convert a ToD in some timezone to a ToD in UTC, together with a day adjustment. localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)@@ -78,11 +78,11 @@ timeToTimeOfDay :: DiffTime -> TimeOfDay timeToTimeOfDay dt | dt >= posixDayLength = TimeOfDay 23 59 (60 + (realToFrac (dt - posixDayLength))) timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) s where-	s' = realToFrac dt-	s = mod' s' 60-	m' = div' s' 60-	m = mod' m' 60-	h = div' m' 60+    s' = realToFrac dt+    s = mod' s' 60+    m' = div' s' 60+    m = mod' m' 60+    h = div' m' 60  -- | Find out how much time since midnight a given TimeOfDay is. timeOfDayToTime :: TimeOfDay -> DiffTime
lib/Data/Time/LocalTime/TimeZone.hs view
@@ -5,19 +5,19 @@ -- #hide module Data.Time.LocalTime.TimeZone (-	-- * Time zones-	TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc,+    -- * Time zones+    TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc, -	-- getting the locale time zone-	getTimeZone,getCurrentTimeZone+    -- getting the locale time zone+    getTimeZone,getCurrentTimeZone ) where  --import System.Time.Calendar.Format import Data.Time.Calendar.Private-import Data.Time.Clock import Data.Time.Clock.POSIX+import Data.Time.Clock.UTC -#if __GLASGOW_HASKELL__ >= 709+#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702 import Foreign #else import Foreign.Safe@@ -31,12 +31,12 @@  -- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag. data TimeZone = TimeZone {-	-- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.-	timeZoneMinutes :: Int,-	-- | Is this time zone just persisting for the summer?-	timeZoneSummerOnly :: Bool,-	-- | The name of the zone, typically a three- or four-letter acronym.-	timeZoneName :: String+    -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.+    timeZoneMinutes :: Int,+    -- | Is this time zone just persisting for the summer?+    timeZoneSummerOnly :: Bool,+    -- | The name of the zone, typically a three- or four-letter acronym.+    timeZoneName :: String } deriving (Eq,Ord #if LANGUAGE_DeriveDataTypeable #if LANGUAGE_Rank2Types@@ -46,7 +46,7 @@     )  instance NFData TimeZone where-	rnf (TimeZone m so n) = m `deepseq` so `deepseq` n `deepseq` ()+    rnf (TimeZone m so n) = m `deepseq` so `deepseq` n `deepseq` ()  -- | Create a nameless non-summer timezone for this number of minutes minutesToTimeZone :: Int -> TimeZone@@ -69,8 +69,8 @@ timeZoneOffsetString = timeZoneOffsetString' (Just '0')  instance Show TimeZone where-	show zone@(TimeZone _ _ "") = timeZoneOffsetString zone-	show (TimeZone _ _ name) = name+    show zone@(TimeZone _ _ "") = timeZoneOffsetString zone+    show (TimeZone _ _ name) = name  -- | The UTC time zone utc :: TimeZone@@ -85,15 +85,15 @@ -- | Get the local time-zone for a given time (varying as per summertime adjustments) getTimeZone :: UTCTime -> IO TimeZone getTimeZone time = with 0 (\pdst -> with nullPtr (\pcname -> do-	secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) 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)-	))+    secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) 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)+    ))  -- | Get the current time-zone getCurrentTimeZone :: IO TimeZone
lib/include/HsTimeConfig.h view
@@ -1,6 +1,9 @@ /* lib/include/HsTimeConfig.h.  Generated from HsTimeConfig.h.in by configure.  */ /* lib/include/HsTimeConfig.h.in.  Generated from configure.ac by autoheader.  */ +/* Define to 1 if you have the `clock_gettime' function. */+#define HAVE_CLOCK_GETTIME 1+ /* Define to 1 if you have the declaration of `altzone', and to 0 if you    don't. */ #define HAVE_DECL_ALTZONE 0
lib/include/HsTimeConfig.h.in view
@@ -1,5 +1,8 @@ /* lib/include/HsTimeConfig.h.in.  Generated from configure.ac by autoheader.  */ +/* Define to 1 if you have the `clock_gettime' function. */+#undef HAVE_CLOCK_GETTIME+ /* Define to 1 if you have the declaration of `altzone', and to 0 if you    don't. */ #undef HAVE_DECL_ALTZONE
test/Test/AddDays.hs view
@@ -6,35 +6,35 @@  days ::[Day] days =-	[-	fromGregorian 2005 2 28,-	fromGregorian 2004 2 29,-	fromGregorian 2004 1 31,-	fromGregorian 2004 12 31,-	fromGregorian 2005 7 1,-	fromGregorian 2005 4 21,-	fromGregorian 2005 6 30-	]+    [+    fromGregorian 2005 2 28,+    fromGregorian 2004 2 29,+    fromGregorian 2004 1 31,+    fromGregorian 2004 12 31,+    fromGregorian 2005 7 1,+    fromGregorian 2005 4 21,+    fromGregorian 2005 6 30+    ]  increments :: [Integer] increments = [-10,-4,-1,0,1,7,83]  adders :: [(String,Integer -> Day -> Day)] adders =-	[-	("day",addDays),-	("month (clip)",addGregorianMonthsClip),-	("month (roll over)",addGregorianMonthsRollOver),-	("year (clip)",addGregorianYearsClip),-	("year (roll over)",addGregorianYearsRollOver)-	]+    [+    ("day",addDays),+    ("month (clip)",addGregorianMonthsClip),+    ("month (roll over)",addGregorianMonthsRollOver),+    ("year (clip)",addGregorianYearsClip),+    ("year (roll over)",addGregorianYearsRollOver)+    ]  resultDays :: [String] resultDays = do-	(aname,adder) <- adders-	increment <- increments-	day <- days-	return ((showGregorian day) ++ " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day))+    (aname,adder) <- adders+    increment <- increments+    day <- days+    return ((showGregorian day) ++ " + " ++ (show increment) ++ " * " ++ aname ++ " = " ++ showGregorian (adder increment day))  addDaysTest :: Test addDaysTest = pureTest "addDays" $
test/Test/ClipDates.hs view
@@ -31,16 +31,16 @@  clipDates :: Test clipDates = pureTest "clipDates" $-    let -        yad  = unlines $ map yearAndDay $ +    let+        yad  = unlines $ map yearAndDay $             tupleUp2 [1968,1969,1971] [-4,0,1,200,364,365,366,367,700]-                               -        greg = unlines $ map gregorian $ ++        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 $ +        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 diff clipDatesRef $ +    in diff clipDatesRef $         concat [ "YearAndDay\n", yad, "Gregorian\n", greg, "ISOWeekDay\n", iso ]
test/Test/ClipDatesRef.hs view
@@ -2,7 +2,7 @@  clipDatesRef :: String clipDatesRef =- unlines + unlines   [ "YearAndDay"   , "1968--4 = 1968-001"   , "1968-0 = 1968-001"
test/Test/ConvertBack.hs view
@@ -7,23 +7,23 @@ import Test.TestUtil  checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String-checkDay encodeDay decodeDay decodeDayValid day-  = let st    = encodeDay day-	day'  = decodeDay st-	mday' = decodeDayValid st+checkDay encodeDay decodeDay decodeDayValid day = let+    st    = encodeDay day+    day'  = decodeDay st+    mday' = decodeDayValid st -	a = if day /= day'-	      then unwords [ show day, "-> "+    a = if day /= day'+          then unwords [ show day, "-> "                            , show st,  "-> "                            , show day'                            , "(diff", show (diffDays day' day) ++ ")" ]-	      else ""+          else "" -	b = if Just day /= mday'-	      then unwords [show day, "->", show st, "->", show mday']-	      else ""+    b = if Just day /= mday'+          then unwords [show day, "->", show st, "->", show mday']+          else ""     in a ++ b-		+ checkers :: [Day -> String] checkers   = [ checkDay toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d)@@ -33,7 +33,7 @@  days :: [Day] days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++-	(fmap (\year -> (fromGregorian year 1 4)) [1980..2000])+    (fmap (\year -> (fromGregorian year 1 4)) [1980..2000])  convertBack :: Test convertBack = pureTest "convertBack" $
test/Test/LongWeekYears.hs view
@@ -7,8 +7,8 @@  longYear :: Integer -> Bool longYear year = case toWeekDate (fromGregorian year 12 31) of-	(_,53,_) -> True-	_ -> False+    (_,53,_) -> True+    _ -> False  showLongYear :: Integer -> String showLongYear year
test/Test/TAI_UTC_DAT.hs view
@@ -2,7 +2,7 @@  taiUTC_DAT :: String taiUTC_DAT =-  unlines +  unlines   [ "1961 JAN  1 =JD 2437300.5  TAI-UTC=   1.4228180 S + (MJD - 37300.) X 0.001296 S"   , "1961 AUG  1 =JD 2437512.5  TAI-UTC=   1.3728180 S + (MJD - 37300.) X 0.001296 S"   , "1962 JAN  1 =JD 2437665.5  TAI-UTC=   1.8458580 S + (MJD - 37665.) X 0.0011232S"
test/Test/TestCalendars.hs view
@@ -8,23 +8,23 @@  showers :: [(String,Day -> String)] showers = [-	("MJD",show . toModifiedJulianDay),-	("Gregorian",showGregorian),-	("Julian",showJulian),-	("ISO 8601",showWeekDate)-	]+    ("MJD",show . toModifiedJulianDay),+    ("Gregorian",showGregorian),+    ("Julian",showJulian),+    ("ISO 8601",showWeekDate)+    ]  days :: [Day] days = [-	fromGregorian 0 12 31,-	fromJulian 1752 9 2,-	fromGregorian 1752 9 14,-	fromGregorian 2005 1 23-	]+    fromGregorian 0 12 31,+    fromJulian 1752 9 2,+    fromGregorian 1752 9 14,+    fromGregorian 2005 1 23+    ]  testCalendars :: Test testCalendars = pureTest "testCalendars" $     diff testCalendarsRef $ unlines $ map (\d -> showShowers d) days   where-    showShowers day = +    showShowers day =         concatMap (\(nm,shower) -> unwords [" ==", nm, shower day]) showers
test/Test/TestEaster.hs view
@@ -18,7 +18,7 @@ showWithWDay = formatTime defaultTimeLocale "%F %A"  testEaster :: Test-testEaster = pureTest "testEaster" $ let +testEaster = pureTest "testEaster" $ let     ds = unlines $ map (\day ->                    unwords [ showWithWDay day, "->"                            , showWithWDay (sundayAfter day)]) days
test/Test/TestFormat.hs view
@@ -11,29 +11,29 @@ import Test.TestUtil  {--	size_t format_time (-	char *s, size_t maxsize,-	const char *format,-	int isdst,int gmtoff,time_t t);+    size_t format_time (+    char *s, size_t maxsize,+    const char *format,+    int isdst,int gmtoff,time_t t); -}  foreign import ccall unsafe "TestFormatStuff.h format_time" format_time :: CString -> CSize -> CString -> CInt -> CInt -> CString -> CTime -> IO CSize  withBuffer :: Int -> (CString -> IO CSize) -> IO String withBuffer n f = withArray (replicate n 0) (\buffer -> do-			len <- f buffer-			peekCStringLen (buffer,fromIntegral len)-		)+            len <- f buffer+            peekCStringLen (buffer,fromIntegral len)+        )  unixFormatTime :: String -> TimeZone -> UTCTime -> IO String unixFormatTime fmt zone time = withCString fmt (\pfmt -> withCString (timeZoneName zone) (\pzonename ->-		withBuffer 100 (\buffer -> format_time buffer 100 pfmt-				(if timeZoneSummerOnly zone then 1 else 0)-				(fromIntegral (timeZoneMinutes zone * 60))-				pzonename-				(fromInteger (truncate (utcTimeToPOSIXSeconds time)))-			)-		))+        withBuffer 100 (\buffer -> format_time buffer 100 pfmt+                (if timeZoneSummerOnly zone then 1 else 0)+                (fromIntegral (timeZoneMinutes zone * 60))+                pzonename+                (fromInteger (truncate (utcTimeToPOSIXSeconds time)))+            )+        ))  locale :: TimeLocale locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"}@@ -67,7 +67,7 @@  times :: [UTCTime] times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++-	(fmap getYearP1 years) ++ (fmap getYearP2 years) ++ (fmap getYearP3 years) ++ (fmap getYearP4 years)+    (fmap getYearP1 years) ++ (fmap getYearP2 years) ++ (fmap getYearP3 years) ++ (fmap getYearP4 years)  padN :: Int -> Char -> String -> String padN n _ s | n <= (length s) = s@@ -144,10 +144,10 @@  class (ParseTime t) => TestParse t where     expectedParse :: String -> String -> Maybe t-    expectedParse "%Z" "" = Just (buildTime defaultTimeLocale [])-    expectedParse "%_Z" "" = Just (buildTime defaultTimeLocale [])-    expectedParse "%-Z" "" = Just (buildTime defaultTimeLocale [])-    expectedParse "%0Z" "" = Just (buildTime defaultTimeLocale [])+    expectedParse "%Z" "" = buildTime defaultTimeLocale []+    expectedParse "%_Z" "" = buildTime defaultTimeLocale []+    expectedParse "%-Z" "" = buildTime defaultTimeLocale []+    expectedParse "%0Z" "" = buildTime defaultTimeLocale []     expectedParse _ _ = Nothing  instance TestParse Day
test/Test/TestFormatStuff.c view
@@ -1,15 +1,15 @@ #include "TestFormatStuff.h"  size_t format_time (-	char* buffer, size_t maxsize,-	const char* format,-	int isdst,int gmtoff,char* zonename,time_t t)+    char* buffer, size_t maxsize,+    const char* format,+    int isdst,int gmtoff,char* zonename,time_t t) {-	t += gmtoff;-	struct tm tmd;-	gmtime_r(&t,&tmd);-	tmd.tm_isdst = isdst;-	tmd.tm_gmtoff = gmtoff;-	tmd.tm_zone = zonename;-	return strftime(buffer,maxsize,format,&tmd);+    t += gmtoff;+    struct tm tmd;+    gmtime_r(&t,&tmd);+    tmd.tm_isdst = isdst;+    tmd.tm_gmtoff = gmtoff;+    tmd.tm_zone = zonename;+    return strftime(buffer,maxsize,format,&tmd); }
test/Test/TestFormatStuff.h view
@@ -1,6 +1,6 @@ #include <time.h>  size_t format_time (-	char *s, size_t maxsize,-	const char *format,-	int isdst,int gmtoff,char* zonename,time_t t);+    char *s, size_t maxsize,+    const char *format,+    int isdst,int gmtoff,char* zonename,time_t t);
test/Test/TestMonthDay.hs view
@@ -13,8 +13,8 @@     diff testMonthDayRef $ concat $ map (\isL -> unlines (leap isL : yearDays isL)) [False,True]     where         leap isLeap = if isLeap then "Leap:" else "Regular:"-        yearDays isLeap = -            map (\yd -> let +        yearDays isLeap =+            map (\yd -> let                 (m,d)  = dayOfYearToMonthAndDay isLeap yd                 yd'    = monthAndDayToDayOfYear isLeap m d                 mdtext = show m ++ "-" ++ show d
test/Test/TestParseDAT.hs view
@@ -8,38 +8,38 @@  tods :: [TimeOfDay] tods = [-	TimeOfDay 0 0 0,-	TimeOfDay 0 0 0.5,-	TimeOfDay 0 0 1,-	TimeOfDay 0 0 1.5,-	TimeOfDay 0 0 2,-	TimeOfDay 23 59 28,-	TimeOfDay 23 59 28.5,-	TimeOfDay 23 59 29,-	TimeOfDay 23 59 29.5,-	TimeOfDay 23 59 30,-	TimeOfDay 23 59 30.5,-	TimeOfDay 23 59 31,-	TimeOfDay 23 59 31.5,-	TimeOfDay 23 59 32,-	TimeOfDay 23 59 59,-	TimeOfDay 23 59 59.5,-	TimeOfDay 23 59 60,-	TimeOfDay 23 59 60.5-	]+    TimeOfDay 0 0 0,+    TimeOfDay 0 0 0.5,+    TimeOfDay 0 0 1,+    TimeOfDay 0 0 1.5,+    TimeOfDay 0 0 2,+    TimeOfDay 23 59 28,+    TimeOfDay 23 59 28.5,+    TimeOfDay 23 59 29,+    TimeOfDay 23 59 29.5,+    TimeOfDay 23 59 30,+    TimeOfDay 23 59 30.5,+    TimeOfDay 23 59 31,+    TimeOfDay 23 59 31.5,+    TimeOfDay 23 59 32,+    TimeOfDay 23 59 59,+    TimeOfDay 23 59 59.5,+    TimeOfDay 23 59 60,+    TimeOfDay 23 59 60.5+    ]  times :: [LocalTime] times =-	fmap (LocalTime (fromGregorian 1998 04 02)) tods ++-	fmap (LocalTime (fromGregorian 1998 12 30)) tods ++-	fmap (LocalTime (fromGregorian 1998 12 31)) tods ++-	fmap (LocalTime (fromGregorian 1999 01 01)) tods ++-	fmap (LocalTime (fromGregorian 1999 01 02)) tods+    fmap (LocalTime (fromGregorian 1998 04 02)) tods +++    fmap (LocalTime (fromGregorian 1998 12 30)) tods +++    fmap (LocalTime (fromGregorian 1998 12 31)) tods +++    fmap (LocalTime (fromGregorian 1999 01 01)) tods +++    fmap (LocalTime (fromGregorian 1999 01 02)) tods  testParseDAT :: Test testParseDAT = pureTest "testParseDAT" $ diff testParseDAT_Ref parseDAT where-    parseDAT = -        let lst = parseTAIUTCDATFile taiUTC_DAT in +    parseDAT =+        let lst = parseTAIUTCDATFile taiUTC_DAT in         unlines $ map         (\lt ->             let
test/Test/TestParseTime.hs view
@@ -11,7 +11,7 @@ import Data.Time.Calendar.WeekDate import Data.Time.Clock.POSIX import Test.QuickCheck hiding (Result,reason)-import Test.QuickCheck.Property hiding (result)+import Test.QuickCheck.Property import Test.TestUtil hiding (Result)  ntest :: Int@@ -286,6 +286,13 @@ instance CoArbitrary UTCTime where     coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds t) :: Integer) +instance Arbitrary UniversalTime where+    arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) where -- 1000-01-1 to 9999-12-31+        k = 86400++instance CoArbitrary UniversalTime where+    coarbitrary (ModJulianDate d) = coarbitrary d+ -- missing from the time package instance Eq ZonedTime where     ZonedTime t1 tz1 == ZonedTime t2 tz2 = t1 == t2 && tz1 == tz2@@ -438,7 +445,8 @@      ("prop_read_show LocalTime", property (prop_read_show :: LocalTime -> Result)),      ("prop_read_show TimeZone", property (prop_read_show :: TimeZone -> Result)),      ("prop_read_show ZonedTime", property (prop_read_show :: ZonedTime -> Result)),-     ("prop_read_show UTCTime", property (prop_read_show :: UTCTime -> Result))]+     ("prop_read_show UTCTime", property (prop_read_show :: UTCTime -> Result)),+     ("prop_read_show UniversalTime", property (prop_read_show :: UniversalTime -> Result))]  ++ [("prop_parse_showWeekDate", property prop_parse_showWeekDate),      ("prop_parse_showGregorian", property prop_parse_showGregorian),      ("prop_parse_showOrdinalDate", property prop_parse_showOrdinalDate)]@@ -449,6 +457,7 @@  ++ map (prop_parse_format_named "TimeZone") timeZoneFormats  ++ map (prop_parse_format_named "ZonedTime") zonedTimeFormats  ++ map (prop_parse_format_named "UTCTime") utcTimeFormats+ ++ map (prop_parse_format_named "UniversalTime") universalTimeFormats   ++ map (prop_parse_format_upper_named "Day") dayFormats  ++ map (prop_parse_format_upper_named "TimeOfDay") timeOfDayFormats@@ -456,6 +465,7 @@  ++ map (prop_parse_format_upper_named "TimeZone") timeZoneFormats  ++ map (prop_parse_format_upper_named "ZonedTime") zonedTimeFormats  ++ map (prop_parse_format_upper_named "UTCTime") utcTimeFormats+ ++ map (prop_parse_format_upper_named "UniversalTime") universalTimeFormats   ++ map (prop_parse_format_lower_named "Day") dayFormats  ++ map (prop_parse_format_lower_named "TimeOfDay") timeOfDayFormats@@ -463,12 +473,14 @@  ++ map (prop_parse_format_lower_named "TimeZone") timeZoneFormats  ++ map (prop_parse_format_lower_named "ZonedTime") zonedTimeFormats  ++ map (prop_parse_format_lower_named "UTCTime") utcTimeFormats+ ++ map (prop_parse_format_lower_named "UniversalTime") universalTimeFormats   ++ map (prop_format_parse_format_named "Day") partialDayFormats  ++ map (prop_format_parse_format_named "TimeOfDay") partialTimeOfDayFormats  ++ map (prop_format_parse_format_named "LocalTime") partialLocalTimeFormats  ++ map (prop_format_parse_format_named "ZonedTime") partialZonedTimeFormats  ++ map (prop_format_parse_format_named "UTCTime") partialUTCTimeFormats+ ++ map (prop_format_parse_format_named "UniversalTime") partialUniversalTimeFormats   ++ map (prop_no_crash_bad_input_named "Day") (dayFormats ++ partialDayFormats ++ failingPartialDayFormats)  ++ map (prop_no_crash_bad_input_named "TimeOfDay") (timeOfDayFormats ++ partialTimeOfDayFormats)@@ -476,6 +488,7 @@  ++ map (prop_no_crash_bad_input_named "TimeZone") (timeZoneFormats)  ++ map (prop_no_crash_bad_input_named "ZonedTime") (zonedTimeFormats ++ partialZonedTimeFormats)  ++ map (prop_no_crash_bad_input_named "UTCTime") (utcTimeFormats ++ partialUTCTimeFormats)+ ++ map (prop_no_crash_bad_input_named "UniversalTime") (universalTimeFormats ++ partialUniversalTimeFormats)   @@ -528,6 +541,9 @@ utcTimeFormats = map FormatString   ["%s.%q","%s%Q"] +universalTimeFormats :: [FormatString UniversalTime]+universalTimeFormats = map FormatString []+ -- -- * Formats that do not include all the information --@@ -561,6 +577,10 @@      -- %c does not include second decimals      "%c"     ]++partialUniversalTimeFormats :: [FormatString UniversalTime]+partialUniversalTimeFormats = map FormatString+    [ ]   --
test/Test/TestTime.hs view
@@ -12,26 +12,26 @@         (y,m,d) = toGregorian date         date' = fromGregorian y m d     in concat [ show mjd ++ "="-                 ++ showGregorian date ++ "=" +                 ++ showGregorian date ++ "="                  ++ showOrdinalDate date ++ "="                  ++ showWeekDate date                  ++ "\n"                 , if date == date'-                   then "" +                   then ""                    else "=" ++ (show $ toModifiedJulianDay date') ++ "!" ]  testCal :: String testCal   = concat         -- days around 1 BCE/1 CE-      [ concatMap showCal [-678950 .. -678930]	+      [ concatMap showCal [-678950 .. -678930]          -- days around 1000 CE-      , concatMap showCal [-313710 .. -313690]	+      , concatMap showCal [-313710 .. -313690]          -- days around MJD zero-      , concatMap showCal [-30..30]	+      , concatMap showCal [-30..30]       , showCal 40000       , showCal 50000 @@ -73,10 +73,10 @@   = let lsMineCal = utcToLocalTime myzone leapSec1998         lsMine = localTimeToUTC myzone lsMineCal     in unlines [ showCal 51178-	       , show leapSec1998Cal-	       , showUTCTime leapSec1998-	       , show lsMineCal-	       , showUTCTime lsMine ]+           , show leapSec1998Cal+           , showUTCTime leapSec1998+           , show lsMineCal+           , showUTCTime lsMine ]  neglong :: Rational neglong = -120
test/Test/TestTimeRef.hs view
@@ -1,7 +1,7 @@ module Test.TestTimeRef where  testTimeRef :: String-testTimeRef = +testTimeRef =   unlines [   "-678950=-0001-12-23=-0001-357=-0001-W51-4"   ,"-678949=-0001-12-24=-0001-358=-0001-W51-5"
+ test/Test/TestTimeZone.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS -Wall -Werror #-}++module Test.TestTimeZone where++import Data.Time+import System.Posix.Env (putEnv)+import Test.TestUtil++testTimeZone :: Test+testTimeZone = ioTest "getTimeZone respects TZ env var" $ do+  putEnv "TZ=UTC+0"+  zone1 <- getTimeZone epoch+  putEnv "TZ=EST+5"+  zone2 <- getTimeZone epoch+  return $ diff False (zone1 == zone2)+ where+  epoch = UTCTime (ModifiedJulianDay 0) 0
+ test/Test/TestValid.hs view
@@ -0,0 +1,61 @@+module Test.TestValid where++import Data.Time+import Data.Time.Calendar.OrdinalDate+import Data.Time.Calendar.WeekDate+import Data.Time.Calendar.Julian+import Test.QuickCheck hiding (Result,reason)+import Test.QuickCheck.Property+import Test.TestUtil hiding (Result)+++validResult :: (Eq c,Show c,Eq t,Show t) =>+    Bool -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> c -> Result+validResult valid toComponents fromComponents fromComponentsValid c = let+    mt = fromComponentsValid c+    t' = fromComponents c+    c' = toComponents t'+    in if valid then+        case mt of+            Nothing -> rejected+            Just t -> if t' /= t+                then failed {reason = "'fromValid' gives " ++ show t ++ ", but 'from' gives " ++ show t'}+                else if c' /= c+                then failed {reason = "found valid, but converts " ++ show c ++ " -> " ++ show t' ++ " -> " ++ show c'}+                else succeeded+        else case mt of+            Nothing -> if c' /= c+                then succeeded+                else failed {reason = show c ++ " found invalid, but converts with " ++ show t'}+            Just _ -> rejected++validTest :: (Arbitrary c,Eq c,Show c,Eq t,Show t) =>+    String -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> Test+validTest name toComponents fromComponents fromComponentsValid = testGroup name+    [+    testProperty "valid" $ property $ validResult True toComponents fromComponents fromComponentsValid,+    testProperty "invalid" $ property $ validResult False toComponents fromComponents fromComponentsValid+    ]++toSundayStartWeek :: Day -> (Integer,Int,Int)+toSundayStartWeek day = let+    (y,_) = toOrdinalDate day+    (m,d) = sundayStartWeek day+    in (y,m,d)++toMondayStartWeek :: Day -> (Integer,Int,Int)+toMondayStartWeek day = let+    (y,_) = toOrdinalDate day+    (m,d) = mondayStartWeek day+    in (y,m,d)++testValid :: Test+testValid = testGroup "testValid"+    [+    validTest "Gregorian" toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d),+    validTest "OrdinalDate" toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d),+    validTest "WeekDate" toWeekDate (\(y,m,d) -> fromWeekDate y m d) (\(y,m,d) -> fromWeekDateValid y m d),+    validTest "SundayStartWeek" toSundayStartWeek (\(y,m,d) -> fromSundayStartWeek y m d) (\(y,m,d) -> fromSundayStartWeekValid y m d),+    validTest "MondayStartWeek" toMondayStartWeek (\(y,m,d) -> fromMondayStartWeek y m d) (\(y,m,d) -> fromMondayStartWeekValid y m d),+    validTest "Julian" toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d)+    ]
test/Test/Tests.hs view
@@ -14,6 +14,7 @@ import Test.TestParseTime import Test.TestTime import Test.TestTimeZone+import Test.TestValid  tests :: [Test] tests = [ addDaysTest@@ -27,4 +28,5 @@         , testParseDAT         , testParseTime         , testTime-        , testTimeZone ]+        , testTimeZone+        , testValid ]
time.cabal view
@@ -1,5 +1,5 @@ name:           time-version:        1.5.0.1+version:        1.6 stability:      stable license:        BSD3 license-file:   LICENSE@@ -11,10 +11,11 @@ description:    A time library category:       System build-type:     Configure-cabal-version:  >=1.14+cabal-version:  >=1.10 x-follows-version-policy:  extra-source-files:+    changelog.md     aclocal.m4     configure.ac     configure@@ -30,15 +31,11 @@     lib/include/HsTimeConfig.h  source-repository head-  type:     git-  location: https://github.com/haskell/time+    type:     git+    location: https://github.com/haskell/time  library     hs-source-dirs: lib-    build-depends:-        base >= 4.4 && < 5,-        deepseq >= 1.1-    ghc-options: -Wall     default-language: Haskell2010     if impl(ghc)         default-extensions:@@ -50,6 +47,10 @@         if impl(hugs)             default-extensions: Rank2Types             cpp-options: -DLANGUAGE_Rank2Types+    ghc-options: -Wall -fwarn-tabs+    build-depends:+        base >= 4.3 && < 5,+        deepseq >= 1.1     if os(windows)         build-depends: Win32     exposed-modules:@@ -75,6 +76,7 @@         Data.Time.Clock.Scale,         Data.Time.Clock.UTC,         Data.Time.Clock.CTimeval,+        Data.Time.Clock.CTimespec,         Data.Time.Clock.UTCDiff,         Data.Time.LocalTime.TimeZone,         Data.Time.LocalTime.TimeOfDay,@@ -91,16 +93,18 @@             HsTimeConfig.h  test-suite ShowDefaultTZAbbreviations-    hs-source-dirs: test     type: exitcode-stdio-1.0+    hs-source-dirs: test+    default-language: Haskell2010+    ghc-options: -Wall -fwarn-tabs     build-depends:         base,-        time == 1.5.0.1+        time == 1.6     main-is: ShowDefaultTZAbbreviations.hs  test-suite tests-    hs-source-dirs: test     type: exitcode-stdio-1.0+    hs-source-dirs: test     default-language: Haskell2010     default-extensions:         Rank2Types@@ -112,12 +116,12 @@         FlexibleInstances         UndecidableInstances         ScopedTypeVariables-    ghc-options: -Wall+    ghc-options: -Wall -fwarn-tabs     c-sources: test/Test/TestFormatStuff.c     build-depends:         base,         deepseq,-        time == 1.5.0.1,+        time == 1.6,         QuickCheck >= 2.5.1,         test-framework >= 0.8,         test-framework-quickcheck2 >= 0.3,@@ -138,6 +142,8 @@         Test.TestEasterRef         Test.TestCalendars         Test.TestCalendarsRef+        Test.TestTimeZone+        Test.TestValid         Test.LongWeekYears         Test.LongWeekYearsRef         Test.ConvertBack@@ -146,4 +152,3 @@         Test.AddDays         Test.AddDaysRef         Test.TestUtil-