{-# 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
    doy <- Bool -> MonthOfYear -> MonthOfYear -> Maybe MonthOfYear
monthAndDayToDayOfYearValid (Year -> Bool
isLeapYear Year
year) MonthOfYear
month MonthOfYear
day
    fromOrdinalDateValid year 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