|
|
@@ -144,3 +144,52 @@ module Utils where
|
|
|
| d == td = []
|
|
|
| otherwise = [x] ++ go' l (d+1) ++ go' r (d+1)
|
|
|
|
|
|
+ type Day = Int
|
|
|
+ type Month = Int
|
|
|
+
|
|
|
+ monthNumOfDay :: Year -> Month -> Int
|
|
|
+ monthNumOfDay yyyy 2 = if (yearIsLeap yyyy) then 29 else 28
|
|
|
+ monthNumOfDay _ 4 = 30
|
|
|
+ monthNumOfDay _ 6 = 30
|
|
|
+ monthNumOfDay _ 9 = 30
|
|
|
+ monthNumOfDay _ 11 = 30
|
|
|
+ monthNumOfDay _ mm = 31
|
|
|
+
|
|
|
+ type Year = Int
|
|
|
+
|
|
|
+ yearIsLeap :: Year -> Bool
|
|
|
+ yearIsLeap yyyy = (mody 4) && ((not (mody 100)) || (mody 400))
|
|
|
+ where mody = \x -> mod yyyy x == 0
|
|
|
+
|
|
|
+ data Date = Date Year Month Day
|
|
|
+ deriving (Show, Eq)
|
|
|
+
|
|
|
+ dateDay :: Date -> Day
|
|
|
+ dateDay (Date _ _ dd) = dd
|
|
|
+
|
|
|
+ dateNextDay :: Date -> Date
|
|
|
+ dateNextDay (Date yyyy mm dd)
|
|
|
+ | dd == (monthNumOfDay yyyy mm) = dateNextMonth (Date yyyy mm 1)
|
|
|
+ | otherwise = (Date yyyy mm (dd+1))
|
|
|
+
|
|
|
+ dateNextMonth :: Date -> Date
|
|
|
+ dateNextMonth (Date yyyy 12 dd) = dateNextYear (Date yyyy 1 dd)
|
|
|
+ dateNextMonth (Date yyyy mm dd) = (Date yyyy (mm+1) dd)
|
|
|
+
|
|
|
+ dateNextYear :: Date -> Date
|
|
|
+ dateNextYear (Date yyyy mm dd) = (Date (yyyy+1) mm dd)
|
|
|
+
|
|
|
+ data Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
|
|
|
+ deriving (Show, Enum, Eq)
|
|
|
+
|
|
|
+ weekdayNext :: Weekday -> Weekday
|
|
|
+ weekdayNext Sunday = Monday
|
|
|
+ weekdayNext x = succ x
|
|
|
+
|
|
|
+ weekdayOfDate :: Date -> Weekday
|
|
|
+ weekdayOfDate tD = go' (Date 1900 1 1) (iterate weekdayNext Monday)
|
|
|
+ where
|
|
|
+ go' :: Date -> [Weekday] -> Weekday
|
|
|
+ go' d (x:xs)
|
|
|
+ | d == tD = x
|
|
|
+ | otherwise = go' (dateNextDay d) xs
|