{-# LANGUAGE Safe #-}

module Data.Time.Format.ISO8601 (
    -- * Format
    Format,
    formatShowM,
    formatShow,
    formatReadP,
    formatParseM,

    -- * Common formats
    ISO8601 (..),
    iso8601Show,
    iso8601ParseM,

    -- * All formats
    FormatExtension (..),
    formatReadPExtension,
    parseFormatExtension,
    calendarFormat,
    yearMonthFormat,
    yearFormat,
    centuryFormat,
    expandedCalendarFormat,
    expandedYearMonthFormat,
    expandedYearFormat,
    expandedCenturyFormat,
    ordinalDateFormat,
    expandedOrdinalDateFormat,
    weekDateFormat,
    yearWeekFormat,
    expandedWeekDateFormat,
    expandedYearWeekFormat,
    timeOfDayFormat,
    hourMinuteFormat,
    hourFormat,
    withTimeDesignator,
    withUTCDesignator,
    timeOffsetFormat,
    timeOfDayAndOffsetFormat,
    localTimeFormat,
    zonedTimeFormat,
    utcTimeFormat,
    dayAndTimeFormat,
    timeAndOffsetFormat,
    durationDaysFormat,
    durationTimeFormat,
    alternativeDurationDaysFormat,
    alternativeDurationTimeFormat,
    intervalFormat,
    recurringIntervalFormat,

    -- * Other
    isoMakeTimeOfDayValid,
) where

import Control.Monad.Fail
import Data.Fixed
import Data.Format
import Data.Ratio
import Data.Time
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Private
import Data.Time.Calendar.WeekDate
import Text.ParserCombinators.ReadP
import Prelude hiding (fail)

data FormatExtension
    = -- | ISO 8601:2004(E) sec. 2.3.4. Use hyphens and colons.
      ExtendedFormat
    | -- | ISO 8601:2004(E) sec. 2.3.3. Omit hyphens and colons. "The basic format should be avoided in plain text."
      BasicFormat

-- | Read a value in either extended or basic format
formatReadPExtension :: (FormatExtension -> Format t) -> ReadP t
formatReadPExtension :: (FormatExtension -> Format t) -> ReadP t
formatReadPExtension FormatExtension -> Format t
ff = Format t -> ReadP t
forall t. Format t -> ReadP t
formatReadP (FormatExtension -> Format t
ff FormatExtension
ExtendedFormat) ReadP t -> ReadP t -> ReadP t
forall a. ReadP a -> ReadP a -> ReadP a
+++ Format t -> ReadP t
forall t. Format t -> ReadP t
formatReadP (FormatExtension -> Format t
ff FormatExtension
BasicFormat)

-- | Parse a value in either extended or basic format
parseFormatExtension :: (MonadFail m) => (FormatExtension -> Format t) -> String -> m t
parseFormatExtension :: (FormatExtension -> Format t) -> String -> m t
parseFormatExtension FormatExtension -> Format t
ff = ReadP t -> String -> m t
forall (m :: * -> *) t. MonadFail m => ReadP t -> String -> m t
parseReader (ReadP t -> String -> m t) -> ReadP t -> String -> m t
forall a b. (a -> b) -> a -> b
$ (FormatExtension -> Format t) -> ReadP t
forall t. (FormatExtension -> Format t) -> ReadP t
formatReadPExtension FormatExtension -> Format t
ff

sepFormat :: String -> Format a -> Format b -> Format (a, b)
sepFormat :: String -> Format a -> Format b -> Format (a, b)
sepFormat String
sep Format a
fa Format b
fb = (Format a
fa Format a -> Format () -> Format a
forall (f :: * -> *) a. Productish f => f a -> f () -> f a
<** String -> Format ()
literalFormat String
sep) Format a -> Format b -> Format (a, b)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Format b
fb

dashFormat :: Format a -> Format b -> Format (a, b)
dashFormat :: Format a -> Format b -> Format (a, b)
dashFormat = String -> Format a -> Format b -> Format (a, b)
forall a b. String -> Format a -> Format b -> Format (a, b)
sepFormat String
"-"

colnFormat :: Format a -> Format b -> Format (a, b)
colnFormat :: Format a -> Format b -> Format (a, b)
colnFormat = String -> Format a -> Format b -> Format (a, b)
forall a b. String -> Format a -> Format b -> Format (a, b)
sepFormat String
":"

extDashFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
ExtendedFormat = Format a -> Format b -> Format (a, b)
forall a b. Format a -> Format b -> Format (a, b)
dashFormat
extDashFormat FormatExtension
BasicFormat = Format a -> Format b -> Format (a, b)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
(<**>)

extColonFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat :: FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
ExtendedFormat = Format a -> Format b -> Format (a, b)
forall a b. Format a -> Format b -> Format (a, b)
colnFormat
extColonFormat FormatExtension
BasicFormat = Format a -> Format b -> Format (a, b)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
(<**>)

expandedYearFormat' :: Int -> Format Integer
expandedYearFormat' :: Int -> Format Integer
expandedYearFormat' Int
n = SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
PosNegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)

yearFormat' :: Format Integer
yearFormat' :: Format Integer
yearFormat' = SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4)

monthFormat :: Format Int
monthFormat :: Format Int
monthFormat = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

dayOfMonthFormat :: Format Int
dayOfMonthFormat :: Format Int
dayOfMonthFormat = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

dayOfYearFormat :: Format Int
dayOfYearFormat :: Format Int
dayOfYearFormat = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)

weekOfYearFormat :: Format Int
weekOfYearFormat :: Format Int
weekOfYearFormat = String -> Format ()
literalFormat String
"W" Format () -> Format Int -> Format Int
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
**> SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

dayOfWeekFormat :: Format Int
dayOfWeekFormat :: Format Int
dayOfWeekFormat = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)

hourFormat' :: Format Int
hourFormat' :: Format Int
hourFormat' = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

data E14

instance HasResolution E14 where
    resolution :: p E14 -> Integer
resolution p E14
_ = Integer
100000000000000

data E16

instance HasResolution E16 where
    resolution :: p E16 -> Integer
resolution p E16
_ = Integer
10000000000000000

hourDecimalFormat :: Format (Fixed E16) -- need four extra decimal places for hours
hourDecimalFormat :: Format (Fixed E16)
hourDecimalFormat = SignOption -> Maybe Int -> Format (Fixed E16)
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

minuteFormat :: Format Int
minuteFormat :: Format Int
minuteFormat = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

