From 1ca245b63dcb9b409be9ecc2b034b821d24af8f9 Mon Sep 17 00:00:00 2001
From: Ashley Yakeley <ashley@yakeley.org>
Date: Sat, 21 Feb 2015 03:09:37 -0800
Subject: [PATCH] instance FormatTime UniversalTime; instance ParseTime
UniversalTime; instance Read UniversalTime
---
lib/Data/Time/Clock/Scale.hs | 3 +++
lib/Data/Time/Format.hs | 9 ++++++---
lib/Data/Time/Format/Parse.hs | 6 ++++++
test/Test/TestParseTime.hs | 22 +++++++++++++++++++++-
4 files changed, 36 insertions(+), 4 deletions(-)
diff --git a/lib/Data/Time/Clock/Scale.hs b/lib/Data/Time/Clock/Scale.hs
index c511829..8700e32 100644
--- a/lib/Data/Time/Clock/Scale.hs
+++ b/lib/Data/Time/Clock/Scale.hs
@@ -24,6 +24,9 @@ import Data.Data
-- | The Modified Julian Date is the day with the fraction of the day, measured from UT midnight.
-- It's used to represent UT1, which is time as measured by the earth's rotation, adjusted for various wobbles.
--
+-- For the 'Read' instance of 'UniversalTime',
+-- import "Data.Time" or "Data.Time.Format".
+--
-- For the 'Show' instance of 'UniversalTime',
-- import "Data.Time" or "Data.Time.LocalTime".
newtype UniversalTime = ModJulianDate {getModJulianDate :: Rational} deriving (Eq,Ord
diff --git a/lib/Data/Time/Format.hs b/lib/Data/Time/Format.hs
index d9f0050..e3fe96b 100644
--- a/lib/Data/Time/Format.hs
+++ b/lib/Data/Time/Format.hs
@@ -58,11 +58,11 @@ formatChar c locale mpado t = case (formatCharacter c) of
--
-- [@%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@
--
@@ -100,7 +100,7 @@ formatChar c locale mpado t = case (formatCharacter c) of
-- 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@
--
@@ -244,3 +244,6 @@ instance FormatTime Day where
instance FormatTime UTCTime where
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)
diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs
index 07dc5b2..0bd698d 100644
--- a/lib/Data/Time/Format/Parse.hs
+++ b/lib/Data/Time/Format/Parse.hs
@@ -464,6 +464,9 @@ instance ParseTime ZonedTime where
instance ParseTime UTCTime where
buildTime l = zonedTimeToUTC . buildTime l
+instance ParseTime UniversalTime where
+ buildTime l = localTimeToUT1 0 . buildTime l
+
-- * Read instances for time package types
#if LANGUAGE_Rank2Types
@@ -485,5 +488,8 @@ instance Read ZonedTime where
instance Read UTCTime where
readsPrec n s = [ (zonedTimeToUTC t, r) | (t,r) <- readsPrec n s ]
+
+instance Read UniversalTime where
+ readsPrec n s = [ (localTimeToUT1 0 t, r) | (t,r) <- readsPrec n s ]
#endif
diff --git a/test/Test/TestParseTime.hs b/test/Test/TestParseTime.hs
index 26ee67d..4c65fbd 100644
--- a/test/Test/TestParseTime.hs
+++ b/test/Test/TestParseTime.hs
@@ -286,6 +286,13 @@ instance Arbitrary UTCTime where
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 @@ properties =
("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 @@ properties =
++ 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 @@ properties =
++ 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 @@ properties =
++ 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 @@ properties =
++ 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 :: [FormatString UTCTime]
utcTimeFormats = map FormatString
["%s.%q","%s%Q"]
+universalTimeFormats :: [FormatString UniversalTime]
+universalTimeFormats = map FormatString []
+
--
-- * Formats that do not include all the information
--
@@ -562,6 +578,10 @@ partialUTCTimeFormats = map FormatString
"%c"
]
+partialUniversalTimeFormats :: [FormatString UniversalTime]
+partialUniversalTimeFormats = map FormatString
+ [ ]
+
--
-- * Known failures
--
GitLab