{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
module Data.Time.Calendar.Gregorian (
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,
toGregorian,
fromGregorian,
pattern YearMonthDay,
fromGregorianValid,
showGregorian,
gregorianMonthLength,
addGregorianMonthsClip,
addGregorianMonthsRollOver,
addGregorianYearsClip,
addGregorianYearsRollOver,
addGregorianDurationClip,
addGregorianDurationRollOver,
diffGregorianDurationClip,
diffGregorianDurationRollOver,
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
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
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)
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 #-}
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
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
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)
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
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
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)
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)
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
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
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
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
instance Show Day where
show :: Day -> String
show = Day -> String
showGregorian
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