renamed modules

[time-w3c.git] / Data / Time / W3C / Types.hs

diff --git a/Data/Time/W3C/Types.hs b/Data/Time/W3C/Types.hs
new file mode 100644 (file)
index 0000000..9f48f68
--- /dev/null
+++ b/Data/Time/W3C/Types.hs
@@ -0,0 +1,86 @@
+module Data.Time.W3C.Types
+    ( W3CDateTime(..)
+    )
+    where
+
+import Data.Convertible
+import Data.Fixed
+import Data.Time
+import Data.Typeable
+
+
+-- This data type is /partially ordered/ so we can't make it an
+-- instance of Ord (e.g. "2010" and "2010-01" can't be compared).
+data W3CDateTime
+    = W3CDateTime {
+        w3cYear     :: !Integer
+      , w3cMonth    :: !(Maybe Int)
+      , w3cDay      :: !(Maybe Int)
+      , w3cHour     :: !(Maybe Int)
+      , w3cMinute   :: !(Maybe Int)
+      , w3cSecond   :: !(Maybe Pico)
+      , w3cTimeZone :: !(Maybe TimeZone)
+      }
+    deriving (Show, Eq, Typeable)
+
+fetch :: (Show a, Typeable a, Typeable b) =>
+         String
+      -> (a -> Maybe b)
+      -> a
+      -> ConvertResult b
+fetch name f a
+    = case f a of
+        Nothing -> convError ("No " ++ name ++ " information in the given value") a
+        Just b  -> return b
+
+instance Convertible Day W3CDateTime where
+    safeConvert day
+        = case toGregorian day of
+            (y, m, d) -> return W3CDateTime {
+                                       w3cYear     = y
+                                     , w3cMonth    = Just m
+                                     , w3cDay      = Just d
+                                     , w3cHour     = Nothing
+                                     , w3cMinute   = Nothing
+                                     , w3cSecond   = Nothing
+                                     , w3cTimeZone = Nothing
+                                     }
+
+instance Convertible W3CDateTime Day where
+    safeConvert w3c
+        = do let y = w3cYear w3c
+             m <- fetch "month" w3cMonth w3c
+             d <- fetch "day"   w3cDay   w3c
+             return (fromGregorian y m d)
+
+instance Convertible ZonedTime W3CDateTime where
+    safeConvert zt
+        = let lt  = zonedTimeToLocalTime zt
+              tz  = zonedTimeZone zt
+              ymd = localDay lt
+              hms = localTimeOfDay lt
+          in
+            return W3CDateTime {
+                         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 tz
+                       }
+
+instance Convertible W3CDateTime ZonedTime where
+    safeConvert w3c
+        = do day <- safeConvert w3c
+             tod <- do h   <- fetch "hour"   w3cHour   w3c
+                       m   <- fetch "minute" w3cMinute w3c
+                       s   <- fetch "second" w3cSecond w3c
+                       case makeTimeOfDayValid h m s of
+                         Just tod -> return tod
+                         Nothing  -> convError "Invalid time of day" w3c
+             tz  <- fetch "timezone" w3cTimeZone w3c
+             return ZonedTime {
+                          zonedTimeToLocalTime = LocalTime day tod
+                        , zonedTimeZone        = tz
+                        }