minuteDecimalFormat :: Format (Fixed E14) -- need two extra decimal places for minutes
minuteDecimalFormat :: Format (Fixed E14)
minuteDecimalFormat = SignOption -> Maybe Int -> Format (Fixed E14)
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

secondFormat :: Format Pico
secondFormat :: Format Pico
secondFormat = SignOption -> Maybe Int -> Format Pico
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

mapGregorian :: Format (Integer, (Int, Int)) -> Format Day
mapGregorian :: Format (Integer, (Int, Int)) -> Format Day
mapGregorian =
    ((Integer, (Int, Int)) -> Maybe Day)
-> (Day -> Maybe (Integer, (Int, Int)))
-> Format (Integer, (Int, Int))
-> Format Day
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat (\(Integer
y, (Int
m, Int
d)) -> Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
y Int
m Int
d) (\Day
day -> (\(Integer
y, Int
m, Int
d) -> (Integer, (Int, Int)) -> Maybe (Integer, (Int, Int))
forall a. a -> Maybe a
Just (Integer
y, (Int
m, Int
d))) ((Integer, Int, Int) -> Maybe (Integer, (Int, Int)))
-> (Integer, Int, Int) -> Maybe (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
day)

mapOrdinalDate :: Format (Integer, Int) -> Format Day
mapOrdinalDate :: Format (Integer, Int) -> Format Day
mapOrdinalDate = ((Integer, Int) -> Maybe Day)
-> (Day -> Maybe (Integer, Int))
-> Format (Integer, Int)
-> Format Day
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat (\(Integer
y, Int
d) -> Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
y Int
d) ((Integer, Int) -> Maybe (Integer, Int)
forall a. a -> Maybe a
Just ((Integer, Int) -> Maybe (Integer, Int))
-> (Day -> (Integer, Int)) -> Day -> Maybe (Integer, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int)
toOrdinalDate)

mapWeekDate :: Format (Integer, (Int, Int)) -> Format Day
mapWeekDate :: Format (Integer, (Int, Int)) -> Format Day
mapWeekDate =
    ((Integer, (Int, Int)) -> Maybe Day)
-> (Day -> Maybe (Integer, (Int, Int)))
-> Format (Integer, (Int, Int))
-> Format Day
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat (\(Integer
y, (Int
w, Int
d)) -> Integer -> Int -> Int -> Maybe Day
fromWeekDateValid Integer
y Int
w Int
d) (\Day
day -> (\(Integer
y, Int
w, Int
d) -> (Integer, (Int, Int)) -> Maybe (Integer, (Int, Int))
forall a. a -> Maybe a
Just (Integer
y, (Int
w, Int
d))) ((Integer, Int, Int) -> Maybe (Integer, (Int, Int)))
-> (Integer, Int, Int) -> Maybe (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toWeekDate Day
day)

-- | Like 'makeTimeOfDayValid', but accepts @24 0 0@ per ISO 8601:2004(E) sec. 4.2.3
--
-- @since 1.12
isoMakeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay
isoMakeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay
isoMakeTimeOfDayValid Int
24 Int
0 Pico
0 = TimeOfDay -> Maybe TimeOfDay
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
24 Int
0 Pico
0)
isoMakeTimeOfDayValid Int
h Int
m Pico
s = Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
h Int
m Pico
s

mapTimeOfDay :: Format (Int, (Int, Pico)) -> Format TimeOfDay
mapTimeOfDay :: Format (Int, (Int, Pico)) -> Format TimeOfDay
mapTimeOfDay = ((Int, (Int, Pico)) -> Maybe TimeOfDay)
-> (TimeOfDay -> Maybe (Int, (Int, Pico)))
-> Format (Int, (Int, Pico))
-> Format TimeOfDay
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat (\(Int
h, (Int
m, Pico
s)) -> Int -> Int -> Pico -> Maybe TimeOfDay
isoMakeTimeOfDayValid Int
h Int
m Pico
s) (\(TimeOfDay Int
h Int
m Pico
s) -> (Int, (Int, Pico)) -> Maybe (Int, (Int, Pico))
forall a. a -> Maybe a
Just (Int
h, (Int
m, Pico
s)))

-- | ISO 8601:2004(E) sec. 4.1.2.2
calendarFormat :: FormatExtension -> Format Day
calendarFormat :: FormatExtension -> Format Day
calendarFormat FormatExtension
fe = Format (Integer, (Int, Int)) -> Format Day
mapGregorian (Format (Integer, (Int, Int)) -> Format Day)
-> Format (Integer, (Int, Int)) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer
-> Format (Int, Int)
-> Format (Integer, (Int, Int))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Integer
yearFormat (Format (Int, Int) -> Format (Integer, (Int, Int)))
-> Format (Int, Int) -> Format (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ FormatExtension -> Format Int -> Format Int -> Format (Int, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Int
monthFormat Format Int
dayOfMonthFormat

-- | ISO 8601:2004(E) sec. 4.1.2.3(a)
yearMonthFormat :: Format (Integer, Int)
yearMonthFormat :: Format (Integer, Int)
yearMonthFormat = Format Integer
yearFormat Format Integer -> Format Int -> Format (Integer, Int)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> String -> Format ()
literalFormat String
"-" Format () -> Format Int -> Format Int
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
**> Format Int
monthFormat

-- | ISO 8601:2004(E) sec. 4.1.2.3(b)
yearFormat :: Format Integer
yearFormat :: Format Integer
yearFormat = Format Integer
yearFormat'

-- | ISO 8601:2004(E) sec. 4.1.2.3(c)
centuryFormat :: Format Integer
centuryFormat :: Format Integer
centuryFormat = SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

-- | ISO 8601:2004(E) sec. 4.1.2.4(a)
expandedCalendarFormat :: Int -> FormatExtension -> Format Day
expandedCalendarFormat :: Int -> FormatExtension -> Format Day
expandedCalendarFormat Int
n FormatExtension
fe =
    Format (Integer, (Int, Int)) -> Format Day
mapGregorian (Format (Integer, (Int, Int)) -> Format Day)
-> Format (Integer, (Int, Int)) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer
-> Format (Int, Int)
-> Format (Integer, (Int, Int))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe (Int -> Format Integer
expandedYearFormat Int
n) (Format (Int, Int) -> Format (Integer, (Int, Int)))
-> Format (Int, Int) -> Format (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ FormatExtension -> Format Int -> Format Int -> Format (Int, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Int
monthFormat Format Int
dayOfMonthFormat

-- | ISO 8601:2004(E) sec. 4.1.2.4(b)
expandedYearMonthFormat :: Int -> Format (Integer, Int)
expandedYearMonthFormat :: Int -> Format (Integer, Int)
expandedYearMonthFormat Int
n = Format Integer -> Format Int -> Format (Integer, Int)
forall a b. Format a -> Format b -> Format (a, b)
dashFormat (Int -> Format Integer
expandedYearFormat Int
n) Format Int
monthFormat

-- | ISO 8601:2004(E) sec. 4.1.2.4(c)
expandedYearFormat :: Int -> Format Integer
expandedYearFormat :: Int -> Format Integer
expandedYearFormat = Int -> Format Integer
expandedYearFormat'

-- | ISO 8601:2004(E) sec. 4.1.2.4(d)
expandedCenturyFormat :: Int -> Format Integer
expandedCenturyFormat :: Int -> Format Integer
expandedCenturyFormat Int
n = SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
PosNegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)

-- | ISO 8601:2004(E) sec. 4.1.3.2
ordinalDateFormat :: FormatExtension -> Format Day
ordinalDateFormat :: FormatExtension -> Format Day
ordinalDateFormat FormatExtension
fe = Format (Integer, Int) -> Format Day
mapOrdinalDate (Format (Integer, Int) -> Format Day)
-> Format (Integer, Int) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer -> Format Int -> Format (Integer, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Integer
yearFormat Format Int
dayOfYearFormat

-- | ISO 8601:2004(E) sec. 4.1.3.3
expandedOrdinalDateFormat :: Int -> FormatExtension -> Format Day
expandedOrdinalDateFormat :: Int -> FormatExtension -> Format Day
expandedOrdinalDateFormat Int
n FormatExtension
fe = Format (Integer, Int) -> Format Day
mapOrdinalDate (Format (Integer, Int) -> Format Day)
-> Format (Integer, Int) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer -> Format Int -> Format (Integer, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe (Int -> Format Integer
expandedYearFormat Int
n) Format Int
dayOfYearFormat

-- | ISO 8601:2004(E) sec. 4.1.4.2
weekDateFormat :: FormatExtension -> Format Day
weekDateFormat :: FormatExtension -> Format Day
weekDateFormat FormatExtension
fe = Format (Integer, (Int, Int)) -> Format Day
mapWeekDate (Format (Integer, (Int, Int)) -> Format Day)
-> Format (Integer, (Int, Int)) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer
-> Format (Int, Int)
-> Format (Integer, (Int, Int))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Integer
yearFormat (Format (Int, Int) -> Format (Integer, (Int, Int)))
-> Format (Int, Int) -> Format (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ FormatExtension -> Format Int -> Format Int -> Format (Int, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Int
weekOfYearFormat Format Int
dayOfWeekFormat

-- | ISO 8601:2004(E) sec. 4.1.4.3
yearWeekFormat :: FormatExtension -> Format (Integer, Int)
yearWeekFormat :: FormatExtension -> Format (Integer, Int)
yearWeekFormat FormatExtension
fe = FormatExtension
-> Format Integer -> Format Int -> Format (Integer, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Integer
yearFormat Format Int
weekOfYearFormat

-- | ISO 8601:2004(E) sec. 4.1.4.2
expandedWeekDateFormat :: Int -> FormatExtension -> Format Day
expandedWeekDateFormat :: Int -> FormatExtension -> Format Day
expandedWeekDateFormat Int
n FormatExtension
fe =
    Format (Integer, (Int, Int)) -> Format Day
mapWeekDate (Format (Integer, (Int, Int)) -> Format Day)
-> Format (Integer, (Int, Int)) -> Format Day
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Integer
-> Format (Int, Int)
-> Format (Integer, (Int, Int))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe (Int -> Format Integer
expandedYearFormat Int
n) (Format (Int, Int) -> Format (Integer, (Int, Int)))
-> Format (Int, Int) -> Format (Integer, (Int, Int))
forall a b. (a -> b) -> a -> b
$ FormatExtension -> Format Int -> Format Int -> Format (Int, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe Format Int
weekOfYearFormat Format Int
dayOfWeekFormat

-- | ISO 8601:2004(E) sec. 4.1.4.3
expandedYearWeekFormat :: Int -> FormatExtension -> Format (Integer, Int)
expandedYearWeekFormat :: Int -> FormatExtension -> Format (Integer, Int)
expandedYearWeekFormat Int
n FormatExtension
fe = FormatExtension
-> Format Integer -> Format Int -> Format (Integer, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe (Int -> Format Integer
expandedYearFormat Int
n) Format Int
weekOfYearFormat

-- | ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a)
timeOfDayFormat :: FormatExtension -> Format TimeOfDay
timeOfDayFormat :: FormatExtension -> Format TimeOfDay
timeOfDayFormat FormatExtension
fe = Format (Int, (Int, Pico)) -> Format TimeOfDay
mapTimeOfDay (Format (Int, (Int, Pico)) -> Format TimeOfDay)
-> Format (Int, (Int, Pico)) -> Format TimeOfDay
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Int -> Format (Int, Pico) -> Format (Int, (Int, Pico))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe Format Int
hourFormat' (Format (Int, Pico) -> Format (Int, (Int, Pico)))
-> Format (Int, Pico) -> Format (Int, (Int, Pico))
forall a b. (a -> b) -> a -> b
$ FormatExtension -> Format Int -> Format Pico -> Format (Int, Pico)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe Format Int
minuteFormat Format Pico
secondFormat

-- workaround for the 'fromRational' in 'Fixed', which uses 'floor' instead of 'round'
fromRationalRound :: Rational -> NominalDiffTime
fromRationalRound :: Rational -> NominalDiffTime
fromRationalRound Rational
r = Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000000000) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000000

-- | ISO 8601:2004(E) sec. 4.2.2.3(a), 4.2.2.4(b)
hourMinuteFormat :: FormatExtension -> Format TimeOfDay
hourMinuteFormat :: FormatExtension -> Format TimeOfDay
hourMinuteFormat FormatExtension
fe = let
    toTOD :: (a, a) -> Maybe TimeOfDay
toTOD (a
h, a
m) =
        case NominalDiffTime -> (Integer, TimeOfDay)
timeToDaysAndTimeOfDay (NominalDiffTime -> (Integer, TimeOfDay))
-> NominalDiffTime -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Rational -> NominalDiffTime
fromRationalRound (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ a -> Rational
forall a. Real a => a -> Rational
toRational (a -> Rational) -> a -> Rational
forall a b. (a -> b) -> a -> b
$ (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h) a -> a -> a
forall a. Num a => a -> a -> a
* a
3600 a -> a -> a
forall a. Num a => a -> a -> a
+ a
m a -> a -> a
forall a. Num a => a -> a -> a
* a
60 of
            (Integer
0, TimeOfDay
tod) -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
tod
            (Integer
1, TimeOfDay Int
0 Int
0 Pico
0) -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
24 Int
0 Pico
0
            (Integer, TimeOfDay)
_ -> Maybe TimeOfDay
forall a. Maybe a
Nothing
    fromTOD :: TimeOfDay -> Maybe (b, a)
fromTOD TimeOfDay
tod = let
        mm :: a
mm = (NominalDiffTime -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> a) -> NominalDiffTime -> a
forall a b. (a -> b) -> a -> b
$ Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime Integer
0 TimeOfDay
tod) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
60
        in (b, a) -> Maybe (b, a)
forall a. a -> Maybe a
Just ((b, a) -> Maybe (b, a)) -> (b, a) -> Maybe (b, a)
forall a b. (a -> b) -> a -> b
$ a -> a -> (b, a)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
quotRemBy a
60 a
mm
    in ((Int, Fixed E14) -> Maybe TimeOfDay)
-> (TimeOfDay -> Maybe (Int, Fixed E14))
-> Format (Int, Fixed E14)
-> Format TimeOfDay
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat (Int, Fixed E14) -> Maybe TimeOfDay
forall a a. (Integral a, Real a) => (a, a) -> Maybe TimeOfDay
toTOD TimeOfDay -> Maybe (Int, Fixed E14)
forall b a.
(Integral b, Real a, Fractional a) =>
TimeOfDay -> Maybe (b, a)
fromTOD (Format (Int, Fixed E14) -> Format TimeOfDay)
-> Format (Int, Fixed E14) -> Format TimeOfDay
forall a b. (a -> b) -> a -> b
$ FormatExtension
-> Format Int -> Format (Fixed E14) -> Format (Int, Fixed E14)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe Format Int
hourFormat' (Format (Fixed E14) -> Format (Int, Fixed E14))
-> Format (Fixed E14) -> Format (Int, Fixed E14)
forall a b. (a -> b) -> a -> b
$ Format (Fixed E14)
minuteDecimalFormat

-- | ISO 8601:2004(E) sec. 4.2.2.3(b), 4.2.2.4(c)
hourFormat :: Format TimeOfDay
hourFormat :: Format TimeOfDay
hourFormat = let
    toTOD :: a -> Maybe TimeOfDay
toTOD a
h = case NominalDiffTime -> (Integer, TimeOfDay)
timeToDaysAndTimeOfDay (NominalDiffTime -> (Integer, TimeOfDay))
-> NominalDiffTime -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Rational -> NominalDiffTime
fromRationalRound (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ a -> Rational
forall a. Real a => a -> Rational
toRational (a -> Rational) -> a -> Rational
forall a b. (a -> b) -> a -> b
$ a
h a -> a -> a
forall a. Num a => a -> a -> a
* a
3600 of
        (Integer
0, TimeOfDay
tod) -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just TimeOfDay
tod
        (Integer
1, TimeOfDay Int
0 Int
0 Pico
0) -> TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
24 Int
0 Pico
0
        (Integer, TimeOfDay)
_ -> Maybe TimeOfDay
forall a. Maybe a
Nothing
    fromTOD :: TimeOfDay -> Maybe a
fromTOD TimeOfDay
tod = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (NominalDiffTime -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> a) -> NominalDiffTime -> a
forall a b. (a -> b) -> a -> b
$ Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime Integer
0 TimeOfDay
tod) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3600
    in (Fixed E16 -> Maybe TimeOfDay)
-> (TimeOfDay -> Maybe (Fixed E16))
-> Format (Fixed E16)
-> Format TimeOfDay
forall a b.
(a -> Maybe b) -> (b -> Maybe a) -> Format a -> Format b
mapMFormat Fixed E16 -> Maybe TimeOfDay
forall a. Real a => a -> Maybe TimeOfDay
toTOD TimeOfDay -> Maybe (Fixed E16)
forall a. Fractional a => TimeOfDay -> Maybe a
fromTOD (Format (Fixed E16) -> Format TimeOfDay)
-> Format (Fixed E16) -> Format TimeOfDay
forall a b. (a -> b) -> a -> b
$ Format (Fixed E16)
hourDecimalFormat

-- | ISO 8601:2004(E) sec. 4.2.2.5
withTimeDesignator :: Format t -> Format t
withTimeDesignator :: Format t -> Format t
withTimeDesignator Format t
f = String -> Format ()
literalFormat String
"T" Format () -> Format t -> Format t
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
**> Format t
f

-- | ISO 8601:2004(E) sec. 4.2.4
withUTCDesignator :: Format t -> Format t
withUTCDesignator :: Format t -> Format t
withUTCDesignator Format t
f = Format t
f Format t -> Format () -> Format t
forall (f :: * -> *) a. Productish f => f a -> f () -> f a
<** String -> Format ()
literalFormat String
"Z"

-- | ISO 8601:2004(E) sec. 4.2.5.1
timeOffsetFormat :: FormatExtension -> Format TimeZone
timeOffsetFormat :: FormatExtension -> Format TimeZone
timeOffsetFormat FormatExtension
fe = let
    toTimeZone :: (Int, Either Int (Int, Int)) -> TimeZone
toTimeZone (Int
sign, Either Int (Int, Int)
ehm) =
        Int -> TimeZone
minutesToTimeZone (Int -> TimeZone) -> Int -> TimeZone
forall a b. (a -> b) -> a -> b
$
            Int
sign Int -> Int -> Int
forall a. Num a => a -> a -> a
* case Either Int (Int, Int)
ehm of
                Left Int
h -> Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60
                Right (Int
h, Int
m) -> Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
    fromTimeZone :: TimeZone -> (Int, Either a (Int, Int))
fromTimeZone TimeZone
tz = let
        mm :: Int
mm = TimeZone -> Int
timeZoneMinutes TimeZone
tz
        (Int
h, Int
m) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int -> Int
forall a. Num a => a -> a
abs Int
mm) Int
60
        in (Int -> Int
forall a. Num a => a -> a
signum Int
mm, (Int, Int) -> Either a (Int, Int)
forall a b. b -> Either a b
Right (Int
h, Int
m))
    digits2 :: Format Int
digits2 = SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
    in ((Int, Either Int (Int, Int)) -> TimeZone)
-> (TimeZone -> (Int, Either Int (Int, Int)))
-> Format (Int, Either Int (Int, Int))
-> Format TimeZone
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (Int, Either Int (Int, Int)) -> TimeZone
toTimeZone TimeZone -> (Int, Either Int (Int, Int))
forall a. TimeZone -> (Int, Either a (Int, Int))
fromTimeZone (Format (Int, Either Int (Int, Int)) -> Format TimeZone)
-> Format (Int, Either Int (Int, Int)) -> Format TimeZone
forall a b. (a -> b) -> a -> b
$
        Format Int
forall t. (Eq t, Num t) => Format t
mandatorySignFormat Format Int
-> Format (Either Int (Int, Int))
-> Format (Int, Either Int (Int, Int))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> (Format Int
digits2 Format Int -> Format (Int, Int) -> Format (Either Int (Int, Int))
forall (f :: * -> *) a b. Summish f => f a -> f b -> f (Either a b)
<++> FormatExtension -> Format Int -> Format Int -> Format (Int, Int)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe Format Int
digits2 Format Int
digits2)

-- | ISO 8601:2004(E) sec. 4.2.5.2
timeOfDayAndOffsetFormat :: FormatExtension -> Format (TimeOfDay, TimeZone)
timeOfDayAndOffsetFormat :: FormatExtension -> Format (TimeOfDay, TimeZone)
timeOfDayAndOffsetFormat FormatExtension
fe = FormatExtension -> Format TimeOfDay
timeOfDayFormat FormatExtension
fe Format TimeOfDay -> Format TimeZone -> Format (TimeOfDay, TimeZone)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> FormatExtension -> Format TimeZone
timeOffsetFormat FormatExtension
fe

-- | ISO 8601:2004(E) sec. 4.3.2
localTimeFormat :: Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat :: Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat Format Day
fday Format TimeOfDay
ftod =
    ((Day, TimeOfDay) -> LocalTime)
-> (LocalTime -> (Day, TimeOfDay))
-> Format (Day, TimeOfDay)
-> Format LocalTime
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (\(Day
day, TimeOfDay
tod) -> Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod) (\(LocalTime Day
day TimeOfDay
tod) -> (Day
day, TimeOfDay
tod)) (Format (Day, TimeOfDay) -> Format LocalTime)
-> Format (Day, TimeOfDay) -> Format LocalTime
forall a b. (a -> b) -> a -> b
$ Format Day
fday Format Day -> Format TimeOfDay -> Format (Day, TimeOfDay)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Format TimeOfDay -> Format TimeOfDay
forall t. Format t -> Format t
withTimeDesignator Format TimeOfDay
ftod

-- | ISO 8601:2004(E) sec. 4.3.2
zonedTimeFormat :: Format Day -> Format TimeOfDay -> FormatExtension -> Format ZonedTime
zonedTimeFormat :: Format Day
-> Format TimeOfDay -> FormatExtension -> Format ZonedTime
zonedTimeFormat Format Day
fday Format TimeOfDay
ftod FormatExtension
fe =
    ((LocalTime, TimeZone) -> ZonedTime)
-> (ZonedTime -> (LocalTime, TimeZone))
-> Format (LocalTime, TimeZone)
-> Format ZonedTime
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (\(LocalTime
lt, TimeZone
tz) -> LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
lt TimeZone
tz) (\(ZonedTime LocalTime
lt TimeZone
tz) -> (LocalTime
lt, TimeZone
tz)) (Format (LocalTime, TimeZone) -> Format ZonedTime)
-> Format (LocalTime, TimeZone) -> Format ZonedTime
forall a b. (a -> b) -> a -> b
$
        Format LocalTime -> FormatExtension -> Format (LocalTime, TimeZone)
forall t. Format t -> FormatExtension -> Format (t, TimeZone)
timeAndOffsetFormat (Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat Format Day
fday Format TimeOfDay
ftod) FormatExtension
fe

-- | ISO 8601:2004(E) sec. 4.3.2
utcTimeFormat :: Format Day -> Format TimeOfDay -> Format UTCTime
utcTimeFormat :: Format Day -> Format TimeOfDay -> Format UTCTime
utcTimeFormat Format Day
fday Format TimeOfDay
ftod =
    (LocalTime -> UTCTime)
-> (UTCTime -> LocalTime) -> Format LocalTime -> Format UTCTime
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc) (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc) (Format LocalTime -> Format UTCTime)
-> Format LocalTime -> Format UTCTime
forall a b. (a -> b) -> a -> b
$ Format LocalTime -> Format LocalTime
forall t. Format t -> Format t
withUTCDesignator (Format LocalTime -> Format LocalTime)
-> Format LocalTime -> Format LocalTime
forall a b. (a -> b) -> a -> b
$ Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat Format Day
fday Format TimeOfDay
ftod

-- | ISO 8601:2004(E) sec. 4.3.3
dayAndTimeFormat :: Format Day -> Format time -> Format (Day, time)
dayAndTimeFormat :: Format Day -> Format time -> Format (Day, time)
dayAndTimeFormat Format Day
fday Format time
ft = Format Day
fday Format Day -> Format time -> Format (Day, time)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Format time -> Format time
forall t. Format t -> Format t
withTimeDesignator Format time
ft

-- | ISO 8601:2004(E) sec. 4.3.3
timeAndOffsetFormat :: Format t -> FormatExtension -> Format (t, TimeZone)
timeAndOffsetFormat :: Format t -> FormatExtension -> Format (t, TimeZone)
timeAndOffsetFormat Format t
ft FormatExtension
fe = Format t
ft Format t -> Format TimeZone -> Format (t, TimeZone)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> FormatExtension -> Format TimeZone
timeOffsetFormat FormatExtension
fe

intDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator :: Char -> Format t
intDesignator Char
c = t -> Format t -> Format t
forall a. Eq a => a -> Format a -> Format a
optionalFormat t
0 (Format t -> Format t) -> Format t -> Format t
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format t
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign Maybe Int
forall a. Maybe a
Nothing Format t -> Format () -> Format t
forall (f :: * -> *) a. Productish f => f a -> f () -> f a
<** String -> Format ()
literalFormat [Char
c]

decDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t
decDesignator :: Char -> Format t
decDesignator Char
c = t -> Format t -> Format t
forall a. Eq a => a -> Format a -> Format a
optionalFormat t
0 (Format t -> Format t) -> Format t -> Format t
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format t
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
NoSign Maybe Int
forall a. Maybe a
Nothing Format t -> Format () -> Format t
forall (f :: * -> *) a. Productish f => f a -> f () -> f a
<** String -> Format ()
literalFormat [Char
c]

daysDesigs :: Format CalendarDiffDays
daysDesigs :: Format CalendarDiffDays
daysDesigs = let
    toCD :: (Integer, (Integer, (Integer, Integer))) -> CalendarDiffDays
toCD (Integer
y, (Integer
m, (Integer
w, Integer
d))) = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m) (Integer
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)
    fromCD :: CalendarDiffDays -> (Integer, (Integer, (a, Integer)))
fromCD (CalendarDiffDays Integer
mm Integer
d) = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
mm Integer
12, (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
mm Integer
12, (a
0, Integer
d)))
    in ((Integer, (Integer, (Integer, Integer))) -> CalendarDiffDays)
-> (CalendarDiffDays -> (Integer, (Integer, (Integer, Integer))))
-> Format (Integer, (Integer, (Integer, Integer)))
-> Format CalendarDiffDays
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (Integer, (Integer, (Integer, Integer))) -> CalendarDiffDays
toCD CalendarDiffDays -> (Integer, (Integer, (Integer, Integer)))
forall a.
Num a =>
CalendarDiffDays -> (Integer, (Integer, (a, Integer)))
fromCD (Format (Integer, (Integer, (Integer, Integer)))
 -> Format CalendarDiffDays)
-> Format (Integer, (Integer, (Integer, Integer)))
-> Format CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Char -> Format Integer
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'Y' Format Integer
-> Format (Integer, (Integer, Integer))
-> Format (Integer, (Integer, (Integer, Integer)))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Char -> Format Integer
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'M' Format Integer
-> Format (Integer, Integer)
-> Format (Integer, (Integer, Integer))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Char -> Format Integer
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'W' Format Integer -> Format Integer -> Format (Integer, Integer)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Char -> Format Integer
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'D'

-- | ISO 8601:2004(E) sec. 4.4.3.2
durationDaysFormat :: Format CalendarDiffDays
durationDaysFormat :: Format CalendarDiffDays
durationDaysFormat = Format () -> Format CalendarDiffDays -> Format CalendarDiffDays
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
(**>) (String -> Format ()
literalFormat String
"P") (Format CalendarDiffDays -> Format CalendarDiffDays)
-> Format CalendarDiffDays -> Format CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ (CalendarDiffDays, String)
-> Format CalendarDiffDays -> Format CalendarDiffDays
forall a. Eq a => (a, String) -> Format a -> Format a
specialCaseShowFormat (CalendarDiffDays
forall a. Monoid a => a
mempty, String
"0D") (Format CalendarDiffDays -> Format CalendarDiffDays)
-> Format CalendarDiffDays -> Format CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Format CalendarDiffDays
daysDesigs

-- | ISO 8601:2004(E) sec. 4.4.3.2
durationTimeFormat :: Format CalendarDiffTime
durationTimeFormat :: Format CalendarDiffTime
durationTimeFormat = let
    toCT :: (CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime
toCT (CalendarDiffDays
cd, (Int
h, (Int
m, Pico
s))) =
        CalendarDiffTime -> CalendarDiffTime -> CalendarDiffTime
forall a. Monoid a => a -> a -> a
mappend (CalendarDiffDays -> CalendarDiffTime
calendarTimeDays CalendarDiffDays
cd) (NominalDiffTime -> CalendarDiffTime
calendarTimeTime (NominalDiffTime -> CalendarDiffTime)
-> NominalDiffTime -> CalendarDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime Integer
0 (TimeOfDay -> NominalDiffTime) -> TimeOfDay -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)
    fromCT :: CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico)))
fromCT (CalendarDiffTime Integer
mm NominalDiffTime
t) = let
        (Integer
d, TimeOfDay Int
h Int
m Pico
s) = NominalDiffTime -> (Integer, TimeOfDay)
timeToDaysAndTimeOfDay NominalDiffTime
t
        in (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
mm Integer
d, (Int
h, (Int
m, Pico
s)))
    in Format () -> Format CalendarDiffTime -> Format CalendarDiffTime
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
(**>) (String -> Format ()
literalFormat String
"P") (Format CalendarDiffTime -> Format CalendarDiffTime)
-> Format CalendarDiffTime -> Format CalendarDiffTime
forall a b. (a -> b) -> a -> b
$
        (CalendarDiffTime, String)
-> Format CalendarDiffTime -> Format CalendarDiffTime
forall a. Eq a => (a, String) -> Format a -> Format a
specialCaseShowFormat (CalendarDiffTime
forall a. Monoid a => a
mempty, String
"0D") (Format CalendarDiffTime -> Format CalendarDiffTime)
-> Format CalendarDiffTime -> Format CalendarDiffTime
forall a b. (a -> b) -> a -> b
$
            ((CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime)
-> (CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico))))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
-> Format CalendarDiffTime
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime
toCT CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico)))
fromCT (Format (CalendarDiffDays, (Int, (Int, Pico)))
 -> Format CalendarDiffTime)
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
-> Format CalendarDiffTime
forall a b. (a -> b) -> a -> b
$
                Format CalendarDiffDays
