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