parsec parser

[time-w3c.git] / Data / Time / W3C / Parser / Parsec.hs

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