-> Format (Int, (Int, Pico))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
(<**>) Format CalendarDiffDays
daysDesigs (Format (Int, (Int, Pico))
 -> Format (CalendarDiffDays, (Int, (Int, Pico))))
-> Format (Int, (Int, Pico))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
forall a b. (a -> b) -> a -> b
$
                    (Int, (Int, Pico))
-> Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico))
forall a. Eq a => a -> Format a -> Format a
optionalFormat (Int
0, (Int
0, Pico
0)) (Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico)))
-> Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico))
forall a b. (a -> b) -> a -> b
$
                        String -> Format ()
literalFormat String
"T" Format () -> Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico))
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
**> Char -> Format Int
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'H' Format Int -> Format (Int, Pico) -> Format (Int, (Int, Pico))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Char -> Format Int
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
intDesignator Char
'M' Format Int -> Format Pico -> Format (Int, Pico)
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
<**> Char -> Format Pico
forall t. (Eq t, Show t, Read t, Num t) => Char -> Format t
decDesignator Char
'S'

-- | ISO 8601:2004(E) sec. 4.4.3.3
alternativeDurationDaysFormat :: FormatExtension -> Format CalendarDiffDays
alternativeDurationDaysFormat :: FormatExtension -> Format CalendarDiffDays
alternativeDurationDaysFormat FormatExtension
fe = let
    toCD :: (Integer, (Integer, Integer)) -> CalendarDiffDays
