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