format everything with hindent
[packages/time.git] / lib / Data / Time / Format / ISO8601.hs
1 module Data.Time.Format.ISO8601
2 (
3 -- * Format
4 Format
5 , formatShowM
6 , formatShow
7 , formatReadP
8 , formatParseM
9 -- * Common formats
10 , ISO8601(..)
11 , iso8601Show
12 , iso8601ParseM
13 -- * All formats
14 , FormatExtension(..)
15 , formatReadPExtension
16 , parseFormatExtension
17 , calendarFormat
18 , yearMonthFormat
19 , yearFormat
20 , centuryFormat
21 , expandedCalendarFormat
22 , expandedYearMonthFormat
23 , expandedYearFormat
24 , expandedCenturyFormat
25 , ordinalDateFormat
26 , expandedOrdinalDateFormat
27 , weekDateFormat
28 , yearWeekFormat
29 , expandedWeekDateFormat
30 , expandedYearWeekFormat
31 , timeOfDayFormat
32 , hourMinuteFormat
33 , hourFormat
34 , withTimeDesignator
35 , withUTCDesignator
36 , timeOffsetFormat
37 , timeOfDayAndOffsetFormat
38 , localTimeFormat
39 , zonedTimeFormat
40 , utcTimeFormat
41 , dayAndTimeFormat
42 , timeAndOffsetFormat
43 , durationDaysFormat
44 , durationTimeFormat
45 , alternativeDurationDaysFormat
46 , alternativeDurationTimeFormat
47 , intervalFormat
48 , recurringIntervalFormat
49 ) where
50
51 import Control.Monad.Fail
52 import Data.Fixed
53 import Data.Format
54 import Data.Ratio
55 import Data.Time
56 import Data.Time.Calendar.OrdinalDate
57 import Data.Time.Calendar.Private
58 import Data.Time.Calendar.WeekDate
59 import Prelude hiding (fail)
60 import Text.ParserCombinators.ReadP
61
62 data FormatExtension
63 =
64 -- | ISO 8601:2004(E) sec. 2.3.4. Use hyphens and colons.
65 ExtendedFormat
66 -- | ISO 8601:2004(E) sec. 2.3.3. Omit hyphens and colons. "The basic format should be avoided in plain text."
67 | BasicFormat
68
69 -- | Read a value in either extended or basic format
70 formatReadPExtension :: (FormatExtension -> Format t) -> ReadP t
71 formatReadPExtension ff = formatReadP (ff ExtendedFormat) +++ formatReadP (ff BasicFormat)
72
73 -- | Parse a value in either extended or basic format
74 parseFormatExtension :: (MonadFail m) => (FormatExtension -> Format t) -> String -> m t
75 parseFormatExtension ff = parseReader $ formatReadPExtension ff
76
77 sepFormat :: String -> Format a -> Format b -> Format (a, b)
78 sepFormat sep fa fb = (fa <** literalFormat sep) <**> fb
79
80 dashFormat :: Format a -> Format b -> Format (a, b)
81 dashFormat = sepFormat "-"
82
83 colnFormat :: Format a -> Format b -> Format (a, b)
84 colnFormat = sepFormat ":"
85
86 extDashFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
87 extDashFormat ExtendedFormat = dashFormat
88 extDashFormat BasicFormat = (<**>)
89
90 extColonFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
91 extColonFormat ExtendedFormat = colnFormat
92 extColonFormat BasicFormat = (<**>)
93
94 expandedYearFormat' :: Int -> Format Integer
95 expandedYearFormat' n = integerFormat PosNegSign (Just n)
96
97 yearFormat' :: Format Integer
98 yearFormat' = integerFormat NegSign (Just 4)
99
100 monthFormat :: Format Int
101 monthFormat = integerFormat NoSign (Just 2)
102
103 dayOfMonthFormat :: Format Int
104 dayOfMonthFormat = integerFormat NoSign (Just 2)
105
106 dayOfYearFormat :: Format Int
107 dayOfYearFormat = integerFormat NoSign (Just 3)
108
109 weekOfYearFormat :: Format Int
110 weekOfYearFormat = literalFormat "W" **> integerFormat NoSign (Just 2)
111
112 dayOfWeekFormat :: Format Int
113 dayOfWeekFormat = integerFormat NoSign (Just 1)
114
115 hourFormat' :: Format Int
116 hourFormat' = integerFormat NoSign (Just 2)
117
118 data E14
119
120 instance HasResolution E14 where
121 resolution _ = 100000000000000
122
123 data E16
124
125 instance HasResolution E16 where
126 resolution _ = 10000000000000000
127
128 hourDecimalFormat :: Format (Fixed E16) -- need four extra decimal places for hours
129 hourDecimalFormat = decimalFormat NoSign (Just 2)
130
131 minuteFormat :: Format Int
132 minuteFormat = integerFormat NoSign (Just 2)
133
134 minuteDecimalFormat :: Format (Fixed E14) -- need two extra decimal places for minutes
135 minuteDecimalFormat = decimalFormat NoSign (Just 2)
136
137 secondFormat :: Format Pico
138 secondFormat = decimalFormat NoSign (Just 2)
139
140 mapGregorian :: Format (Integer, (Int, Int)) -> Format Day
141 mapGregorian =
142 mapMFormat (\(y, (m, d)) -> fromGregorianValid y m d) (\day -> (\(y, m, d) -> Just (y, (m, d))) $ toGregorian day)
143
144 mapOrdinalDate :: Format (Integer, Int) -> Format Day
145 mapOrdinalDate = mapMFormat (\(y, d) -> fromOrdinalDateValid y d) (Just . toOrdinalDate)
146
147 mapWeekDate :: Format (Integer, (Int, Int)) -> Format Day
148 mapWeekDate =
149 mapMFormat (\(y, (w, d)) -> fromWeekDateValid y w d) (\day -> (\(y, w, d) -> Just (y, (w, d))) $ toWeekDate day)
150
151 mapTimeOfDay :: Format (Int, (Int, Pico)) -> Format TimeOfDay
152 mapTimeOfDay = mapMFormat (\(h, (m, s)) -> makeTimeOfDayValid h m s) (\(TimeOfDay h m s) -> Just (h, (m, s)))
153
154 -- | ISO 8601:2004(E) sec. 4.1.2.2
155 calendarFormat :: FormatExtension -> Format Day
156 calendarFormat fe = mapGregorian $ extDashFormat fe yearFormat $ extDashFormat fe monthFormat dayOfMonthFormat
157
158 -- | ISO 8601:2004(E) sec. 4.1.2.3(a)
159 yearMonthFormat :: Format (Integer, Int)
160 yearMonthFormat = yearFormat <**> literalFormat "-" **> monthFormat
161
162 -- | ISO 8601:2004(E) sec. 4.1.2.3(b)
163 yearFormat :: Format Integer
164 yearFormat = yearFormat'
165
166 -- | ISO 8601:2004(E) sec. 4.1.2.3(c)
167 centuryFormat :: Format Integer
168 centuryFormat = integerFormat NegSign (Just 2)
169
170 -- | ISO 8601:2004(E) sec. 4.1.2.4(a)
171 expandedCalendarFormat :: Int -> FormatExtension -> Format Day
172 expandedCalendarFormat n fe =
173 mapGregorian $ extDashFormat fe (expandedYearFormat n) $ extDashFormat fe monthFormat dayOfMonthFormat
174
175 -- | ISO 8601:2004(E) sec. 4.1.2.4(b)
176 expandedYearMonthFormat :: Int -> Format (Integer, Int)
177 expandedYearMonthFormat n = dashFormat (expandedYearFormat n) monthFormat
178
179 -- | ISO 8601:2004(E) sec. 4.1.2.4(c)
180 expandedYearFormat :: Int -> Format Integer
181 expandedYearFormat = expandedYearFormat'
182
183 -- | ISO 8601:2004(E) sec. 4.1.2.4(d)
184 expandedCenturyFormat :: Int -> Format Integer
185 expandedCenturyFormat n = integerFormat PosNegSign (Just n)
186
187 -- | ISO 8601:2004(E) sec. 4.1.3.2
188 ordinalDateFormat :: FormatExtension -> Format Day
189 ordinalDateFormat fe = mapOrdinalDate $ extDashFormat fe yearFormat dayOfYearFormat
190
191 -- | ISO 8601:2004(E) sec. 4.1.3.3
192 expandedOrdinalDateFormat :: Int -> FormatExtension -> Format Day
193 expandedOrdinalDateFormat n fe = mapOrdinalDate $ extDashFormat fe (expandedYearFormat n) dayOfYearFormat
194
195 -- | ISO 8601:2004(E) sec. 4.1.4.2
196 weekDateFormat :: FormatExtension -> Format Day
197 weekDateFormat fe = mapWeekDate $ extDashFormat fe yearFormat $ extDashFormat fe weekOfYearFormat dayOfWeekFormat
198
199 -- | ISO 8601:2004(E) sec. 4.1.4.3
200 yearWeekFormat :: FormatExtension -> Format (Integer, Int)
201 yearWeekFormat fe = extDashFormat fe yearFormat weekOfYearFormat
202
203 -- | ISO 8601:2004(E) sec. 4.1.4.2
204 expandedWeekDateFormat :: Int -> FormatExtension -> Format Day
205 expandedWeekDateFormat n fe =
206 mapWeekDate $ extDashFormat fe (expandedYearFormat n) $ extDashFormat fe weekOfYearFormat dayOfWeekFormat
207
208 -- | ISO 8601:2004(E) sec. 4.1.4.3
209 expandedYearWeekFormat :: Int -> FormatExtension -> Format (Integer, Int)
210 expandedYearWeekFormat n fe = extDashFormat fe (expandedYearFormat n) weekOfYearFormat
211
212 -- | ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a)
213 timeOfDayFormat :: FormatExtension -> Format TimeOfDay
214 timeOfDayFormat fe = mapTimeOfDay $ extColonFormat fe hourFormat' $ extColonFormat fe minuteFormat secondFormat
215
216 -- workaround for the 'fromRational' in 'Fixed', which uses 'floor' instead of 'round'
217 fromRationalRound :: Rational -> NominalDiffTime
218 fromRationalRound r = fromRational $ round (r * 1000000000000) % 1000000000000
219
220 -- | ISO 8601:2004(E) sec. 4.2.2.3(a), 4.2.2.4(b)
221 hourMinuteFormat :: FormatExtension -> Format TimeOfDay
222 hourMinuteFormat fe = let
223 toTOD (h, m) =
224 case timeToDaysAndTimeOfDay $ fromRationalRound $ toRational $ (fromIntegral h) * 3600 + m * 60 of
225 (0, tod) -> Just tod
226 _ -> Nothing
227 fromTOD tod = let
228 mm = (realToFrac $ daysAndTimeOfDayToTime 0 tod) / 60
229 in Just $ quotRemBy 60 mm
230 in mapMFormat toTOD fromTOD $ extColonFormat fe hourFormat' $ minuteDecimalFormat
231
232 -- | ISO 8601:2004(E) sec. 4.2.2.3(b), 4.2.2.4(c)
233 hourFormat :: Format TimeOfDay
234 hourFormat = let
235 toTOD h =
236 case timeToDaysAndTimeOfDay $ fromRationalRound $ toRational $ h * 3600 of
237 (0, tod) -> Just tod
238 _ -> Nothing
239 fromTOD tod = Just $ (realToFrac $ daysAndTimeOfDayToTime 0 tod) / 3600
240 in mapMFormat toTOD fromTOD $ hourDecimalFormat
241
242 -- | ISO 8601:2004(E) sec. 4.2.2.5
243 withTimeDesignator :: Format t -> Format t
244 withTimeDesignator f = literalFormat "T" **> f
245
246 -- | ISO 8601:2004(E) sec. 4.2.4
247 withUTCDesignator :: Format t -> Format t
248 withUTCDesignator f = f <** literalFormat "Z"
249
250 -- | ISO 8601:2004(E) sec. 4.2.5.1
251 timeOffsetFormat :: FormatExtension -> Format TimeZone
252 timeOffsetFormat fe = let
253 toTimeZone (sign, (h, m)) = minutesToTimeZone $ sign * (h * 60 + m)
254 fromTimeZone tz = let
255 mm = timeZoneMinutes tz
256 hm = quotRem (abs mm) 60
257 in (signum mm, hm)
258 in isoMap toTimeZone fromTimeZone $
259 mandatorySignFormat <**> extColonFormat fe (integerFormat NoSign (Just 2)) (integerFormat NoSign (Just 2))
260
261 -- | ISO 8601:2004(E) sec. 4.2.5.2
262 timeOfDayAndOffsetFormat :: FormatExtension -> Format (TimeOfDay, TimeZone)
263 timeOfDayAndOffsetFormat fe = timeOfDayFormat fe <**> timeOffsetFormat fe
264
265 -- | ISO 8601:2004(E) sec. 4.3.2
266 localTimeFormat :: Format Day -> Format TimeOfDay -> Format LocalTime
267 localTimeFormat fday ftod =
268 isoMap (\(day, tod) -> LocalTime day tod) (\(LocalTime day tod) -> (day, tod)) $ fday <**> withTimeDesignator ftod
269
270 -- | ISO 8601:2004(E) sec. 4.3.2
271 zonedTimeFormat :: Format Day -> Format TimeOfDay -> FormatExtension -> Format ZonedTime
272 zonedTimeFormat fday ftod fe =
273 isoMap (\(lt, tz) -> ZonedTime lt tz) (\(ZonedTime lt tz) -> (lt, tz)) $
274 timeAndOffsetFormat (localTimeFormat fday ftod) fe
275
276 -- | ISO 8601:2004(E) sec. 4.3.2
277 utcTimeFormat :: Format Day -> Format TimeOfDay -> Format UTCTime
278 utcTimeFormat fday ftod =
279 isoMap (localTimeToUTC utc) (utcToLocalTime utc) $ withUTCDesignator $ localTimeFormat fday ftod
280
281 -- | ISO 8601:2004(E) sec. 4.3.3
282 dayAndTimeFormat :: Format Day -> Format time -> Format (Day, time)
283 dayAndTimeFormat fday ft = fday <**> withTimeDesignator ft
284
285 -- | ISO 8601:2004(E) sec. 4.3.3
286 timeAndOffsetFormat :: Format t -> FormatExtension -> Format (t, TimeZone)
287 timeAndOffsetFormat ft fe = ft <**> timeOffsetFormat fe
288
289 intDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t
290 intDesignator c = optionalFormat 0 $ integerFormat NoSign Nothing <** literalFormat [c]
291
292 decDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t
293 decDesignator c = optionalFormat 0 $ decimalFormat NoSign Nothing <** literalFormat [c]
294
295 daysDesigs :: Format CalendarDiffDays
296 daysDesigs = let
297 toCD (y, (m, (w, d))) = CalendarDiffDays (y * 12 + m) (w * 7 + d)
298 fromCD (CalendarDiffDays mm d) = (quot mm 12, (rem mm 12, (0, d)))
299 in isoMap toCD fromCD $ intDesignator 'Y' <**> intDesignator 'M' <**> intDesignator 'W' <**> intDesignator 'D'
300
301 -- | ISO 8601:2004(E) sec. 4.4.3.2
302 durationDaysFormat :: Format CalendarDiffDays
303 durationDaysFormat = (**>) (literalFormat "P") $ specialCaseShowFormat (mempty, "0D") $ daysDesigs
304
305 -- | ISO 8601:2004(E) sec. 4.4.3.2
306 durationTimeFormat :: Format CalendarDiffTime
307 durationTimeFormat = let
308 toCT (cd, (h, (m, s))) =
309 mappend (calendarTimeDays cd) (calendarTimeTime $ daysAndTimeOfDayToTime 0 $ TimeOfDay h m s)
310 fromCT (CalendarDiffTime mm t) = let
311 (d, TimeOfDay h m s) = timeToDaysAndTimeOfDay t
312 in (CalendarDiffDays mm d, (h, (m, s)))
313 in (**>) (literalFormat "P") $
314 specialCaseShowFormat (mempty, "0D") $
315 isoMap toCT fromCT $
316 (<**>) daysDesigs $
317 optionalFormat (0, (0, 0)) $
318 literalFormat "T" **> intDesignator 'H' <**> intDesignator 'M' <**> decDesignator 'S'
319
320 -- | ISO 8601:2004(E) sec. 4.4.3.3
321 alternativeDurationDaysFormat :: FormatExtension -> Format CalendarDiffDays
322 alternativeDurationDaysFormat fe = let
323 toCD (y, (m, d)) = CalendarDiffDays (y * 12 + m) d
324 fromCD (CalendarDiffDays mm d) = (quot mm 12, (rem mm 12, d))
325 in isoMap toCD fromCD $
326 (**>) (literalFormat "P") $
327 extDashFormat fe (clipFormat (0, 9999) $ integerFormat NegSign $ Just 4) $
328 extDashFormat fe (clipFormat (0, 12) $ integerFormat NegSign $ Just 2) $
329 (clipFormat (0, 30) $ integerFormat NegSign $ Just 2)
330
331 -- | ISO 8601:2004(E) sec. 4.4.3.3
332 alternativeDurationTimeFormat :: FormatExtension -> Format CalendarDiffTime
333 alternativeDurationTimeFormat fe = let
334 toCT (cd, (h, (m, s))) =
335 mappend (calendarTimeDays cd) (calendarTimeTime $ daysAndTimeOfDayToTime 0 $ TimeOfDay h m s)
336 fromCT (CalendarDiffTime mm t) = let
337 (d, TimeOfDay h m s) = timeToDaysAndTimeOfDay t
338 in (CalendarDiffDays mm d, (h, (m, s)))
339 in isoMap toCT fromCT $
340 (<**>) (alternativeDurationDaysFormat fe) $
341 withTimeDesignator $
342 extColonFormat fe (clipFormat (0, 24) $ integerFormat NegSign (Just 2)) $
343 extColonFormat fe (clipFormat (0, 60) $ integerFormat NegSign (Just 2)) $
344 (clipFormat (0, 60) $ decimalFormat NegSign (Just 2))
345
346 -- | ISO 8601:2004(E) sec. 4.4.4.1
347 intervalFormat :: Format a -> Format b -> Format (a, b)
348 intervalFormat = sepFormat "/"
349
350 -- | ISO 8601:2004(E) sec. 4.5
351 recurringIntervalFormat :: Format a -> Format b -> Format (Int, a, b)
352 recurringIntervalFormat fa fb =
353 isoMap (\(r, (a, b)) -> (r, a, b)) (\(r, a, b) -> (r, (a, b))) $
354 sepFormat "/" (literalFormat "R" **> integerFormat NoSign Nothing) $ intervalFormat fa fb
355
356 class ISO8601 t where
357 -- | The most commonly used ISO 8601 format for this type.
358 iso8601Format :: Format t
359
360 -- | Show in the most commonly used ISO 8601 format.
361 iso8601Show :: ISO8601 t => t -> String
362 iso8601Show = formatShow iso8601Format
363
364 -- | Parse the most commonly used ISO 8601 format.
365 iso8601ParseM :: (MonadFail m, ISO8601 t) => String -> m t
366 iso8601ParseM = formatParseM iso8601Format
367
368 -- | @yyyy-mm-dd@ (ISO 8601:2004(E) sec. 4.1.2.2 extended format)
369 instance ISO8601 Day where
370 iso8601Format = calendarFormat ExtendedFormat
371
372 -- | @hh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a) extended format)
373 instance ISO8601 TimeOfDay where
374 iso8601Format = timeOfDayFormat ExtendedFormat
375
376 -- | @±hh:mm@ (ISO 8601:2004(E) sec. 4.2.5.1 extended format)
377 instance ISO8601 TimeZone where
378 iso8601Format = timeOffsetFormat ExtendedFormat
379
380 -- | @yyyy-mm-ddThh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
381 instance ISO8601 LocalTime where
382 iso8601Format = localTimeFormat iso8601Format iso8601Format
383
384 -- | @yyyy-mm-ddThh:mm:ss[.sss]±hh:mm@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
385 instance ISO8601 ZonedTime where
386 iso8601Format = zonedTimeFormat iso8601Format iso8601Format ExtendedFormat
387
388 -- | @yyyy-mm-ddThh:mm:ss[.sss]Z@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
389 instance ISO8601 UTCTime where
390 iso8601Format = utcTimeFormat iso8601Format iso8601Format
391
392 -- | @PyYmMdD@ (ISO 8601:2004(E) sec. 4.4.3.2)
393 instance ISO8601 CalendarDiffDays where
394 iso8601Format = durationDaysFormat
395
396 -- | @PyYmMdDThHmMs[.sss]S@ (ISO 8601:2004(E) sec. 4.4.3.2)
397 instance ISO8601 CalendarDiffTime where
398 iso8601Format = durationTimeFormat