From 3d738487d6fb1077d139fd689279a1ebd27a9fdc Mon Sep 17 00:00:00 2001 From: PHO Date: Thu, 11 Mar 2010 17:45:01 +0900 Subject: [PATCH] parsec parser --- Data/Time/W3C.hs | 2 + Data/Time/W3C/Parser.hs | 15 ++++ Data/Time/W3C/Parser/Parsec.hs | 136 +++++++++++++++++++++++++++++++++ time-w3c.cabal | 7 +- 4 files changed, 158 insertions(+), 2 deletions(-) create mode 100644 Data/Time/W3C/Parser.hs create mode 100644 Data/Time/W3C/Parser/Parsec.hs diff --git a/Data/Time/W3C.hs b/Data/Time/W3C.hs index a6f19f4..5cf1822 100644 --- a/Data/Time/W3C.hs +++ b/Data/Time/W3C.hs @@ -1,8 +1,10 @@ module Data.Time.W3C ( W3CDateTime(..) , format + , parse ) where import Data.Time.W3C.Format +import Data.Time.W3C.Parser import Data.Time.W3C.Types diff --git a/Data/Time/W3C/Parser.hs b/Data/Time/W3C/Parser.hs new file mode 100644 index 0000000..539a024 --- /dev/null +++ b/Data/Time/W3C/Parser.hs @@ -0,0 +1,15 @@ +module Data.Time.W3C.Parser + ( parse + ) + where + +import qualified Text.Parsec as P + +import Data.Time.W3C.Parser.Parsec +import Data.Time.W3C.Types + +parse :: String -> Maybe W3CDateTime +parse src + = case P.parse w3cDateTime "" src of + Right w3c -> Just w3c + Left _ -> Nothing diff --git a/Data/Time/W3C/Parser/Parsec.hs b/Data/Time/W3C/Parser/Parsec.hs new file mode 100644 index 0000000..f73d68c --- /dev/null +++ b/Data/Time/W3C/Parser/Parsec.hs @@ -0,0 +1,136 @@ +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)) + ) + +{- 0.152 => 2,5,1 --> + * (0 / 10) + 0.2 = 0.2 + * (0.2 / 10) + 0.5 = 0.52 + * (0.52 / 10) + 0.1 = 0.152 *done* + -} +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 diff --git a/time-w3c.cabal b/time-w3c.cabal index 6b08679..b842172 100644 --- a/time-w3c.cabal +++ b/time-w3c.cabal @@ -22,12 +22,15 @@ Library Exposed-modules: Data.Time.W3C Data.Time.W3C.Format + Data.Time.W3C.Parser + Data.Time.W3C.Parser.Parsec Data.Time.W3C.Types Build-depends: base >= 4 && < 5, - convertible >= 1.0, - time >= 1.1 + convertible >= 1.0 && < 2, + parsec >= 3 && < 4, + time >= 1.1 && < 2 Extensions: DeriveDataTypeable -- 2.40.0