99b08018079a847f27f9d2b4dd0776d7c52ff578
[packages/time.git] / lib / Data / Time / Calendar / MonthDay.hs
1 module Data.Time.Calendar.MonthDay
2 (
3 monthAndDayToDayOfYear,monthAndDayToDayOfYearValid,dayOfYearToMonthAndDay,monthLength
4 ) where
5
6 import Data.Time.Calendar.Private
7
8 -- | Convert month and day in the Gregorian or Julian calendars to day of year.
9 -- First arg is leap year flag.
10 monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int
11 monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where
12 month' = clip 1 12 month
13 day' = fromIntegral (clip 1 (monthLength' isLeap month') day)
14 month'' = fromIntegral month'
15 k = if month' <= 2 then 0 else if isLeap then -1 else -2
16
17 -- | Convert month and day in the Gregorian or Julian calendars to day of year.
18 -- First arg is leap year flag.
19 monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int
20 monthAndDayToDayOfYearValid isLeap month day = do
21 month' <- clipValid 1 12 month
22 day' <- clipValid 1 (monthLength' isLeap month') day
23 let
24 day'' = fromIntegral day'
25 month'' = fromIntegral month'
26 k = if month' <= 2 then 0 else if isLeap then -1 else -2
27 return ((div (367 * month'' - 362) 12) + k + day'')
28
29 -- | Convert day of year in the Gregorian or Julian calendars to month and day.
30 -- First arg is leap year flag.
31 dayOfYearToMonthAndDay :: Bool -> Int -> (Int,Int)
32 dayOfYearToMonthAndDay isLeap yd = findMonthDay (monthLengths isLeap) (clip 1 (if isLeap then 366 else 365) yd)
33
34 findMonthDay :: [Int] -> Int -> (Int,Int)
35 findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n))
36 findMonthDay _ yd = (1,yd)
37
38 -- | The length of a given month in the Gregorian or Julian calendars.
39 -- First arg is leap year flag.
40 monthLength :: Bool -> Int -> Int
41 monthLength isLeap month' = monthLength' isLeap (clip 1 12 month')
42
43 monthLength' :: Bool -> Int -> Int
44 monthLength' isLeap month' = (monthLengths isLeap) !! (month' - 1)
45
46 monthLengths :: Bool -> [Int]
47 monthLengths isleap =
48 [31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]
49 --J F M A M J J A S O N D