module Rakka.W3CDateTime
    ( formatW3CDateTime
    , parseW3CDateTime
    )
    where

import           Control.Monad
import           Data.Time
import           Prelude hiding (min)
import           Text.ParserCombinators.Parsec
import           Text.Printf


formatW3CDateTime :: ZonedTime -> String
formatW3CDateTime zonedTime
    = formatLocalTime (zonedTimeToLocalTime zonedTime)
      ++
      formatTimeZone (zonedTimeZone zonedTime)
    where
      formatLocalTime :: LocalTime -> String
      formatLocalTime localTime
          = let (year, month, day) = toGregorian (localDay localTime)
                timeOfDay          = localTimeOfDay localTime
                (secInt, secFrac)  = properFraction (todSec timeOfDay)
            in
              printf "%04d-%02d-%02dT%02d:%02d:%02d"
                     year
                     month
                     day
                     (todHour timeOfDay)
                     (todMin timeOfDay)
                     (secInt :: Int))
              ++
              (if secFrac == 0
               then ""
               else tail (show secFrac))
      
      formatTimeZone :: TimeZone -> String
      formatTimeZone tz
          = case timeZoneMinutes tz of
              offset | offset <  0 -> '-' : (showTZ $ negate offset)
                     | offset == 0 -> "Z"
                     | otherwise   -> '+' : showTZ offset
      
      showTZ :: Int -> String   
      showTZ offset
          = let hour   = offset `div` 60
                minute = offset - hour * 60
            in 
              show2 hour ++ ":" ++ show2 minute
            
      show2 :: Int -> String
      show2 n | n < 10    = '0' : show n
              | otherwise = show n


parseW3CDateTime :: String -> Maybe ZonedTime
parseW3CDateTime src
    = case parse w3cDateTime "" src of
        Right zt -> Just zt
        Left  _  -> Nothing

w3cDateTime :: Parser ZonedTime
w3cDateTime = do year <- liftM read (count 4 digit)
                 mon  <- option 1 (char '-' >> liftM read (count 2 digit))
                 day  <- option 1 (char '-' >> liftM read (count 2 digit))
                 (hour, min, sec, offMin)
                     <- option (0, 0, 0, 0) time
                 eof

                 let julianDay = fromGregorian year mon day
                     timeOfDay = TimeOfDay hour min (fromRational $ toRational sec)
                     localTime = LocalTime julianDay timeOfDay
                     timeZone  = minutesToTimeZone offMin
                     zonedTime = ZonedTime localTime timeZone

                 return zonedTime
    where
      time :: Parser (Int, Int, Double, Int)
      time = do char 'T'
                hour   <- liftM read (count 2 digit)
                char ':'
                min    <- liftM read (count 2 digit)
                sec    <- option 0 $ do char ':'
                                        secInt  <- count 2 digit
                                        secFrac <- option "" $ do c  <- char '.'
                                                                  cs <- many1 digit
                                                                  return (c:cs)
                                        return $ read (secInt ++ secFrac)
                offMin <- (char 'Z' >> return 0)
                        <|>
                        (do sign <- (char '+' >> return 1)
                                    <|>
                                    (char '-' >> return (-1))
                            h    <- liftM read (count 2 digit)
                            char ':'
                            m    <- liftM read (count 2 digit)
                            return $ sign * h * 60 + m)
                return (hour, min, sec, offMin)