{-# LANGUAGE CPP #-}
module Data.Time.Calendar.Julian.Compat (
Year, MonthOfYear, DayOfMonth, DayOfYear,
toJulianYearAndDay,
fromJulianYearAndDay,
fromJulianYearAndDayValid,
showJulianYearAndDay,
isJulianLeapYear,
toJulian,fromJulian,
pattern JulianYearMonthDay,
fromJulianValid,showJulian,julianMonthLength,
addJulianMonthsClip,addJulianMonthsRollOver,
addJulianYearsClip,addJulianYearsRollOver,
addJulianDurationClip,addJulianDurationRollOver,
diffJulianDurationClip,diffJulianDurationRollOver,
) where
import Data.Time.Orphans ()
#if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,14,0)
import Data.Time.Calendar.Julian hiding (diffJulianDurationRollOver)
#else
import Data.Time.Calendar.Julian
#endif
import Data.Time.Calendar.Compat
#if !MIN_VERSION_time(1,11,0)
import Data.Time.Calendar.Types
#endif
#if !MIN_VERSION_time(1,9,0)
addJulianDurationClip :: CalendarDiffDays -> Day -> Day
addJulianDurationClip (CalendarDiffDays m d) day = addDays d $ addJulianMonthsClip m day
addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
addJulianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addJulianMonthsRollOver m day
diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
diffJulianDurationClip day2 day1 = let
(y1,m1,d1) = toJulian day1
(y2,m2,d2) = toJulian day2
ym1 = y1 * 12 + toInteger m1
ym2 = y2 * 12 + toInteger m2
ymdiff = ym2 - ym1
ymAllowed =
if day2 >= day1 then
if d2 >= d1 then ymdiff else ymdiff - 1
else if d2 <= d1 then ymdiff else ymdiff + 1
dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1
in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
#endif
#if !MIN_VERSION_time(1,14,0)
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
diffJulianDurationRollOver Day
day2 Day
day1 =
let
(Year
y1, MonthOfYear
m1, MonthOfYear
_) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian Day
day1
(Year
y2, MonthOfYear
m2, MonthOfYear
_) = Day -> (Year, MonthOfYear, MonthOfYear)
toJulian 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
addJulianDurationRollOver (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
addJulianDurationRollOver (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
#endif
#if !MIN_VERSION_time(1,11,0)
pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
pattern JulianYearMonthDay y m d <- (toJulian -> (y,m,d)) where
JulianYearMonthDay y m d = fromJulian y m d
{-# COMPLETE JulianYearMonthDay #-}
#endif