59a8edf99bf3949df9e4181993e6f8622e02a627
[packages/time.git] / lib / Data / Time / Calendar / OrdinalDate.hs
1 -- | ISO 8601 Ordinal Date format
2 module Data.Time.Calendar.OrdinalDate where
3
4 import Data.Time.Calendar.Days
5 import 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.
9 toOrdinalDate :: Day -> (Integer,Int)
10 toOrdinalDate (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).
24 fromOrdinalDate :: Integer -> Int -> Day
25 fromOrdinalDate 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'
31 fromOrdinalDateValid :: Integer -> Int -> Maybe Day
32 fromOrdinalDateValid 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)
40 showOrdinalDate :: Day -> String
41 showOrdinalDate 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?
45 isLeapYear :: Integer -> Bool
46 isLeapYear 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').
51 mondayStartWeek :: Day -> (Int,Int)
52 mondayStartWeek 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').
60 sundayStartWeek :: Day -> (Int,Int)
61 sundayStartWeek 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').
70 fromMondayStartWeek :: 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
75 fromMondayStartWeek 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
93 fromMondayStartWeekValid :: 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
98 fromMondayStartWeekValid 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').
123 fromSundayStartWeek :: 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
128 fromSundayStartWeek 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
146 fromSundayStartWeekValid :: 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
151 fromSundayStartWeekValid 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