toCD (Integer
y, (Integer
m, Integer
d)) = Integer -> Integer -> CalendarDiffDays
CalendarDiffDays (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m) Integer
d
    fromCD :: CalendarDiffDays -> (Integer, (Integer, Integer))
fromCD (CalendarDiffDays Integer
mm Integer
d) = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
mm Integer
12, (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem Integer
mm Integer
12, Integer
d))
    in ((Integer, (Integer, Integer)) -> CalendarDiffDays)
-> (CalendarDiffDays -> (Integer, (Integer, Integer)))
-> Format (Integer, (Integer, Integer))
-> Format CalendarDiffDays
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (Integer, (Integer, Integer)) -> CalendarDiffDays
toCD CalendarDiffDays -> (Integer, (Integer, Integer))
fromCD (Format (Integer, (Integer, Integer)) -> Format CalendarDiffDays)
-> Format (Integer, (Integer, Integer)) -> Format CalendarDiffDays
forall a b. (a -> b) -> a -> b
$
        Format ()
-> Format (Integer, (Integer, Integer))
-> Format (Integer, (Integer, Integer))
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
(**>) (String -> Format ()
literalFormat String
"P") (Format (Integer, (Integer, Integer))
 -> Format (Integer, (Integer, Integer)))
-> Format (Integer, (Integer, Integer))
-> Format (Integer, (Integer, Integer))
forall a b. (a -> b) -> a -> b
$
            FormatExtension
