test units
[time-w3c.git] / 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