module Data.Time.Calendar.Gregorian
(
toGregorian,fromGregorian,showGregorian,gregorianMonthLength,
addGregorianMonthsClip,addGregorianMonthsRollOver,
addGregorianYearsClip,addGregorianYearsRollOver,
isLeapYear
) where
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.Days
import Data.Time.Calendar.Private
toGregorian :: Day -> (Integer,Int,Int)
toGregorian date = (year,month,day) where
(year,yd) = toOrdinalDate date
(month,day) = dayOfYearToMonthAndDay (isLeapYear year) yd
fromGregorian :: Integer -> Int -> Int -> Day
fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day)
showGregorian :: Day -> String
showGregorian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where
(y,m,d) = toGregorian date
gregorianMonthLength :: Integer -> Int -> Int
gregorianMonthLength year = monthLength (isLeapYear year)
rolloverMonths :: (Integer,Integer) -> (Integer,Int)
rolloverMonths (y,m) = (y + (div (m 1) 12),fromIntegral (mod (m 1) 12) + 1)
addGregorianMonths :: Integer -> Day -> (Integer,Int,Int)
addGregorianMonths n day = (y',m',d) where
(y,m,d) = toGregorian day
(y',m') = rolloverMonths (y,fromIntegral m + n)
addGregorianMonthsClip :: Integer -> Day -> Day
addGregorianMonthsClip n day = fromGregorian y m d where
(y,m,d) = addGregorianMonths n day
addGregorianMonthsRollOver :: Integer -> Day -> Day
addGregorianMonthsRollOver n day = addDays (fromIntegral d 1) (fromGregorian y m 1) where
(y,m,d) = addGregorianMonths n day
addGregorianYearsClip :: Integer -> Day -> Day
addGregorianYearsClip n = addGregorianMonthsClip (n * 12)
addGregorianYearsRollOver :: Integer -> Day -> Day
addGregorianYearsRollOver n = addGregorianMonthsRollOver (n * 12)
instance Show Day where
show = showGregorian