{-# 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.
diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffGregorianDurationRollOver Day
day2 Day
day1 =
    let
        (Year
y1, MonthOfYear
m1, MonthOfYear
_) = Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian Day
day1
        (Year
y2, MonthOfYear
m2, MonthOfYear
_) = 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
        findpos :: Year -> CalendarDiffDays
findpos Year
mdiff =
            let
                dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addGregorianDurationRollOver (Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
mdiff Year
0) Day
day1
                dd :: Year
dd = Day -> Day -> Year
diffDays Day
day2 Day
dayAllowed
            in
                if Year
dd Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
>= Year
0 then Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
mdiff Year
dd else Year -> CalendarDiffDays
findpos (Year -> Year
forall a. Enum a => a -> a
pred Year
mdiff)
        findneg :: Year -> CalendarDiffDays
findneg Year
mdiff =
            let
                dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addGregorianDurationRollOver (Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
mdiff Year
0) Day
day1
                dd :: Year
dd = Day -> Day -> Year
diffDays Day
day2 Day
dayAllowed
            in
                if Year
dd Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
<= Year
0 then Year -> Year -> CalendarDiffDays
CalendarDiffDays Year
mdiff Year
dd else Year -> CalendarDiffDays
findpos (Year -> Year
forall a. Enum a => a -> a
succ Year
mdiff)
    in
        if Day
day2 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
day1
            then Year -> CalendarDiffDays
findpos Year
ymdiff
            else Year -> CalendarDiffDays
findneg Year
ymdiff

-- 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