Convertible W3CDateTime ZonedTime
authorPHO <pho@cielonegro.org>
Thu, 11 Mar 2010 06:42:40 +0000 (15:42 +0900)
committerPHO <pho@cielonegro.org>
Thu, 11 Mar 2010 06:42:40 +0000 (15:42 +0900)
Data/Time/W3CDateTime/Types.hs

index b41023c1322edf3b43776bc577c9be4747eaa7d2..c7573eb09814481b69bd9402e183d9282334790d 100644 (file)
@@ -53,22 +53,24 @@ instance Convertible W3CDateTime Day where
              d <- fetch "day"   w3cDay   w3c
              return (fromGregorian y m d)
 
-instance Convertible UTCTime W3CDateTime where
-    safeConvert u
-        = let (y, m, d) = toGregorian (utctDay u)
-              hms       = timeToTimeOfDay (utctDayTime u)
+instance Convertible ZonedTime W3CDateTime where
+    safeConvert zt
+        = let lt  = zonedTimeToLocalTime zt
+              tz  = zonedTimeZone zt
+              ymd = localDay lt
+              hms = localTimeOfDay lt
           in
             return W3CDateTime {
-                         w3cYear     = y
-                       , w3cMonth    = Just m
-                       , w3cDay      = Just d
+                         w3cYear     =       case toGregorian ymd of (y, _, _) -> y
+                       , w3cMonth    = Just (case toGregorian ymd of (_, m, _) -> m)
+                       , w3cDay      = Just (case toGregorian ymd of (_, _, d) -> d)
                        , w3cHour     = Just (todHour hms)
                        , w3cMinute   = Just (todMin  hms)
                        , w3cSecond   = Just (todSec  hms)
-                       , w3cTimeZone = Just utc
+                       , w3cTimeZone = Just tz
                        }
 
-instance Convertible W3CDateTime UTCTime where
+instance Convertible W3CDateTime ZonedTime where
     safeConvert w3c
         = do day <- safeConvert w3c
              tod <- do h   <- fetch "hour"   w3cHour   w3c
@@ -78,5 +80,7 @@ instance Convertible W3CDateTime UTCTime where
                          Just tod -> return tod
                          Nothing  -> convError "Invalid time of day" w3c
              tz  <- fetch "timezone" w3cTimeZone w3c
-             let lt = LocalTime day tod
-             return (localTimeToUTC tz lt)
+             return ZonedTime {
+                          zonedTimeToLocalTime = LocalTime day tod
+                        , zonedTimeZone        = tz
+                        }