{-# OPTIONS -fno-warn-orphans #-}
module Data.Time.Calendar.Gregorian
(
    -- * Gregorian calendar
    toGregorian,fromGregorian,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.MonthDay
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Days
import Data.Time.Calendar.CalendarDiffDays
import Data.Time.Calendar.Private

-- | Convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31).
toGregorian :: Day -> (Integer,Int,Int)
toGregorian :: Day -> (Integer, Int, Int)
toGregorian Day
date = (Integer
year,Int
month,Int
day) where
    (Integer
year,Int
yd) = Day -> (Integer, Int)
toOrdinalDate Day
date
    (Int
month,Int
day) = Bool -> Int -> (Int, Int)
dayOfYearToMonthAndDay (Integer -> Bool
isLeapYear Integer
year) Int
yd

-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
-- Invalid values will be clipped to the correct range, month first, then day.
fromGregorian :: Integer -> Int -> Int -> Day
fromGregorian :: Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day = Integer -> Int -> Day
fromOrdinalDate Integer
year (Bool -> Int -> Int -> Int
monthAndDayToDayOfYear (Integer -> Bool
isLeapYear Integer
year) Int
month Int
day)

-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
-- Invalid values will return Nothing
fromGregorianValid :: Integer -> Int -> Int -> Maybe Day
fromGregorianValid :: Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day = do
    Int
doy <- Bool -> Int -> Int -> Maybe Int
monthAndDayToDayOfYearValid (Integer -> Bool
isLeapYear Integer
year) Int
month Int
day
    Integer -> Int -> Maybe Day
fromOrdinalDateValid Integer
year Int
doy

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

-- | The number of days in a given month according to the proleptic Gregorian calendar. First argument is year, second is month.
gregorianMonthLength :: Integer -> Int -> Int
gregorianMonthLength :: Integer -> Int -> Int
gregorianMonthLength Integer
year = Bool -> Int -> Int
monthLength (Integer -> Bool
isLeapYear Integer
year)

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

addGregorianMonths :: Integer -> Day -> (Integer,Int,Int)
addGregorianMonths :: Integer -> Day -> (Integer, Int, Int)
addGregorianMonths Integer
n Day
day = (Integer
y',Int
m',Int
d) where
    (Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
    (Integer
y',Int
m') = (Integer, Integer) -> (Integer, Int)
rolloverMonths (Integer
y,Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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 :: Integer -> Day -> Day
addGregorianMonthsClip Integer
n Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d where
    (Integer
y,Int
m,Int
d) = Integer -> Day -> (Integer, Int, Int)
addGregorianMonths Integer
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 :: Integer -> Day -> Day
addGregorianMonthsRollOver Integer
n Day
day = Integer -> Day -> Day
addDays (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
1) where
    (Integer
y,Int
m,Int
d) = Integer -> Day -> (Integer, Int, Int)
addGregorianMonths Integer
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 :: Integer -> Day -> Day
addGregorianYearsClip Integer
n = Integer -> Day -> Day
addGregorianMonthsClip (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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 :: Integer -> Day -> Day
addGregorianYearsRollOver Integer
n = Integer -> Day -> Day
addGregorianMonthsRollOver (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12)

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

-- | Add months (rolling over to next month), then add days
addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day
addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day
addGregorianDurationRollOver (CalendarDiffDays Integer
m Integer
d) Day
day = Integer -> Day -> Day
addDays Integer
d (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianMonthsRollOver Integer
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
    (Integer
y1,Int
m1,Int
d1) = Day -> (Integer, Int, Int)
toGregorian Day
day1
    (Integer
y2,Int
m2,Int
d2) = Day -> (Integer, Int, Int)
toGregorian Day
day2
    ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m1
    ym2 :: Integer
ym2 = Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m2
    ymdiff :: Integer
ymdiff = Integer
ym2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ym1
    ymAllowed :: Integer
ymAllowed =
        if Day
day2 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
day1 then
        if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
        else if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
    dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addGregorianDurationClip (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed Integer
0) Day
day1
    in Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed (Integer -> CalendarDiffDays) -> Integer -> CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
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
    (Integer
y1,Int
m1,Int
d1) = Day -> (Integer, Int, Int)
toGregorian Day
day1
    (Integer
y2,Int
m2,Int
d2) = Day -> (Integer, Int, Int)
toGregorian Day
day2
    ym1 :: Integer
ym1 = Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m1
    ym2 :: Integer
ym2 = Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
m2
    ymdiff :: Integer
ymdiff = Integer
ym2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ym1
    ymAllowed :: Integer
ymAllowed =
        if Day
day2 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
day1 then
        if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
        else if Int
d2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d1 then Integer
ymdiff else Integer
ymdiff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
    dayAllowed :: Day
dayAllowed = CalendarDiffDays -> Day -> Day
addGregorianDurationRollOver (Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed Integer
0) Day
day1
    in Integer -> Integer -> CalendarDiffDays
CalendarDiffDays Integer
ymAllowed (Integer -> CalendarDiffDays) -> Integer -> CalendarDiffDays
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
day2 Day
dayAllowed

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