module Data.Time.Calendar.BankHoliday.UnitedStates
(
isBankHoliday
, bankHolidays
, holidaysBetween
, holidaysBetweenYears
) where
import Data.Maybe
import Data.Time (Day, fromGregorian)
import Data.Time.Calendar (DayOfWeek (..), addDays, toModifiedJulianDay, dayOfWeek)
import Data.Time.Calendar.BankHoliday (yearFromDay)
bankHolidays :: Integer -> [Day]
bankHolidays :: Integer -> [Day]
bankHolidays Integer
year = [Day] -> [Day]
filterHistoric [Day]
standardHolidays
where
[Int -> Day
jan, Int -> Day
feb, Int -> Day
jun, Int -> Day
jul, Int -> Day
sep, Int -> Day
oct, Int -> Day
nov, Int -> Day
dec] = [Int -> Day]
monthsMap
monthsMap :: [Int -> Day]
monthsMap = (Int -> Int -> Day) -> [Int] -> [Int -> Day]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Int -> Int -> Day
fromGregorian Integer
year) [Int
1,Int
2,Int
6,Int
7,Int
9,Int
10,Int
11,Int
12]
standardHolidays :: [Day]
standardHolidays = [
Integer
2 Integer -> Day -> Day
`weeksAfter` (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
jan
, Integer
2 Integer -> Day -> Day
`weeksAfter` (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
feb
, Day -> Day
weekBefore ((Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
jun)
, (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
sep
, Day -> Day
weekAfter ((Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
oct)
, Integer
3 Integer -> Day -> Day
`weeksAfter` (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstThursdayIn Int -> Day
nov
] [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Maybe Day] -> [Day]
forall a. [Maybe a] -> [a]
catMaybes [
Day -> Maybe Day
weekendHolidayFrom (Int -> Day
jan Int
1)
, Day -> Maybe Day
weekendHolidayFrom (Int -> Day
jul Int
4)
, Day -> Maybe Day
weekendHolidayFrom (Int -> Day
nov Int
11)
, Day -> Maybe Day
weekendHolidayFrom (Int -> Day
dec Int
25)
]
isBankHoliday :: Day -> Bool
isBankHoliday :: Day -> Bool
isBankHoliday Day
d = Day
d Day -> [Day] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Integer -> [Day]
bankHolidays (Day -> Integer
yearFromDay Day
d)
filterHistoric :: [Day] -> [Day]
filterHistoric :: [Day] -> [Day]
filterHistoric = (Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
filter (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
marchNinth1933)
where marchNinth1933 :: Day
marchNinth1933 = Integer -> Int -> Int -> Day
fromGregorian Integer
1933 Int
3 Int
9
holidaysBetweenYears :: Integer -> Integer -> [Day]
holidaysBetweenYears :: Integer -> Integer -> [Day]
holidaysBetweenYears Integer
startYear Integer
endYear =
(Integer -> [Day]) -> [Integer] -> [Day]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Integer -> [Day]
bankHolidays [Integer
startYear..Integer
endYear]
holidaysBetween :: Day -> Day -> [Day]
holidaysBetween :: Day -> Day -> [Day]
holidaysBetween Day
start Day
end =
(Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Day
a -> Day
a Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
start Bool -> Bool -> Bool
&& Day
a Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
end) [Day]
fullRange
where
fullRange :: [Day]
fullRange = Integer -> Integer -> [Day]
holidaysBetweenYears (Day -> Integer
yearFromDay Day
start) (Day -> Integer
yearFromDay Day
end)
weekendHolidayFrom :: Day -> Maybe Day
weekendHolidayFrom :: Day -> Maybe Day
weekendHolidayFrom Day
d = case Day -> Integer
weekIndex Day
d of
Integer
3 -> Maybe Day
forall a. Maybe a
Nothing
Integer
4 -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Integer -> Day -> Day
addDays Integer
1 Day
d)
Integer
_ -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
weekIndex :: Day -> Integer
weekIndex Day
day = Day -> Integer
toModifiedJulianDay Day
day Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
7
firstMondayIn :: (t -> Day) -> Day
firstMondayIn t -> Day
month = DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
Monday (t -> Day
month t
01)
firstThursdayIn :: (t -> Day) -> Day
firstThursdayIn t -> Day
month = DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
Thursday (t -> Day
month t
01)
weeksBefore :: Integer -> Day -> Day
weeksBefore Integer
n = Integer -> Day -> Day
addDays (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-Integer
7))
weekBefore :: Day -> Day
weekBefore = Integer -> Day -> Day
weeksBefore Integer
1
weeksAfter :: Integer -> Day -> Day
weeksAfter Integer
n = Integer -> Day -> Day
addDays (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7)
weekAfter :: Day -> Day
weekAfter = Integer -> Day -> Day
weeksAfter Integer
1
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dw Day
d = if Day -> DayOfWeek
dayOfWeek Day
d DayOfWeek -> DayOfWeek -> Bool
forall a. Eq a => a -> a -> Bool
== DayOfWeek
dw
then Day
d
else DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dw (Integer -> Day -> Day
addDays Integer
1 Day
d)