cfab53e017bb4a2322071bde23d9fc83aa7cb560
[packages/time.git] / lib / Data / Time / Format / Parse / Class.hs
1 module Data.Time.Format.Parse.Class
2 (
3 -- * Parsing
4 ParseNumericPadding(..),
5 ParseTime(..),
6 parseSpecifiers,
7 timeSubstituteTimeSpecifier,
8 timeParseTimeSpecifier,
9 durationParseTimeSpecifier,
10 )
11 where
12
13 import Control.Applicative hiding (optional,many)
14 import Data.Char
15 import Data.Maybe
16 import Data.Time.Format.Locale
17 import Text.ParserCombinators.ReadP
18
19 data ParseNumericPadding = NoPadding | SpacePadding | ZeroPadding
20
21 -- | The class of types which can be parsed given a UNIX-style time format
22 -- string.
23 class ParseTime t where
24 -- | @since 1.9.1
25 substituteTimeSpecifier :: proxy t -> TimeLocale -> Char -> Maybe String
26 substituteTimeSpecifier _ _ _ = Nothing
27 -- | Get the string corresponding to the given format specifier.
28 --
29 -- @since 1.9.1
30 parseTimeSpecifier :: proxy t -> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
31 -- | Builds a time value from a parsed input string.
32 -- If the input does not include all the information needed to
33 -- construct a complete value, any missing parts should be taken
34 -- from 1970-01-01 00:00:00 +0000 (which was a Thursday).
35 -- In the absence of @%C@ or @%Y@, century is 1969 - 2068.
36 --
37 -- @since 1.9.1
38 buildTime :: TimeLocale -- ^ The time locale.
39 -> [(Char,String)] -- ^ Pairs of format characters and the
40 -- corresponding part of the input.
41 -> Maybe t
42
43 -- | Case-insensitive version of 'Text.ParserCombinators.ReadP.char'.
44 charCI :: Char -> ReadP Char
45 charCI c = satisfy (\x -> toUpper c == toUpper x)
46
47 -- | Case-insensitive version of 'Text.ParserCombinators.ReadP.string'.
48 stringCI :: String -> ReadP String
49 stringCI this = do
50 let
51 scan [] _ = return this
52 scan (x:xs) (y:ys) | toUpper x == toUpper y = do
53 _ <- get
54 scan xs ys
55 scan _ _ = pfail
56 s <- look
57 scan this s
58
59 parseSpecifiers :: ParseTime t => proxy t -> TimeLocale -> String -> ReadP [(Char,String)]
60 parseSpecifiers pt locale = let
61 parse :: String -> ReadP [(Char,String)]
62 parse [] = return []
63 parse ('%':cs) = parse1 cs
64 parse (c:cs) | isSpace c = do
65 _ <- satisfy isSpace
66 case cs of
67 (c':_) | isSpace c' -> return ()
68 _ -> skipSpaces
69 parse cs
70 parse (c:cs) = do
71 _ <- charCI c
72 parse cs
73
74 parse1 :: String -> ReadP [(Char,String)]
75 parse1 ('-':cs) = parse2 (Just NoPadding) cs
76 parse1 ('_':cs) = parse2 (Just SpacePadding) cs
77 parse1 ('0':cs) = parse2 (Just ZeroPadding) cs
78 parse1 cs = parse2 Nothing cs
79
80 parse2 :: Maybe ParseNumericPadding -> String -> ReadP [(Char,String)]
81 parse2 mpad ('E':cs) = parse3 mpad True cs
82 parse2 mpad cs = parse3 mpad False cs
83
84 parse3 :: Maybe ParseNumericPadding -> Bool -> String -> ReadP [(Char,String)]
85 parse3 _ _ ('%':cs) = do
86 _ <- char '%'
87 parse cs
88 parse3 _ _ (c:cs) | Just s <- substituteTimeSpecifier pt locale c = parse $ s ++ cs
89 parse3 mpad _alt (c:cs) = do
90 str <- parseTimeSpecifier pt locale mpad c
91 specs <- parse cs
92 return $ (c,str) : specs
93 parse3 _ _ [] = return []
94 in parse
95
96 parsePaddedDigits :: ParseNumericPadding -> Int -> ReadP String
97 parsePaddedDigits ZeroPadding n = count n (satisfy isDigit)
98 parsePaddedDigits SpacePadding _n = skipSpaces >> many1 (satisfy isDigit)
99 parsePaddedDigits NoPadding _n = many1 (satisfy isDigit)
100
101 parsePaddedSignedDigits :: ParseNumericPadding -> Int -> ReadP String
102 parsePaddedSignedDigits pad n = do
103 sign <- option "" $ char '-' >> return "-"
104 digits <- parsePaddedDigits pad n
105 return $ sign ++ digits
106
107 parseSignedDecimal :: ReadP String
108 parseSignedDecimal = do
109 sign <- option "" $ char '-' >> return "-"
110 skipSpaces
111 digits <- many1 $ satisfy isDigit
112 decimaldigits <- option "" $ do
113 _ <- char '.'
114 dd <- many $ satisfy isDigit
115 return $ '.':dd
116 return $ sign ++ digits ++ decimaldigits
117
118 timeParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
119 timeParseTimeSpecifier l mpad c = let
120 digits pad = parsePaddedDigits (fromMaybe pad mpad)
121 oneOf = choice . map stringCI
122 numericTZ = do
123 s <- choice [char '+', char '-']
124 h <- parsePaddedDigits ZeroPadding 2
125 optional (char ':')
126 m <- parsePaddedDigits ZeroPadding 2
127 return (s:h++m)
128 in case c of
129 -- century
130 'C' -> digits SpacePadding 2
131 'f' -> digits SpacePadding 2
132
133 -- year
134 'Y' -> digits SpacePadding 4
135 'G' -> digits SpacePadding 4
136
137 -- year of century
138 'y' -> digits ZeroPadding 2
139 'g' -> digits ZeroPadding 2
140
141 -- month of year
142 'B' -> oneOf (map fst (months l))
143 'b' -> oneOf (map snd (months l))
144 'm' -> digits ZeroPadding 2
145
146 -- day of month
147 'd' -> digits ZeroPadding 2
148 'e' -> digits SpacePadding 2
149
150 -- week of year
151 'V' -> digits ZeroPadding 2
152 'U' -> digits ZeroPadding 2
153 'W' -> digits ZeroPadding 2
154
155 -- day of week
156 'u' -> oneOf $ map (:[]) ['1'..'7']
157 'a' -> oneOf (map snd (wDays l))
158 'A' -> oneOf (map fst (wDays l))
159 'w' -> oneOf $ map (:[]) ['0'..'6']
160
161 -- day of year
162 'j' -> digits ZeroPadding 3
163
164 -- dayhalf of day (i.e. AM or PM)
165 'P' -> oneOf (let (am,pm) = amPm l in [am, pm])
166 'p' -> oneOf (let (am,pm) = amPm l in [am, pm])
167
168 -- hour of day (i.e. 24h)
169 'H' -> digits ZeroPadding 2
170 'k' -> digits SpacePadding 2
171
172 -- hour of dayhalf (i.e. 12h)
173 'I' -> digits ZeroPadding 2
174 'l' -> digits SpacePadding 2
175
176 -- minute of hour
177 'M' -> digits ZeroPadding 2
178
179 -- second of minute
180 'S' -> digits ZeroPadding 2
181
182 -- picosecond of second
183 'q' -> digits ZeroPadding 12
184 'Q' -> liftA2 (:) (char '.') (munch isDigit) <++ return ""
185
186 -- time zone
187 'z' -> numericTZ
188 'Z' -> munch1 isAlpha <++
189 numericTZ
190
191 -- seconds since epoch
192 's' -> (char '-' >> fmap ('-':) (munch1 isDigit))
193 <++ munch1 isDigit
194
195 _ -> fail $ "Unknown format character: " ++ show c
196
197 timeSubstituteTimeSpecifier :: TimeLocale -> Char -> Maybe String
198 timeSubstituteTimeSpecifier l 'c' = Just $ dateTimeFmt l
199 timeSubstituteTimeSpecifier _ 'R' = Just "%H:%M"
200 timeSubstituteTimeSpecifier _ 'T' = Just "%H:%M:%S"
201 timeSubstituteTimeSpecifier l 'X' = Just $ timeFmt l
202 timeSubstituteTimeSpecifier l 'r' = Just $ time12Fmt l
203 timeSubstituteTimeSpecifier _ 'D' = Just "%m/%d/%y"
204 timeSubstituteTimeSpecifier _ 'F' = Just "%Y-%m-%d"
205 timeSubstituteTimeSpecifier l 'x' = Just $ dateFmt l
206 timeSubstituteTimeSpecifier _ 'h' = Just "%b"
207 timeSubstituteTimeSpecifier _ _ = Nothing
208
209 durationParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
210 durationParseTimeSpecifier _ mpad c = let
211 padopt = parsePaddedSignedDigits $ fromMaybe NoPadding mpad
212 in case c of
213 'y' -> padopt 1
214 'b' -> padopt 1
215 'B' -> padopt 2
216 'w' -> padopt 1
217 'd' -> padopt 1
218 'D' -> padopt 1
219 'h' -> padopt 1
220 'H' -> padopt 2
221 'm' -> padopt 1
222 'M' -> padopt 2
223 's' -> parseSignedDecimal
224 'S' -> parseSignedDecimal
225 _ -> fail $ "Unknown format character: " ++ show c