format everything with hindent
[packages/time.git] / lib / Data / Time / Calendar / WeekDate.hs
1 -- | ISO 8601 Week Date format
2 module Data.Time.Calendar.WeekDate where
3
4 import Data.Time.Calendar.Days
5 import Data.Time.Calendar.OrdinalDate
6 import Data.Time.Calendar.Private
7
8 -- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday).
9 -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday.
10 -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year.
11 toWeekDate :: Day -> (Integer, Int, Int)
12 toWeekDate date@(ModifiedJulianDay mjd) = (y1, fromInteger (w1 + 1), fromInteger d_mod_7 + 1)
13 where
14 (d_div_7, d_mod_7) = d `divMod` 7
15 (y0, yd) = toOrdinalDate date
16 d = mjd + 2
17 foo :: Integer -> Integer
18 foo y = bar (toModifiedJulianDay (fromOrdinalDate y 6))
19 bar k = d_div_7 - k `div` 7
20 (y1, w1) =
21 case bar (d - toInteger yd + 4) of
22 -1 -> (y0 - 1, foo (y0 - 1))
23 52 ->
24 if foo (y0 + 1) == 0
25 then (y0 + 1, 0)
26 else (y0, 52)
27 w0 -> (y0, w0)
28
29 -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
30 -- Invalid week and day values will be clipped to the correct range.
31 fromWeekDate :: Integer -> Int -> Int -> Day
32 fromWeekDate y w d =
33 ModifiedJulianDay
34 (k - (mod k 7) +
35 (toInteger
36 (((clip
37 1
38 (if longYear
39 then 53
40 else 52)
41 w) *
42 7) +
43 (clip 1 7 d))) -
44 10)
45 where
46 k = toModifiedJulianDay (fromOrdinalDate y 6)
47 longYear =
48 case toWeekDate (fromOrdinalDate y 365) of
49 (_, 53, _) -> True
50 _ -> False
51
52 -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
53 -- Invalid week and day values will return Nothing.
54 fromWeekDateValid :: Integer -> Int -> Int -> Maybe Day
55 fromWeekDateValid y w d = do
56 d' <- clipValid 1 7 d
57 let
58 longYear =
59 case toWeekDate (fromOrdinalDate y 365) of
60 (_, 53, _) -> True
61 _ -> False
62 w' <-
63 clipValid
64 1
65 (if longYear
66 then 53
67 else 52)
68 w
69 let k = toModifiedJulianDay (fromOrdinalDate y 6)
70 return (ModifiedJulianDay (k - (mod k 7) + (toInteger ((w' * 7) + d')) - 10))
71
72 -- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
73 showWeekDate :: Day -> String
74 showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d)
75 where
76 (y, w, d) = toWeekDate date