------------------------------------------------------------------------------
-- 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)
import Data.Time.Calendar (DayOfWeek (..), addDays, toModifiedJulianDay, dayOfWeek)
import Data.Time.Calendar.BankHoliday (yearFromDay)

{- | bank holidays for a given year -}
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 -- mlk Day
      , Integer
2 Integer -> Day -> Day
`weeksAfter` (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
feb   -- presidents day
      , Day -> Day
weekBefore ((Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
jun)     -- memorial day
      , (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
sep                  -- labor day
      , Day -> Day
weekAfter ((Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
oct)      -- columbusDay
      , Integer
3 Integer -> Day -> Day
`weeksAfter` (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstThursdayIn Int -> Day
nov -- thanksgiving
      ] [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)  -- newYearsDay
      , Day -> Maybe Day
weekendHolidayFrom (Int -> Day
jul Int
4)  -- independenceDay
      , Day -> Maybe Day
weekendHolidayFrom (Int -> Day
nov Int
11) -- veteransDay
      , Day -> Maybe Day
weekendHolidayFrom (Int -> Day
dec Int
25) -- christmas
      ]

{- | whether the given day is a bank holiday -}
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)

-- | day federal bank holidays were announced in the United States
-- | March 9th 1933
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

-- | find holidays falling between 2 years of time
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]

-- | find holidays falling between 2 specific days
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            -- saturday
  Integer
4 -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Integer -> Day -> Day
addDays Integer
1 Day
d) -- sunday
  Integer
_ -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d

-- | relative day helper functions
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)