{-# OPTIONS -Wall -Werror #-} module Data.Time.Calendar.Julian ( module Data.Time.Calendar.JulianYearDay, toJulian,fromJulian,showJulian,julianMonthLength, -- calendrical arithmetic -- e.g. "one month after March 31st" addJulianMonthsClip,addJulianMonthsRollOver, addJulianYearsClip,addJulianYearsRollOver ) where import Data.Time.Calendar.MonthDay import Data.Time.Calendar.JulianYearDay import Data.Time.Calendar.Days import Data.Time.Calendar.Private -- | convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31). toJulian :: Day -> (Integer,Int,Int) toJulian date = (year,month,day) where (year,yd) = toJulianYearAndDay date (month,day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd -- | convert from proleptic Julian 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. fromJulian :: Integer -> Int -> Int -> Day fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day) -- | show in ISO 8601 format (yyyy-mm-dd) showJulian :: Day -> String showJulian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where (y,m,d) = toJulian date -- | The number of days in a given month according to the proleptic Julian calendar. First argument is year, second is month. julianMonthLength :: Integer -> Int -> Int julianMonthLength year = monthLength (isJulianLeapYear year) rolloverMonths :: (Integer,Integer) -> (Integer,Int) rolloverMonths (y,m) = (y + (div (m - 1) 12),fromIntegral (mod (m - 1) 12) + 1) addJulianMonths :: Integer -> Day -> (Integer,Int,Int) addJulianMonths n day = (y',m',d) where (y,m,d) = toJulian day (y',m') = rolloverMonths (y,fromIntegral m + 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. addJulianMonthsClip :: Integer -> Day -> Day addJulianMonthsClip n day = fromJulian y m d where (y,m,d) = addJulianMonths n 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. addJulianMonthsRollOver :: Integer -> Day -> Day addJulianMonthsRollOver n day = addDays (fromIntegral d - 1) (fromJulian y m 1) where (y,m,d) = addJulianMonths n 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. addJulianYearsClip :: Integer -> Day -> Day addJulianYearsClip n = addJulianMonthsClip (n * 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. addJulianYearsRollOver :: Integer -> Day -> Day addJulianYearsRollOver n = addJulianMonthsRollOver (n * 12)