{-# LANGUAGE Safe #-}

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

module Data.Time.Calendar.Gregorian (
    -- * Year, month and day
    Year,
    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

-- | 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 $bYearMonthDay :: Year -> MonthOfYear -> MonthOfYear -> Day
$mYearMonthDay :: forall r.
Day
-> (Year -> MonthOfYear -> MonthOfYear -> r) -> (Void# -> r) -> r
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