parsec parser

diff --git a/Data/Time/W3C.hs b/Data/Time/W3C.hs
index a6f19f40eec655ae9621b9e37cb9a685812092af..5cf18224b9453891096c27cc17f76421b38722f0 100644 (file)
--- 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 (file)
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 (file)
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 6b08679ce6627e9768efa6f34752df0b031826a0..b8421729673dd77e3369e617e845f45971a05cf1 100644 (file)
--- 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