------------------------------------------------------------------------------ -- Module : Data.Time.Calendar.BankHoliday.UnitedStates -- Maintainer : brady.ouren@gmail.com ------------------------------------------------------------------------------ module Data.Time.Calendar.BankHoliday.UnitedStates ( isBankHoliday , bankHolidays , holidaysBetween , holidaysBetweenYears ) where import Data.Maybe import Data.Time (Day, fromGregorian, toGregorian) import Data.Time.Calendar (addDays, toModifiedJulianDay) import Data.Time.Calendar.BankHoliday (isWeekday, isWeekend, yearFromDay) {- | bank holidays for a given year -} bankHolidays :: Integer -> [Day] bankHolidays year = filterHistoric standardHolidays where [jan, feb, jun, jul, sep, oct, nov, dec] = monthsMap monthsMap = map (fromGregorian year) [1,2,6,7,9,10,11,12] standardHolidays = [ 2 `weeksAfter` firstMondayIn jan -- mlk Day , 2 `weeksAfter` firstMondayIn feb -- presidents day , weekBefore (firstMondayIn jun) -- memorial day , firstMondayIn sep -- labor day , weekAfter (firstMondayIn oct) -- columbusDay , 2 `weeksAfter` firstThursdayIn nov -- thanksgiving ] ++ catMaybes [ weekendHolidayFrom (jan 1) -- newYearsDay , weekendHolidayFrom (jul 4) -- independenceDay , weekendHolidayFrom (nov 11) -- veteransDay , weekendHolidayFrom (dec 25) -- christmas ] {- | whether the given day is a bank holiday -} isBankHoliday :: Day -> Bool isBankHoliday d = d `elem` bankHolidays (yearFromDay d) -- | day federal bank holidays were announced in the United States -- | March 9th 1933 filterHistoric :: [Day] -> [Day] filterHistoric = filter (\d -> d > marchNinth1933) where marchNinth1933 = fromGregorian 1933 3 9 -- | find holidays falling between 2 years of time holidaysBetweenYears :: Integer -> Integer -> [Day] holidaysBetweenYears startYear endYear = foldl (++) [] (map bankHolidays [startYear..endYear]) -- | find holidays falling between 2 specific days holidaysBetween :: Day -> Day -> [Day] holidaysBetween start end = filter (\a -> a >= start && a <= end) fullRange where fullRange = holidaysBetweenYears (yearFromDay start) (yearFromDay end) weekendHolidayFrom :: Day -> Maybe Day weekendHolidayFrom d = case weekIndex d of 3 -> Nothing -- saturday 4 -> Just (addDays 1 d) -- sunday _ -> Just d -- | relative day helper functions weekIndex day = toModifiedJulianDay day `mod` 7 firstMondayIn month = addDays (negate $ weekIndex (month 02)) (month 07) firstThursdayIn month = addDays 3 (firstMondayIn month) weeksBefore n = addDays (n * (-7)) weekBefore = weeksBefore 1 weeksAfter n = addDays (n * 7) weekAfter = weeksAfter 1