Data/Time/W3C/Parser/Parsec.hs

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