[commit: packages/time] format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis: instance FormatTime UniversalTime; instance ParseTime UniversalTime; instance Read UniversalTime (1ca245b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/1ca245b63dcb9b409be9ecc2b034b821d24af8f9

>---------------------------------------------------------------

commit 1ca245b63dcb9b409be9ecc2b034b821d24af8f9
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Sat Feb 21 03:09:37 2015 -0800

    instance FormatTime UniversalTime; instance ParseTime UniversalTime; instance Read UniversalTime


>---------------------------------------------------------------

1ca245b63dcb9b409be9ecc2b034b821d24af8f9
 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 at .
 --
--- 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