Data/Time/W3C/Format.hs

   1 -- | Format W3C Date and Time strings.
   2 module Data.Time.W3C.Format
   3     ( format
   4     )
   5     where
   6
   7 import Data.Convertible
   8 import Data.Fixed
   9 import Data.Time
  10 import Data.Time.W3C.Types
  11
  12
  13 -- | Format W3C Date and Time string from anything convertible to
  14 -- 'W3CDateTime' type. The most obvious acceptable type is the
  15 -- 'W3CDateTime' itself.
  16 format :: Convertible t W3CDateTime => t -> String
  17 format = format' . convert
  18     where
  19       format' (W3CDateTime year Nothing Nothing Nothing Nothing Nothing Nothing)
  20           = show4 year
  21
  22       format' (W3CDateTime year (Just month) Nothing Nothing Nothing Nothing Nothing)
  23           = concat [show4 year, "-", show2 month]
  24
  25       format' (W3CDateTime year (Just month) (Just day) Nothing Nothing Nothing Nothing)
  26           = concat [show4 year, "-", show2 month, "-", show2 day]
  27
  28       format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) Nothing (Just tz))
  29           = concat [ show4 year
  30                    , "-"
  31                    , show2 month
  32                    , "-"
  33                    , show2 day
  34                    , "T"
  35                    , show2 hour
  36                    , ":"
  37                    , show2 minute
  38                    , showTZ tz
  39                    ]
  40
  41       format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) (Just second) (Just tz))
  42           = concat [ show4 year
  43                    , "-"
  44                    , show2 month
  45                    , "-"
  46                    , show2 day
  47                    , "T"
  48                    , show2 hour
  49                    , ":"
  50                    , show2 minute
  51                    , ":"
  52                    , case properFraction second :: (Int, Pico) of
  53                        (int, 0   ) -> show2 int
  54                        (int, frac) -> show2 int ++ tail (showFixed True frac)
  55                    , showTZ tz
  56                    ]
  57
  58       format' w = error ("Invalid W3C Date and Time: " ++ show w)
  59
  60 show4 :: Integral i => i -> String
  61 show4 i
  62     | i >= 0 && i < 10    = "000" ++ show i
  63     | i >= 0 && i < 100   = "00"  ++ show i
  64     | i >= 0 && i < 1000  = "0"   ++ show i
  65     | i >= 0 && i < 10000 = show i
  66     | otherwise          = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)
  67
  68 show2 :: Integral i => i -> String
  69 show2 i
  70     | i >= 0 && i < 10  = "0" ++ show i
  71     | i >= 0 && i < 100 = show i
  72     | otherwise         = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)
  73
  74 showTZ :: TimeZone -> String
  75 showTZ tz
  76     = case timeZoneMinutes tz of
  77         offset | offset <  0 -> '-' : showTZ' (negate offset)
  78                | offset == 0 -> "Z"
  79                | otherwise   -> '+' : showTZ' offset
  80     where
  81       showTZ' offset
  82           = let h = offset `div` 60
  83                 m = offset - h * 60
  84             in
  85               concat [show2 h, ":", show2 m]