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