module Data.Time.W3C.Parser.Parsec
( w3cDateTime
)
where
import Control.Monad
import Data.Time
import Data.Time.W3C.Types
import Text.Parsec
w3cDateTime :: Stream s m Char => ParsecT s u m W3CDateTime
w3cDateTime = read4 >>= mdhmst
where
mdhmst year
= ( char '-' >> read2 >>= dhmst year )
<|>
return W3CDateTime {
w3cYear = year
, w3cMonth = Nothing
, w3cDay = Nothing
, w3cHour = Nothing
, w3cMinute = Nothing
, w3cSecond = Nothing
, w3cTimeZone = Nothing
}
dhmst year month
= ( char '-' >> read2 >>= hmst year month )
<|>
return W3CDateTime {
w3cYear = year
, w3cMonth = Just month
, w3cDay = Nothing
, w3cHour = Nothing
, w3cMinute = Nothing
, w3cSecond = Nothing
, w3cTimeZone = Nothing
}
hmst year month day
= ( do _ <- char 'T'
h <- read2
_ <- char ':'
m <- read2
st year month day h m
)
<|>
return W3CDateTime {
w3cYear = year
, w3cMonth = Just month
, w3cDay = Just day
, w3cHour = Nothing
, w3cMinute = Nothing
, w3cSecond = Nothing
, w3cTimeZone = Nothing
}
st year month day hour minute
= ( do _ <- char ':'
s <- second
t <- timezone
return W3CDateTime {
w3cYear = year
, w3cMonth = Just month
, w3cDay = Just day
, w3cHour = Just hour
, w3cMinute = Just minute
, w3cSecond = Just s
, w3cTimeZone = Just t
}
)
<|>
( do t <- timezone
return W3CDateTime {
w3cYear = year
, w3cMonth = Just month
, w3cDay = Just day
, w3cHour = Just hour
, w3cMinute = Just minute
, w3cSecond = Nothing
, w3cTimeZone = Just t
}
)
second = do int <- read2
frac <- option 0 (char '.' >> liftM parseFrac (many1 digit))
return (int + frac)
timezone = liftM minutesToTimeZone
( ( char 'Z' >> return 0 )
<|>
do sign <- ( char '+' >> return 1 )
<|>
( char '-' >> return (1) )
h <- read2
_ <- char ':'
m <- read2
return (sign * (h * 60 + m))
)
parseFrac :: RealFrac r => String -> r
parseFrac = parseFrac' 0 . reverse . map fromC
where
parseFrac' r [] = r
parseFrac' r (d:ds) = parseFrac' (r / 10 + d / 10) ds
read4 :: (Stream s m Char, Num n) => ParsecT s u m n
read4 = do n1 <- digit'
n2 <- digit'
n3 <- digit'
n4 <- digit'
return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)
read2 :: (Stream s m Char, Num n) => ParsecT s u m n
read2 = do n1 <- digit'
n2 <- digit'
return (n1 * 10 + n2)
digit' :: (Stream s m Char, Num n) => ParsecT s u m n
digit' = liftM fromC digit
fromC :: Num n => Char -> n
fromC '0' = 0
fromC '1' = 1
fromC '2' = 2
fromC '3' = 3
fromC '4' = 4
fromC '5' = 5
fromC '6' = 6
fromC '7' = 7
fromC '8' = 8
fromC '9' = 9
fromC _ = undefined