1{-# LANGUAGE CPP                #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3#if __GLASGOW_HASKELL__ >= 710
4{-# LANGUAGE PatternSynonyms    #-}
5{-# LANGUAGE ViewPatterns       #-}
6#endif
7module Data.Time.Calendar.Compat (
8    -- * Days
9    Day(..),addDays,diffDays,
10
11    -- * CalendarDiffTime
12    CalendarDiffDays (..),
13    calendarDay,calendarWeek,calendarMonth,calendarYear,scaleCalendarDiffDays,
14
15    -- * Gregorian calendar
16    toGregorian,fromGregorian,fromGregorianValid,showGregorian,gregorianMonthLength,
17
18    -- calendrical arithmetic
19    -- e.g. "one month after March 31st"
20    addGregorianMonthsClip,addGregorianMonthsRollOver,
21    addGregorianYearsClip,addGregorianYearsRollOver,
22    addGregorianDurationClip,addGregorianDurationRollOver,
23    diffGregorianDurationClip,diffGregorianDurationRollOver,
24
25    -- re-exported from OrdinalDate
26    isLeapYear ,
27
28      -- * Week
29    DayOfWeek(..), dayOfWeek,
30    dayOfWeekDiff, firstDayOfWeekOnAfter,
31
32    -- * Type aliases
33    DayOfMonth, MonthOfYear, Year,
34#if __GLASGOW_HASKELL__ >= 710
35    pattern YearMonthDay,
36#endif
37    ) where
38
39import Data.Time.Calendar
40import Data.Time.Format
41import Data.Time.Orphans ()
42
43#if !MIN_VERSION_time(1,11,0)
44import Data.Time.Calendar.Types
45#endif
46
47#if !MIN_VERSION_time(1,9,0)
48import Data.Time.Calendar.WeekDate.Compat
49#endif
50
51#if !MIN_VERSION_time(1,5,0)
52import System.Locale (TimeLocale (..))
53#endif
54
55import Control.DeepSeq (NFData (..))
56import Data.Data       (Data, Typeable)
57import Data.Monoid     (Monoid (..))
58import Data.Semigroup  (Semigroup (..))
59
60-------------------------------------------------------------------------------
61-- CalendarDiffTime
62-------------------------------------------------------------------------------
63
64#if MIN_VERSION_time(1,9,0) && !MIN_VERSION_time(1,9,2)
65deriving instance Typeable CalendarDiffDays
66deriving instance Data CalendarDiffDays
67#endif
68
69#if !MIN_VERSION_time(1,9,0)
70
71data CalendarDiffDays = CalendarDiffDays
72    { cdMonths :: Integer
73    , cdDays :: Integer
74    } deriving (Eq,
75    Data
76#if __GLASGOW_HASKELL__ >= 802
77#endif
78    ,Typeable
79#if __GLASGOW_HASKELL__ >= 802
80#endif
81    )
82
83-- | Additive
84instance Semigroup CalendarDiffDays where
85    CalendarDiffDays m1 d1 <> CalendarDiffDays m2 d2 = CalendarDiffDays (m1 + m2) (d1 + d2)
86
87-- | Additive
88instance Monoid CalendarDiffDays where
89    mempty  = CalendarDiffDays 0 0
90    mappend = (<>)
91
92instance Show CalendarDiffDays where
93    show (CalendarDiffDays m d) = "P" ++ show m ++ "M" ++ show d ++ "D"
94
95instance NFData CalendarDiffDays where
96    rnf (CalendarDiffDays x y) = rnf x `seq` rnf y
97
98calendarDay :: CalendarDiffDays
99calendarDay = CalendarDiffDays 0 1
100
101calendarWeek :: CalendarDiffDays
102calendarWeek = CalendarDiffDays 0 7
103
104calendarMonth :: CalendarDiffDays
105calendarMonth = CalendarDiffDays 1 0
106
107calendarYear :: CalendarDiffDays
108calendarYear = CalendarDiffDays 12 0
109
110-- | Scale by a factor. Note that @scaleCalendarDiffDays (-1)@ will not perfectly invert a duration, due to variable month lengths.
111scaleCalendarDiffDays :: Integer -> CalendarDiffDays -> CalendarDiffDays
112scaleCalendarDiffDays k (CalendarDiffDays m d) = CalendarDiffDays (k * m) (k * d)
113
114#endif
115
116-------------------------------------------------------------------------------
117-- Gregorian
118-------------------------------------------------------------------------------
119
120#if !MIN_VERSION_time(1,9,0)
121
122-- | Add months (clipped to last day), then add days
123addGregorianDurationClip :: CalendarDiffDays -> Day -> Day
124addGregorianDurationClip (CalendarDiffDays m d) day = addDays d $ addGregorianMonthsClip m day
125
126-- | Add months (rolling over to next month), then add days
127addGregorianDurationRollOver :: CalendarDiffDays -> Day -> Day
128addGregorianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addGregorianMonthsRollOver m day
129
130-- | Calendrical difference, with as many whole months as possible
131diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays
132diffGregorianDurationClip day2 day1 = let
133    (y1,m1,d1) = toGregorian day1
134    (y2,m2,d2) = toGregorian day2
135    ym1 = y1 * 12 + toInteger m1
136    ym2 = y2 * 12 + toInteger m2
137    ymdiff = ym2 - ym1
138    ymAllowed =
139        if day2 >= day1 then
140        if d2 >= d1 then ymdiff else ymdiff - 1
141        else if d2 <= d1 then ymdiff else ymdiff + 1
142    dayAllowed = addGregorianDurationClip (CalendarDiffDays ymAllowed 0) day1
143    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
144
145-- | Calendrical difference, with as many whole months as possible.
146-- Same as 'diffGregorianDurationClip' for positive durations.
147diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
148diffGregorianDurationRollOver day2 day1 = let
149    (y1,m1,d1) = toGregorian day1
150    (y2,m2,d2) = toGregorian day2
151    ym1 = y1 * 12 + toInteger m1
152    ym2 = y2 * 12 + toInteger m2
153    ymdiff = ym2 - ym1
154    ymAllowed =
155        if day2 >= day1 then
156        if d2 >= d1 then ymdiff else ymdiff - 1
157        else if d2 <= d1 then ymdiff else ymdiff + 1
158    dayAllowed = addGregorianDurationRollOver (CalendarDiffDays ymAllowed 0) day1
159    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
160
161#endif
162
163#if !MIN_VERSION_time(1,11,0)
164#if __GLASGOW_HASKELL__ >= 710
165-- | Bidirectional abstract constructor for the proleptic Gregorian calendar.
166-- Invalid values will be clipped to the correct range, month first, then day.
167pattern YearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
168pattern YearMonthDay y m d <- (toGregorian -> (y,m,d)) where
169    YearMonthDay y m d = fromGregorian y m d
170
171#if __GLASGOW_HASKELL__ >= 802
172{-# COMPLETE YearMonthDay #-}
173#endif
174#endif
175#endif
176
177-------------------------------------------------------------------------------
178-- DayOfWeek
179-------------------------------------------------------------------------------
180
181#if !MIN_VERSION_time(1,11,0)
182-- | @dayOfWeekDiff a b = a - b@ in range 0 to 6.
183-- The number of days from b to the next a.
184dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int
185dayOfWeekDiff a b = mod (fromEnum a - fromEnum b) 7
186
187-- | The first day-of-week on or after some day
188firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
189firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d
190#endif
191