-- | Format W3C Date and Time strings.
module Data.Time.W3C.Format
    ( format
    )
    where

import Data.Convertible
import Data.Fixed
import Data.Time
import Data.Time.W3C.Types


-- | Format W3C Date and Time string from anything convertible to
-- 'W3CDateTime' type. The most obvious acceptable type is the
-- 'W3CDateTime' itself.
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 (showFixed True 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]