-> Format Integer
-> Format (Integer, Integer)
-> Format (Integer, (Integer, Integer))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe ((Integer, Integer) -> Format Integer -> Format Integer
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Integer
0, Integer
9999) (Format Integer -> Format Integer)
-> Format Integer -> Format Integer
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Maybe Int -> Format Integer) -> Maybe Int -> Format Integer
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Format (Integer, Integer) -> Format (Integer, (Integer, Integer)))
-> Format (Integer, Integer)
-> Format (Integer, (Integer, Integer))
forall a b. (a -> b) -> a -> b
$
                FormatExtension
-> Format Integer -> Format Integer -> Format (Integer, Integer)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extDashFormat FormatExtension
fe ((Integer, Integer) -> Format Integer -> Format Integer
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Integer
0, Integer
12) (Format Integer -> Format Integer)
-> Format Integer -> Format Integer
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Maybe Int -> Format Integer) -> Maybe Int -> Format Integer
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) (Format Integer -> Format (Integer, Integer))
-> Format Integer -> Format (Integer, Integer)
forall a b. (a -> b) -> a -> b
$
                    ((Integer, Integer) -> Format Integer -> Format Integer
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Integer
0, Integer
30) (Format Integer -> Format Integer)
-> Format Integer -> Format Integer
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Integer
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Maybe Int -> Format Integer) -> Maybe Int -> Format Integer
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)

