1-- | ISO 8601 Ordinal Date format
2module Data.Time.Calendar.OrdinalDate where
3
4import Data.Time.Calendar.Days
5import Data.Time.Calendar.Private
6
7-- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar),
8-- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.
9toOrdinalDate :: Day -> (Integer,Int)
10toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where
11    a = mjd + 678575
12    quadcent = div a 146097
13    b = mod a 146097
14    cent = min (div b 36524) 3
15    c = b - (cent * 36524)
16    quad = div c 1461
17    d = mod c 1461
18    y = min (div d 365) 3
19    yd = fromInteger (d - (y * 365) + 1)
20    year = quadcent * 400 + cent * 100 + quad * 4 + y + 1
21
22-- | Convert from ISO 8601 Ordinal Date format.
23-- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
24fromOrdinalDate :: Integer -> Int -> Day
25fromOrdinalDate year day = ModifiedJulianDay mjd where
26    y = year - 1
27    mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576
28
29-- | Convert from ISO 8601 Ordinal Date format.
30-- Invalid day numbers return 'Nothing'
31fromOrdinalDateValid :: Integer -> Int -> Maybe Day
32fromOrdinalDateValid year day = do
33    day' <- clipValid 1 (if isLeapYear year then 366 else 365) day
34    let
35        y = year - 1
36        mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576
37    return (ModifiedJulianDay mjd)
38
39-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd)
40showOrdinalDate :: Day -> String
41showOrdinalDate date = (show4 y) ++ "-" ++ (show3 d) where
42    (y,d) = toOrdinalDate date
43
44-- | Is this year a leap year according to the proleptic Gregorian calendar?
45isLeapYear :: Integer -> Bool
46isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))
47
48-- | Get the number of the Monday-starting week in the year and the day of the week.
49-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
50-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
51mondayStartWeek :: Day -> (Int,Int)
52mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where
53    yd = snd (toOrdinalDate date)
54    d = (toModifiedJulianDay date) + 2
55    k = d - (toInteger yd)
56
57-- | Get the number of the Sunday-starting week in the year and the day of the week.
58-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
59-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
60sundayStartWeek :: Day -> (Int,Int)
61sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where
62    yd = snd (toOrdinalDate date)
63    d = (toModifiedJulianDay date) + 3
64    k = d - (toInteger yd)
65
66-- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year,
67-- the number of the Monday-starting week, and the day of the week.
68-- The first Monday is the first day of week 1, any earlier days in the year
69-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
70fromMondayStartWeek :: Integer -- ^ Year.
71                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
72                    -> Int     -- ^ Day of week.
73                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
74                    -> Day
75fromMondayStartWeek year w d = let
76    -- first day of the year
77    firstDay = fromOrdinalDate year 1
78
79    -- 0-based year day of first monday of the year
80    zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7
81
82    -- 0-based week of year
83    zbWeek = w - 1
84
85    -- 0-based day of week
86    zbDay = d - 1
87
88    -- 0-based day in year
89    zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay
90
91    in addDays zbYearDay firstDay
92
93fromMondayStartWeekValid :: Integer -- ^ Year.
94                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
95                    -> Int     -- ^ Day of week.
96                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
97                    -> Maybe Day
98fromMondayStartWeekValid year w d = do
99    d' <- clipValid 1 7 d
100    let
101        -- first day of the year
102        firstDay = fromOrdinalDate year 1
103
104        -- 0-based week of year
105        zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7
106
107        -- 0-based week number
108        zbWeek = w - 1
109
110        -- 0-based day of week
111        zbDay = d' - 1
112
113        -- 0-based day in year
114        zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay
115
116    zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay
117    return $ addDays zbYearDay' firstDay
118
119-- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and
120-- the number of the day of a Sunday-starting week.
121-- The first Sunday is the first day of week 1, any earlier days in the
122-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
123fromSundayStartWeek :: Integer -- ^ Year.
124                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
125                    -> Int     -- ^ Day of week
126                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
127                    -> Day
128fromSundayStartWeek year w d = let
129    -- first day of the year
130    firstDay = fromOrdinalDate year 1
131
132    -- 0-based year day of first monday of the year
133    zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7
134
135    -- 0-based week of year
136    zbWeek = w - 1
137
138    -- 0-based day of week
139    zbDay = d
140
141    -- 0-based day in year
142    zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay
143
144    in addDays zbYearDay firstDay
145
146fromSundayStartWeekValid :: Integer -- ^ Year.
147                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
148                    -> Int     -- ^ Day of week.
149                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
150                    -> Maybe Day
151fromSundayStartWeekValid year w d =  do
152    d' <- clipValid 0 6 d
153    let
154        -- first day of the year
155        firstDay = fromOrdinalDate year 1
156
157        -- 0-based week of year
158        zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7
159
160        -- 0-based week number
161        zbWeek = w - 1
162
163        -- 0-based day of week
164        zbDay = d'
165
166        -- 0-based day in year
167        zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay
168
169    zbYearDay' <- clipValid 0 (if isLeapYear year then 365 else 364) zbYearDay
170    return $ addDays zbYearDay' firstDay
171