+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)
\ No newline at end of file