-- | ISO 8601:2004(E) sec. 4.4.3.3
alternativeDurationTimeFormat :: FormatExtension -> Format CalendarDiffTime
alternativeDurationTimeFormat :: FormatExtension -> Format CalendarDiffTime
alternativeDurationTimeFormat FormatExtension
fe = let
    toCT :: (CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime
toCT (CalendarDiffDays
cd, (Int
h, (Int
m, Pico
s))) =
        CalendarDiffTime -> CalendarDiffTime -> CalendarDiffTime
forall a. Monoid a => a -> a -> a
mappend (CalendarDiffDays -> CalendarDiffTime
calendarTimeDays CalendarDiffDays
cd) (NominalDiffTime -> CalendarDiffTime
calendarTimeTime (NominalDiffTime -> CalendarDiffTime)
-> NominalDiffTime -> CalendarDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime Integer
0 (TimeOfDay -> NominalDiffTime) -> TimeOfDay -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)
    fromCT :: CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico)))
fromCT (CalendarDiffTime Integer
mm NominalDiffTime
t) = let
        (Integer
d, TimeOfDay Int
h Int
m Pico
s) = NominalDiffTime -> (Integer, TimeOfDay)
timeToDaysAndTimeOfDay NominalDiffTime
t
        in (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
mm Integer
d, (Int
h, (Int
m, Pico
s)))
    in ((CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime)
-> (CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico))))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
-> Format CalendarDiffTime
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (CalendarDiffDays, (Int, (Int, Pico))) -> CalendarDiffTime
toCT CalendarDiffTime -> (CalendarDiffDays, (Int, (Int, Pico)))
fromCT (Format (CalendarDiffDays, (Int, (Int, Pico)))
 -> Format CalendarDiffTime)
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
-> Format CalendarDiffTime
forall a b. (a -> b) -> a -> b
$
        Format CalendarDiffDays
