1{-# LANGUAGE CPP #-}
2module Data.Time.Calendar.Julian.Compat (
3
4    toJulianYearAndDay,
5    fromJulianYearAndDay,
6    fromJulianYearAndDayValid,
7    showJulianYearAndDay,
8    isJulianLeapYear,
9
10    toJulian,fromJulian,fromJulianValid,showJulian,julianMonthLength,
11
12    -- calendrical arithmetic
13    -- e.g. "one month after March 31st"
14    addJulianMonthsClip,addJulianMonthsRollOver,
15    addJulianYearsClip,addJulianYearsRollOver,
16    addJulianDurationClip,addJulianDurationRollOver,
17    diffJulianDurationClip,diffJulianDurationRollOver,
18    ) where
19
20import Data.Time.Orphans ()
21
22import Data.Time.Calendar.Julian
23import Data.Time.Calendar.Compat
24
25#if !MIN_VERSION_time(1,9,0)
26
27-- | Add months (clipped to last day), then add days
28addJulianDurationClip :: CalendarDiffDays -> Day -> Day
29addJulianDurationClip (CalendarDiffDays m d) day = addDays d $ addJulianMonthsClip m day
30
31-- | Add months (rolling over to next month), then add days
32addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
33addJulianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addJulianMonthsRollOver m day
34
35-- | Calendrical difference, with as many whole months as possible
36diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
37diffJulianDurationClip day2 day1 = let
38    (y1,m1,d1) = toJulian day1
39    (y2,m2,d2) = toJulian day2
40    ym1 = y1 * 12 + toInteger m1
41    ym2 = y2 * 12 + toInteger m2
42    ymdiff = ym2 - ym1
43    ymAllowed =
44        if day2 >= day1 then
45        if d2 >= d1 then ymdiff else ymdiff - 1
46        else if d2 <= d1 then ymdiff else ymdiff + 1
47    dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1
48    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
49
50-- | Calendrical difference, with as many whole months as possible.
51-- Same as 'diffJulianDurationClip' for positive durations.
52diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
53diffJulianDurationRollOver day2 day1 = let
54    (y1,m1,d1) = toJulian day1
55    (y2,m2,d2) = toJulian day2
56    ym1 = y1 * 12 + toInteger m1
57    ym2 = y2 * 12 + toInteger m2
58    ymdiff = ym2 - ym1
59    ymAllowed =
60        if day2 >= day1 then
61        if d2 >= d1 then ymdiff else ymdiff - 1
62        else if d2 <= d1 then ymdiff else ymdiff + 1
63    dayAllowed = addJulianDurationRollOver (CalendarDiffDays ymAllowed 0) day1
64    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
65
66#endif
67