Data/Time/W3C/Parser/Parsec.hs

   1 module Data.Time.W3C.Parser.Parsec
   2     ( w3cDateTime
   3     )
   4     where
   5
   6 import Control.Monad
   7 import Data.Time
   8 import Data.Time.W3C.Types
   9 import Text.Parsec
  10
  11
  12 w3cDateTime :: Stream s m Char => ParsecT s u m W3CDateTime
  13 w3cDateTime = read4 >>= mdhmst
  14     where
  15       mdhmst year
  16           = ( char '-' >> read2 >>= dhmst year )
  17             <|>
  18             return W3CDateTime {
  19                          w3cYear     = year
  20                        , w3cMonth    = Nothing
  21                        , w3cDay      = Nothing
  22                        , w3cHour     = Nothing
  23                        , w3cMinute   = Nothing
  24                        , w3cSecond   = Nothing
  25                        , w3cTimeZone = Nothing
  26                        }
  27       dhmst year month
  28           = ( char '-' >> read2 >>= hmst year month )
  29             <|>
  30             return W3CDateTime {
  31                          w3cYear     = year
  32                        , w3cMonth    = Just month
  33                        , w3cDay      = Nothing
  34                        , w3cHour     = Nothing
  35                        , w3cMinute   = Nothing
  36                        , w3cSecond   = Nothing
  37                        , w3cTimeZone = Nothing
  38                        }
  39       hmst year month day
  40           = ( do _ <- char 'T'
  41                  h <- read2
  42                  _ <- char ':'
  43                  m <- read2
  44                  st year month day h m
  45             )
  46             <|>
  47             return W3CDateTime {
  48                          w3cYear     = year
  49                        , w3cMonth    = Just month
  50                        , w3cDay      = Just day
  51                        , w3cHour     = Nothing
  52                        , w3cMinute   = Nothing
  53                        , w3cSecond   = Nothing
  54                        , w3cTimeZone = Nothing
  55                        }
  56       st year month day hour minute
  57           = ( do _ <- char ':'
  58                  s <- second
  59                  t <- timezone
  60                  return W3CDateTime {
  61                               w3cYear     = year
  62                             , w3cMonth    = Just month
  63                             , w3cDay      = Just day
  64                             , w3cHour     = Just hour
  65                             , w3cMinute   = Just minute
  66                             , w3cSecond   = Just s
  67                             , w3cTimeZone = Just t
  68                             }
  69             )
  70             <|>
  71             ( do t <- timezone
  72                  return W3CDateTime {
  73                               w3cYear     = year
  74                             , w3cMonth    = Just month
  75                             , w3cDay      = Just day
  76                             , w3cHour     = Just hour
  77                             , w3cMinute   = Just minute
  78                             , w3cSecond   = Nothing
  79                             , w3cTimeZone = Just t
  80                             }
  81             )
  82
  83       second = do int  <- read2
  84                   frac <- option 0 (char '.' >> liftM parseFrac (many1 digit))
  85                   return (int + frac)
  86
  87       timezone = liftM minutesToTimeZone
  88                  ( ( char 'Z' >> return 0 )
  89                    <|>
  90                    do sign <- ( char '+' >> return 1 )
  91                               <|>
  92                               ( char '-' >> return (-1) )
  93                       h    <- read2
  94                       _    <- char ':'
  95                       m    <- read2
  96                       return (sign * (h * 60 + m))
  97                  )
  98
  99 {- 0.152 => 2,5,1 -->
 100    * (0    / 10) + 0.2 = 0.2
 101    * (0.2  / 10) + 0.5 = 0.52
 102    * (0.52 / 10) + 0.1 = 0.152  *done*
 103  -}
 104 parseFrac :: RealFrac r => String -> r
 105 parseFrac = parseFrac' 0 . reverse . map fromC
 106     where
 107       parseFrac' r []     = r
 108       parseFrac' r (d:ds) = parseFrac' (r / 10 + d / 10) ds
 109
 110 read4 :: (Stream s m Char, Num n) => ParsecT s u m n
 111 read4 = do n1 <- digit'
 112            n2 <- digit'
 113            n3 <- digit'
 114            n4 <- digit'
 115            return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)
 116
 117 read2 :: (Stream s m Char, Num n) => ParsecT s u m n
 118 read2 = do n1 <- digit'
 119            n2 <- digit'
 120            return (n1 * 10 + n2)
 121
 122 digit' :: (Stream s m Char, Num n) => ParsecT s u m n
 123 digit' = liftM fromC digit
 124
 125 fromC :: Num n => Char -> n
 126 fromC '0' = 0
 127 fromC '1' = 1
 128 fromC '2' = 2
 129 fromC '3' = 3
 130 fromC '4' = 4
 131 fromC '5' = 5
 132 fromC '6' = 6
 133 fromC '7' = 7
 134 fromC '8' = 8
 135 fromC '9' = 9
 136 fromC _   = undefined