-> Format (Int, (Int, Pico))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
forall (f :: * -> *) a b. Productish f => f a -> f b -> f (a, b)
(<**>) (FormatExtension -> Format CalendarDiffDays
alternativeDurationDaysFormat FormatExtension
fe) (Format (Int, (Int, Pico))
 -> Format (CalendarDiffDays, (Int, (Int, Pico))))
-> Format (Int, (Int, Pico))
-> Format (CalendarDiffDays, (Int, (Int, Pico)))
forall a b. (a -> b) -> a -> b
$
            Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico))
forall t. Format t -> Format t
withTimeDesignator (Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico)))
-> Format (Int, (Int, Pico)) -> Format (Int, (Int, Pico))
forall a b. (a -> b) -> a -> b
$
                FormatExtension
-> Format Int -> Format (Int, Pico) -> Format (Int, (Int, Pico))
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe ((Int, Int) -> Format Int -> Format Int
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Int
0, Int
24) (Format Int -> Format Int) -> Format Int -> Format Int
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)) (Format (Int, Pico) -> Format (Int, (Int, Pico)))
-> Format (Int, Pico) -> Format (Int, (Int, Pico))
forall a b. (a -> b) -> a -> b
$
                    FormatExtension -> Format Int -> Format Pico -> Format (Int, Pico)
