1{-# LANGUAGE CPP #-}
2#if __GLASGOW_HASKELL__ >= 710
3{-# LANGUAGE PatternSynonyms #-}
4{-# LANGUAGE ViewPatterns    #-}
5#endif
6module Data.Time.Calendar.Julian.Compat (
7    Year, MonthOfYear, DayOfMonth, DayOfYear,
8
9    -- JulianYearDay
10    toJulianYearAndDay,
11    fromJulianYearAndDay,
12    fromJulianYearAndDayValid,
13    showJulianYearAndDay,
14    isJulianLeapYear,
15
16    toJulian,fromJulian,
17#if __GLASGOW_HASKELL__ >= 710
18    pattern JulianYearMonthDay,
19#endif
20    fromJulianValid,showJulian,julianMonthLength,
21
22    -- calendrical arithmetic
23    -- e.g. "one month after March 31st"
24    addJulianMonthsClip,addJulianMonthsRollOver,
25    addJulianYearsClip,addJulianYearsRollOver,
26    addJulianDurationClip,addJulianDurationRollOver,
27    diffJulianDurationClip,diffJulianDurationRollOver,
28) where
29
30import Data.Time.Orphans ()
31
32import Data.Time.Calendar.Julian
33import Data.Time.Calendar.Compat
34
35#if !MIN_VERSION_time(1,11,0)
36import Data.Time.Calendar.Types
37#endif
38
39#if !MIN_VERSION_time(1,9,0)
40
41-- | Add months (clipped to last day), then add days
42addJulianDurationClip :: CalendarDiffDays -> Day -> Day
43addJulianDurationClip (CalendarDiffDays m d) day = addDays d $ addJulianMonthsClip m day
44
45-- | Add months (rolling over to next month), then add days
46addJulianDurationRollOver :: CalendarDiffDays -> Day -> Day
47addJulianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addJulianMonthsRollOver m day
48
49-- | Calendrical difference, with as many whole months as possible
50diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
51diffJulianDurationClip day2 day1 = let
52    (y1,m1,d1) = toJulian day1
53    (y2,m2,d2) = toJulian day2
54    ym1 = y1 * 12 + toInteger m1
55    ym2 = y2 * 12 + toInteger m2
56    ymdiff = ym2 - ym1
57    ymAllowed =
58        if day2 >= day1 then
59        if d2 >= d1 then ymdiff else ymdiff - 1
60        else if d2 <= d1 then ymdiff else ymdiff + 1
61    dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1
62    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
63
64-- | Calendrical difference, with as many whole months as possible.
65-- Same as 'diffJulianDurationClip' for positive durations.
66diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
67diffJulianDurationRollOver day2 day1 = let
68    (y1,m1,d1) = toJulian day1
69    (y2,m2,d2) = toJulian day2
70    ym1 = y1 * 12 + toInteger m1
71    ym2 = y2 * 12 + toInteger m2
72    ymdiff = ym2 - ym1
73    ymAllowed =
74        if day2 >= day1 then
75        if d2 >= d1 then ymdiff else ymdiff - 1
76        else if d2 <= d1 then ymdiff else ymdiff + 1
77    dayAllowed = addJulianDurationRollOver (CalendarDiffDays ymAllowed 0) day1
78    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
79
80#endif
81
82#if !MIN_VERSION_time(1,11,0)
83#if __GLASGOW_HASKELL__ >= 710
84-- | Bidirectional abstract constructor for the proleptic Julian calendar.
85-- Invalid values will be clipped to the correct range, month first, then day.
86pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
87pattern JulianYearMonthDay y m d <- (toJulian -> (y,m,d)) where
88    JulianYearMonthDay y m d = fromJulian y m d
89
90#if __GLASGOW_HASKELL__ >= 802
91{-# COMPLETE JulianYearMonthDay #-}
92#endif
93#endif
94#endif
95