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