renamed modules

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

diff --git a/Data/Time/W3C/Format.hs b/Data/Time/W3C/Format.hs
new file mode 100644 (file)
index 0000000..d83d8c3
--- /dev/null
+++ b/Data/Time/W3C/Format.hs
@@ -0,0 +1,81 @@
+module Data.Time.W3C.Format
+    ( format
+    )
+    where
+
+import Data.Convertible
+import Data.Fixed
+import Data.Time
+import Data.Time.W3C.Types
+
+
+format :: Convertible t W3CDateTime => t -> String
+format = format' . convert
+    where
+      format' (W3CDateTime year Nothing Nothing Nothing Nothing Nothing Nothing)
+          = show4 year
+
+      format' (W3CDateTime year (Just month) Nothing Nothing Nothing Nothing Nothing)
+          = concat [show4 year, "-", show2 month]
+
+      format' (W3CDateTime year (Just month) (Just day) Nothing Nothing Nothing Nothing)
+          = concat [show4 year, "-", show2 month, "-", show2 day]
+
+      format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) Nothing (Just tz))
+          = concat [ show4 year
+                   , "-"
+                   , show2 month
+                   , "-"
+                   , show2 day
+                   , "T"
+                   , show2 hour
+                   , ":"
+                   , show2 minute
+                   , showTZ tz
+                   ]
+
+      format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) (Just second) (Just tz))
+          = concat [ show4 year
+                   , "-"
+                   , show2 month
+                   , "-"
+                   , show2 day
+                   , "T"
+                   , show2 hour
+                   , ":"
+                   , show2 minute
+                   , ":"
+                   , case properFraction second :: (Int, Pico) of
+                       (int, 0   ) -> show2 int
+                       (int, frac) -> show2 int ++ tail (show frac)
+                   , showTZ tz
+                   ]
+
+      format' w = error ("Invalid W3C Date and Time: " ++ show w)
+
+show4 :: Integral i => i -> String
+show4 i
+    | i >= 0 && i < 10    = "000" ++ show i
+    | i >= 0 && i < 100   = "00"  ++ show i
+    | i >= 0 && i < 1000  = "0"   ++ show i
+    | i >= 0 && i < 10000 = show i
+    | otherwise          = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)
+
+show2 :: Integral i => i -> String
+show2 i
+    | i >= 0 && i < 10  = "0" ++ show i
+    | i >= 0 && i < 100 = show i
+    | otherwise         = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)
+
+showTZ :: TimeZone -> String
+showTZ tz
+    = case timeZoneMinutes tz of
+        offset | offset <  0 -> '-' : showTZ' (negate offset)
+               | offset == 0 -> "Z"
+               | otherwise   -> '+' : showTZ' offset
+    where
+      showTZ' offset
+          = let h = offset `div` 60
+                m = offset - h * 60
+            in
+              concat [show2 h, ":", show2 m]