module Data.Time.Calendar.BankHoliday.EnglandAndWales
( bankHolidays
, isBankHoliday
, countBankHolidays
) where
import Data.List ((\\))
import Data.Time
( Day
, addDays
, fromGregorian
, toGregorian
, toModifiedJulianDay
)
import Data.Time.Calendar.Easter (gregorianEaster)
import qualified Data.Set as S
( Set
, (\\)
, fromList
, member
, split
, toList
, union
)
bankHolidays :: Integer -> [Day]
bankHolidays yy = S.toList $ standardHolidays S.\\ filterByYear yy skipped `S.union` filterByYear yy extras
where
standardHolidays = S.fromList
$ [ newYearsDay
, firstMondayIn may
, weekBefore $ firstMondayIn jun
, weekBefore $ firstMondayIn sep ]
++ easter
++ christmas
newYearsDay = case wd jan 1 of
3 -> jan 3
4 -> jan 2
_ -> jan 1
easter = let easterSunday = gregorianEaster yy in [addDays (-2) easterSunday, addDays 1 easterSunday]
christmas = case wd dec 25 of
2 -> [dec 25, dec 28]
3 -> [dec 27, dec 28]
4 -> [dec 26, dec 27]
_ -> [dec 25, dec 26]
[jan, may, jun, sep, dec] = map (fromGregorian yy)
[1, 5, 6, 9, 12]
firstMondayIn mm = addDays (negate $ wd mm 02) (mm 07)
wd mm dd = toModifiedJulianDay (mm dd) `mod` 7
weekBefore = addDays (-7)
filterByYear :: Integer -> S.Set Day -> S.Set Day
filterByYear y s0 = s2
where
(s1, _) = S.split (fromGregorian (y+1) 1 1) s0
(_ ,s2) = S.split (addDays (-1) $ fromGregorian y 1 1) s1
skipped :: S.Set Day
skipped = S.fromList [ fromGregorian 1995 05 1
, fromGregorian 2002 05 27
, fromGregorian 2012 05 28
, fromGregorian 2020 05 04
]
extras :: S.Set Day
extras = S.fromList [ fromGregorian 1995 05 08
, fromGregorian 1999 12 31
, fromGregorian 2002 06 03
, fromGregorian 2002 06 04
, fromGregorian 2011 04 29
, fromGregorian 2012 06 04
, fromGregorian 2012 06 05
, fromGregorian 2020 05 08
]
extraYears :: [Integer]
extraYears = yearsOf extras \\ yearsOf skipped
where
yearsOf s = [y | (y,_,_) <- map toGregorian $ S.toList s]
isBankHoliday :: Day -> Bool
isBankHoliday d = (not $ S.member d skipped) && (S.member d extras || isStandardHoliday)
where
(yy,mm,dd) = toGregorian d
dayOfWeek = mod (toModifiedJulianDay d) 7
isMonday = dayOfWeek == 5
isWeekend = dayOfWeek `elem` [3,4]
easterSunday = gregorianEaster yy
isStandardHoliday
| isWeekend = False
| isMonday = (mm == 1 && dd <= 3)
|| (mm == 5 && (dd <= 7 || 31-7 < dd))
|| (mm == 8 && 31-7 < dd)
|| (mm == 12 && 25 <= dd && dd < 29)
|| d == addDays 1 easterSunday
| otherwise = (mm,dd) == (1,1)
|| (mm == 12 && 25 <= dd && (dd < 27 || (dayOfWeek == 6 && dd < 29)))
|| d == addDays (-2) easterSunday
countBankHolidays :: Day -> Day -> Integer
countBankHolidays d0 d1
= if d0 <= d1 then
if y0 == y1
then fromIntegral $ length $ takeWhile (<d1) $ dropWhile (<d0) $ bankHolidays y0
else fromIntegral (length (takeWhile (<d1) $ bankHolidays y1)
- length (takeWhile (<d0) $ bankHolidays y0)
+ length (dropWhile (<y0) $ takeWhile (<y1) extraYears))
+ 8 * (y1 - y0)
else negate (countBankHolidays d1 d0)
where
(y0,_,_) = toGregorian d0
(y1,_,_) = toGregorian d1