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