forall a b.
FormatExtension -> Format a -> Format b -> Format (a, b)
extColonFormat FormatExtension
fe ((Int, Int) -> Format Int -> Format Int
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Int
0, Int
60) (Format Int -> Format Int) -> Format Int -> Format Int
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)) (Format Pico -> Format (Int, Pico))
-> Format Pico -> Format (Int, Pico)
forall a b. (a -> b) -> a -> b
$
                        ((Pico, Pico) -> Format Pico -> Format Pico
forall a. Ord a => (a, a) -> Format a -> Format a
clipFormat (Pico
0, Pico
60) (Format Pico -> Format Pico) -> Format Pico -> Format Pico
forall a b. (a -> b) -> a -> b
$ SignOption -> Maybe Int -> Format Pico
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
decimalFormat SignOption
NegSign (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2))

-- | ISO 8601:2004(E) sec. 4.4.4.1
intervalFormat :: Format a -> Format b -> Format (a, b)
intervalFormat :: Format a -> Format b -> Format (a, b)
intervalFormat = String -> Format a -> Format b -> Format (a, b)
forall a b. String -> Format a -> Format b -> Format (a, b)
sepFormat String
"/"

-- | ISO 8601:2004(E) sec. 4.5
recurringIntervalFormat :: Format a -> Format b -> Format (Int, a, b)
recurringIntervalFormat :: Format a -> Format b -> Format (Int, a, b)
recurringIntervalFormat Format a
fa Format b
fb =
    ((Int, (a, b)) -> (Int, a, b))
-> ((Int, a, b) -> (Int, (a, b)))
-> Format (Int, (a, b))
-> Format (Int, a, b)
forall (f :: * -> *) a b.
IsoVariant f =>
(a -> b) -> (b -> a) -> f a -> f b
isoMap (\(Int
r, (a
a, b
b)) -> (Int
r, a
a, b
b)) (\(Int
r, a
a, b
b) -> (Int
r, (a
a, b
b))) (Format (Int, (a, b)) -> Format (Int, a, b))
-> Format (Int, (a, b)) -> Format (Int, a, b)
forall a b. (a -> b) -> a -> b
$
        String -> Format Int -> Format (a, b) -> Format (Int, (a, b))
forall a b. String -> Format a -> Format b -> Format (a, b)
sepFormat String
"/" (String -> Format ()
literalFormat String
"R" Format () -> Format Int -> Format Int
forall (f :: * -> *) a. Productish f => f () -> f a -> f a
**> SignOption -> Maybe Int -> Format Int
forall t.
(Show t, Read t, Num t) =>
SignOption -> Maybe Int -> Format t
integerFormat SignOption
NoSign Maybe Int
forall a. Maybe a
Nothing) (Format (a, b) -> Format (Int, (a, b)))
-> Format (a, b) -> Format (Int, (a, b))
forall a b. (a -> b) -> a -> b
$ Format a -> Format b -> Format (a, b)
forall a b. Format a -> Format b -> Format (a, b)
intervalFormat Format a
fa Format b
fb

class ISO8601 t where
    -- | The most commonly used ISO 8601 format for this type.
    iso8601Format :: Format t

-- | Show in the most commonly used ISO 8601 format.
iso8601Show :: ISO8601 t => t -> String
iso8601Show :: t -> String
iso8601Show = Format t -> t -> String
forall t. Format t -> t -> String
formatShow Format t
forall t. ISO8601 t => Format t
iso8601Format

-- | Parse the most commonly used ISO 8601 format.
iso8601ParseM :: (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM :: String -> m t
iso8601ParseM = Format t -> String -> m t
forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM Format t
forall t. ISO8601 t => Format t
iso8601Format

-- | @yyyy-mm-dd@ (ISO 8601:2004(E) sec. 4.1.2.2 extended format)
instance ISO8601 Day where
    iso8601Format :: Format Day
iso8601Format = FormatExtension -> Format Day
calendarFormat FormatExtension
ExtendedFormat

-- | @hh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.2.2.2, 4.2.2.4(a) extended format)
instance ISO8601 TimeOfDay where
    iso8601Format :: Format TimeOfDay
iso8601Format = FormatExtension -> Format TimeOfDay
timeOfDayFormat FormatExtension
ExtendedFormat

-- | @±hh:mm@ (ISO 8601:2004(E) sec. 4.2.5.1 extended format)
instance ISO8601 TimeZone where
    iso8601Format :: Format TimeZone
iso8601Format = FormatExtension -> Format TimeZone
timeOffsetFormat FormatExtension
ExtendedFormat

-- | @yyyy-mm-ddThh:mm:ss[.sss]@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
instance ISO8601 LocalTime where
    iso8601Format :: Format LocalTime
iso8601Format = Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat Format Day
forall t. ISO8601 t => Format t
iso8601Format Format TimeOfDay
forall t. ISO8601 t => Format t
iso8601Format

-- | @yyyy-mm-ddThh:mm:ss[.sss]±hh:mm@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
instance ISO8601 ZonedTime where
    iso8601Format :: Format ZonedTime
iso8601Format = Format Day
-> Format TimeOfDay -> FormatExtension -> Format ZonedTime
zonedTimeFormat Format Day
forall t. ISO8601 t => Format t
iso8601Format Format TimeOfDay
forall t. ISO8601 t => Format t
iso8601Format FormatExtension
ExtendedFormat

-- | @yyyy-mm-ddThh:mm:ss[.sss]Z@ (ISO 8601:2004(E) sec. 4.3.2 extended format)
instance ISO8601 UTCTime where
    iso8601Format :: Format UTCTime
iso8601Format = Format Day -> Format TimeOfDay -> Format UTCTime
utcTimeFormat Format Day
forall t. ISO8601 t => Format t
iso8601Format Format TimeOfDay
forall t. ISO8601 t => Format t
iso8601Format

-- | @PyYmMdD@ (ISO 8601:2004(E) sec. 4.4.3.2)
instance ISO8601 CalendarDiffDays where
    iso8601Format :: Format CalendarDiffDays
iso8601Format = Format CalendarDiffDays
durationDaysFormat

-- | @PyYmMdDThHmMs[.sss]S@ (ISO 8601:2004(E) sec. 4.4.3.2)
instance ISO8601 CalendarDiffTime where
    iso8601Format :: Format CalendarDiffTime
iso8601Format = Format CalendarDiffTime
durationTimeFormat