Data/Time/W3C/Format.hs

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