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