format everything with hindent
[packages/time.git] / lib / Data / Time / Calendar / MonthDay.hs
1 module Data.Time.Calendar.MonthDay
2 ( monthAndDayToDayOfYear
3 , monthAndDayToDayOfYearValid
4 , dayOfYearToMonthAndDay
5 , monthLength
6 ) where
7
8 import Data.Time.Calendar.Private
9
10 -- | Convert month and day in the Gregorian or Julian calendars to day of year.
11 -- First arg is leap year flag.
12 monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int
13 monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day'
14 where
15 month' = clip 1 12 month
16 day' = fromIntegral (clip 1 (monthLength' isLeap month') day)
17 month'' = fromIntegral month'
18 k =
19 if month' <= 2
20 then 0
21 else if isLeap
22 then -1
23 else -2
24
25 -- | Convert month and day in the Gregorian or Julian calendars to day of year.
26 -- First arg is leap year flag.
27 monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int
28 monthAndDayToDayOfYearValid isLeap month day = do
29 month' <- clipValid 1 12 month
30 day' <- clipValid 1 (monthLength' isLeap month') day
31 let
32 day'' = fromIntegral day'
33 month'' = fromIntegral month'
34 k =
35 if month' <= 2
36 then 0
37 else if isLeap
38 then -1
39 else -2
40 return ((div (367 * month'' - 362) 12) + k + day'')
41
42 -- | Convert day of year in the Gregorian or Julian calendars to month and day.
43 -- First arg is leap year flag.
44 dayOfYearToMonthAndDay :: Bool -> Int -> (Int, Int)
45 dayOfYearToMonthAndDay isLeap yd =
46 findMonthDay
47 (monthLengths isLeap)
48 (clip
49 1
50 (if isLeap
51 then 366
52 else 365)
53 yd)
54
55 findMonthDay :: [Int] -> Int -> (Int, Int)
56 findMonthDay (n:ns) yd
57 | yd > n = (\(m, d) -> (m + 1, d)) (findMonthDay ns (yd - n))
58 findMonthDay _ yd = (1, yd)
59
60 -- | The length of a given month in the Gregorian or Julian calendars.
61 -- First arg is leap year flag.
62 monthLength :: Bool -> Int -> Int
63 monthLength isLeap month' = monthLength' isLeap (clip 1 12 month')
64
65 monthLength' :: Bool -> Int -> Int
66 monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1)
67
68 monthLengths :: Bool -> [Int]
69 monthLengths isleap =
70 [ 31
71 , if isleap
72 then 29
73 else 28
74 , 31
75 , 30
76 , 31
77 , 30
78 , 31
79 , 31
80 , 30
81 , 31
82 , 30
83 , 31
84 ]
85 --J F M A M J J A S O N D