    {-# LANGUAGE Safe #-}
    {-# LANGUAGE TypeSynonymInstances #-}

    {-# OPTIONS -fno-warn-orphans #-}

    module Data.Time.Calendar.Gregorian (
        -- * Year, month and day
        Year,
        pattern CommonEra,
        pattern BeforeCommonEra,
        MonthOfYear,
        pattern January,
        pattern February,
        pattern March,
        pattern April,
        pattern May,
        pattern June,
        pattern July,
        pattern August,
        pattern September,
        pattern October,
        pattern November,
        pattern December,
        DayOfMonth,

        -- * Gregorian calendar
        toGregorian,
        fromGregorian,
        pattern YearMonthDay,
        fromGregorianValid,
        showGregorian,
        gregorianMonthLength,
        -- calendrical arithmetic
        -- e.g. "one month after March 31st"
        addGregorianMonthsClip,
        addGregorianMonthsRollOver,
        addGregorianYearsClip,
        addGregorianYearsRollOver,
        addGregorianDurationClip,
        addGregorianDurationRollOver,
        diffGregorianDurationClip,
        diffGregorianDurationRollOver,
        -- re-exported from OrdinalDate
        isLeapYear,
    ) where

    import Data.Time.Calendar.CalendarDiffDays
    import Data.Time.Calendar.Days
    import Data.Time.Calendar.MonthDay
    import Data.Time.Calendar.OrdinalDate
    import Data.Time.Calendar.Private
    import Data.Time.Calendar.Types

    -- | Convert to proleptic Gregorian calendar.
    toGregorian :: Day -> (Year, MonthOfYear, DayOfMonth)
    toGregorian :: Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    date = (Year
    year, MonthOfYear
    month, MonthOfYear
    day)
      where
        (Year
    year, MonthOfYear
    yd) = Day -> (Year, MonthOfYear)
    toOrdinalDate Day
    date
        (MonthOfYear
    month, MonthOfYear
    day) = Bool -> MonthOfYear -> (MonthOfYear, MonthOfYear)
    dayOfYearToMonthAndDay (Year -> Bool
    isLeapYear Year
    year) MonthOfYear
    yd

    -- | Convert from proleptic Gregorian calendar.
    -- Invalid values will be clipped to the correct range, month first, then day.
    fromGregorian :: Year -> MonthOfYear -> DayOfMonth -> Day
    fromGregorian :: Year -> MonthOfYear -> MonthOfYear -> Day
    fromGregorian Year
    year MonthOfYear
    month MonthOfYear
    day = Year -> MonthOfYear -> Day
    fromOrdinalDate Year
    year (Bool -> MonthOfYear -> MonthOfYear -> MonthOfYear
    monthAndDayToDayOfYear (Year -> Bool
    isLeapYear Year
    year) MonthOfYear
    month MonthOfYear
    day)

    -- | Bidirectional abstract constructor for the proleptic Gregorian calendar.
    -- Invalid values will be clipped to the correct range, month first, then day.
    pattern YearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
    pattern $mYearMonthDay :: forall {r}.
    Day
    -> (Year -> MonthOfYear -> MonthOfYear -> r) -> ((# #) -> r) -> r
    $bYearMonthDay :: Year -> MonthOfYear -> MonthOfYear -> Day
    YearMonthDay y m d <-
        (toGregorian -> (y, m, d))
        where
            YearMonthDay Year
    y MonthOfYear
    m MonthOfYear
    d = Year -> MonthOfYear -> MonthOfYear -> Day
    fromGregorian Year
    y MonthOfYear
    m MonthOfYear
    d

    {-# COMPLETE YearMonthDay #-}

    -- | Convert from proleptic Gregorian calendar.
    -- Invalid values will return Nothing
    fromGregorianValid :: Year -> MonthOfYear -> DayOfMonth -> Maybe Day
    fromGregorianValid :: Year -> MonthOfYear -> MonthOfYear -> Maybe Day
    fromGregorianValid Year
    year MonthOfYear
    month MonthOfYear
    day = do
        MonthOfYear
    doy <- Bool -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
    monthAndDayToDayOfYearValid (Year -> Bool
    isLeapYear Year
    year) MonthOfYear
    month MonthOfYear
    day
        Year -> MonthOfYear -> Maybe Day
    fromOrdinalDateValid Year
    year MonthOfYear
    doy

    -- | Show in ISO 8601 format (yyyy-mm-dd)
    showGregorian :: Day -> String
    showGregorian :: Day -> String
    showGregorian Day
    date = (Year -> String
    forall t. ShowPadded t => t -> String
    show4 Year
    y) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (MonthOfYear -> String
    forall t. ShowPadded t => t -> String
    show2 MonthOfYear
    m) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (MonthOfYear -> String
    forall t. ShowPadded t => t -> String
    show2 MonthOfYear
    d)
      where
        (Year
    y, MonthOfYear
    m, MonthOfYear
    d) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    date

    -- | The number of days in a given month according to the proleptic Gregorian calendar.
    gregorianMonthLength :: Year -> MonthOfYear -> DayOfMonth
    gregorianMonthLength :: Year -> MonthOfYear -> MonthOfYear
    gregorianMonthLength Year
    year = Bool -> MonthOfYear -> MonthOfYear
    monthLength (Year -> Bool
    isLeapYear Year
    year)

    rolloverMonths :: (Year, Integer) -> (Year, MonthOfYear)
    rolloverMonths :: (Year, Year) -> (Year, MonthOfYear)
    rolloverMonths (Year
    y, Year
    m) = (Year
    y Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + (Year -> Year -> Year
    forall a. Integral a => a -> a -> a
    div (Year
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1) Year
    12), Year -> MonthOfYear
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Year -> Year -> Year
    forall a. Integral a => a -> a -> a
    mod (Year
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1) Year
    12) MonthOfYear -> MonthOfYear -> MonthOfYear
    forall a. Num a => a -> a -> a
    + MonthOfYear
    1)

    addGregorianMonths :: Integer -> Day -> (Year, MonthOfYear, DayOfMonth)
    addGregorianMonths :: Year -> Day -> (Year, MonthOfYear, MonthOfYear)
    addGregorianMonths Year
    n Day
    day = (Year
    y', MonthOfYear
    m', MonthOfYear
    d)
      where
        (Year
    y, MonthOfYear
    m, MonthOfYear
    d) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    day
        (Year
    y', MonthOfYear
    m') = (Year, Year) -> (Year, MonthOfYear)
    rolloverMonths (Year
    y, MonthOfYear -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral MonthOfYear
    m Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + Year
    n)

    -- | Add months, with days past the last day of the month clipped to the last day.
    -- For instance, 2005-01-30 + 1 month = 2005-02-28.
    addGregorianMonthsClip :: Integer -> Day -> Day
    addGregorianMonthsClip :: Year -> Day -> Day
    addGregorianMonthsClip Year
    n Day
    day = Year -> MonthOfYear -> MonthOfYear -> Day
    fromGregorian Year
    y MonthOfYear
    m MonthOfYear
    d
      where
        (Year
    y, MonthOfYear
    m, MonthOfYear
    d) = Year -> Day -> (Year, MonthOfYear, MonthOfYear)
    addGregorianMonths Year
    n Day
    day

    -- | Add months, with days past the last day of the month rolling over to the next month.
    -- For instance, 2005-01-30 + 1 month = 2005-03-02.
    addGregorianMonthsRollOver :: Integer -> Day -> Day
    addGregorianMonthsRollOver :: Year -> Day -> Day
    addGregorianMonthsRollOver Year
    n Day
    day = Year -> Day -> Day
    addDays (MonthOfYear -> Year
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral MonthOfYear
    d Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1) (Year -> MonthOfYear -> MonthOfYear -> Day
    fromGregorian Year
    y MonthOfYear
    m MonthOfYear
    1)
      where
        (Year
    y, MonthOfYear
    m, MonthOfYear
    d) = Year -> Day -> (Year, MonthOfYear, MonthOfYear)
    addGregorianMonths Year
    n Day
    day

    -- | Add years, matching month and day, with Feb 29th clipped to Feb 28th if necessary.
    -- For instance, 2004-02-29 + 2 years = 2006-02-28.
    addGregorianYearsClip :: Integer -> Day -> Day
    addGregorianYearsClip :: Year -> Day -> Day
    addGregorianYearsClip Year
    n = Year -> Day -> Day
    addGregorianMonthsClip (Year
    n Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12)

    -- | Add years, matching month and day, with Feb 29th rolled over to Mar 1st if necessary.
    -- For instance, 2004-02-29 + 2 years = 2006-03-01.
    addGregorianYearsRollOver :: Integer -> Day -> Day
    addGregorianYearsRollOver :: Year -> Day -> Day
    addGregorianYearsRollOver Year
    n = Year -> Day -> Day
    addGregorianMonthsRollOver (Year
    n Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12)

    -- | Add months (clipped to last day), then add days
    addGregorianDurationClip :: CalendarDiffDays -> Day -> Day
    addGregorianDurationClip :: CalendarDiffDays -> Day -> Day
    addGregorianDurationClip (CalendarDiffDays Year
    m Year
    d) Day
    day = Year -> Day -> Day
    addDays Year
    d (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Year -> Day -> Day
    addGregorianMonthsClip Year
    m Day
    day

    -- | Add months (rolling over to next month), then add days
    addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day
    addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day
    addGregorianDurationRollOver (CalendarDiffDays Year
    m Year
    d) Day
    day = Year -> Day -> Day
    addDays Year
    d (Day -> Day) -> Day -> Day
    forall a b. (a -> b) -> a -> b
    $ Year -> Day -> Day
    addGregorianMonthsRollOver Year
    m Day
    day

    -- | Calendrical difference, with as many whole months as possible
    diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays
    diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays
    diffGregorianDurationClip Day
    day2 Day
    day1 = let
        (Year
    y1, MonthOfYear
    m1, MonthOfYear
    d1) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    day1
        (Year
    y2, MonthOfYear
    m2, MonthOfYear
    d2) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    day2
        ym1 :: Year
    ym1 = Year
    y1 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m1
        ym2 :: Year
    ym2 = Year
    y2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m2
        ymdiff :: Year
    ymdiff = Year
    ym2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    ym1
        ymAllowed :: Year
    ymAllowed =
            if Day
    day2 Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    day1
                then
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    >= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1
                else
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + Year
    1
        dayAllowed :: Day
    dayAllowed = CalendarDiffDays -> Day -> Day
    addGregorianDurationClip (Year -> Year -> CalendarDiffDays
    CalendarDiffDays Year
    ymAllowed Year
    0) Day
    day1
        in Year -> Year -> CalendarDiffDays
    CalendarDiffDays Year
    ymAllowed (Year -> CalendarDiffDays) -> Year -> CalendarDiffDays
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Year
    diffDays Day
    day2 Day
    dayAllowed

    -- | Calendrical difference, with as many whole months as possible.
    -- Same as 'diffGregorianDurationClip' for positive durations.
    diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
    diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
    diffGregorianDurationRollOver Day
    day2 Day
    day1 = let
        (Year
    y1, MonthOfYear
    m1, MonthOfYear
    d1) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    day1
        (Year
    y2, MonthOfYear
    m2, MonthOfYear
    d2) = Day -> (Year, MonthOfYear, MonthOfYear)
    toGregorian Day
    day2
        ym1 :: Year
    ym1 = Year
    y1 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m1
        ym2 :: Year
    ym2 = Year
    y2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    * Year
    12 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + MonthOfYear -> Year
    forall a. Integral a => a -> Year
    toInteger MonthOfYear
    m2
        ymdiff :: Year
    ymdiff = Year
    ym2 Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    ym1
        ymAllowed :: Year
    ymAllowed =
            if Day
    day2 Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    day1
                then
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    >= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    - Year
    1
                else
                    if MonthOfYear
    d2 MonthOfYear -> MonthOfYear -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MonthOfYear
    d1
                        then Year
    ymdiff
                        else Year
    ymdiff Year -> Year -> Year
    forall a. Num a => a -> a -> a
    + Year
    1
        dayAllowed :: Day
    dayAllowed = CalendarDiffDays -> Day -> Day
    addGregorianDurationRollOver (Year -> Year -> CalendarDiffDays
    CalendarDiffDays Year
    ymAllowed Year
    0) Day
    day1
        in Year -> Year -> CalendarDiffDays
    CalendarDiffDays Year
    ymAllowed (Year -> CalendarDiffDays) -> Year -> CalendarDiffDays
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Year
    diffDays Day
    day2 Day
    dayAllowed

    -- orphan instance
    instance Show Day where
        show :: Day -> String
    show = Day -> String
    showGregorian

    -- orphan instance
    instance DayPeriod Year where
        periodFirstDay :: Year -> Day
    periodFirstDay Year
    y = Year -> MonthOfYear -> MonthOfYear -> Day
    YearMonthDay Year
    y MonthOfYear
    January MonthOfYear
    1
        periodLastDay :: Year -> Day
    periodLastDay Year
    y = Year -> MonthOfYear -> MonthOfYear -> Day
    YearMonthDay Year
    y MonthOfYear
    December MonthOfYear
    31
        dayPeriod :: Day -> Year
    dayPeriod (YearMonthDay Year
    y MonthOfYear
    _ MonthOfYear
    _) = Year
    y