+++ /dev/null
-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