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 :: Integer -> [Day]
bankHolidays Integer
yy = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Day
standardHolidays forall a. Ord a => Set a -> Set a -> Set a
S.\\ Integer -> Set Day -> Set Day
filterByYear Integer
yy Set Day
skipped forall a. Ord a => Set a -> Set a -> Set a
`S.union` Integer -> Set Day -> Set Day
filterByYear Integer
yy Set Day
extras
where
standardHolidays :: Set Day
standardHolidays = forall a. Ord a => [a] -> Set a
S.fromList
forall a b. (a -> b) -> a -> b
$ [ Day
newYearsDay
, forall {t}. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
may
, Day -> Day
weekBefore forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
jun
, Day -> Day
weekBefore forall a b. (a -> b) -> a -> b
$ forall {t}. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
sep ]
forall a. [a] -> [a] -> [a]
++ [Day]
easter
forall a. [a] -> [a] -> [a]
++ [Day]
christmas
newYearsDay :: Day
newYearsDay = case forall {t}. (t -> Day) -> t -> Integer
wd Int -> Day
jan Int
1 of
Integer
3 -> Int -> Day
jan Int
3
Integer
4 -> Int -> Day
jan Int
2
Integer
_ -> Int -> Day
jan Int
1
easter :: [Day]
easter = let easterSunday :: Day
easterSunday = Integer -> Day
gregorianEaster Integer
yy in [Integer -> Day -> Day
addDays (-Integer
2) Day
easterSunday, Integer -> Day -> Day
addDays Integer
1 Day
easterSunday]
christmas :: [Day]
christmas = case forall {t}. (t -> Day) -> t -> Integer
wd Int -> Day
dec Int
25 of
Integer
2 -> [Int -> Day
dec Int
25, Int -> Day
dec Int
28]
Integer
3 -> [Int -> Day
dec Int
27, Int -> Day
dec Int
28]
Integer
4 -> [Int -> Day
dec Int
26, Int -> Day
dec Int
27]
Integer
_ -> [Int -> Day
dec Int
25, Int -> Day
dec Int
26]
[Int -> Day
jan, Int -> Day
may, Int -> Day
jun, Int -> Day
sep, Int -> Day
dec] = forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Int -> Int -> Day
fromGregorian Integer
yy)
[Int
1, Int
5, Int
6, Int
9, Int
12]
firstMondayIn :: (t -> Day) -> Day
firstMondayIn t -> Day
mm = Integer -> Day -> Day
addDays (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall {t}. (t -> Day) -> t -> Integer
wd t -> Day
mm t
02) (t -> Day
mm t
07)
wd :: (t -> Day) -> t -> Integer
wd t -> Day
mm t
dd = Day -> Integer
toModifiedJulianDay (t -> Day
mm t
dd) forall a. Integral a => a -> a -> a
`mod` Integer
7
weekBefore :: Day -> Day
weekBefore = Integer -> Day -> Day
addDays (-Integer
7)
filterByYear :: Integer -> S.Set Day -> S.Set Day
filterByYear :: Integer -> Set Day -> Set Day
filterByYear Integer
y Set Day
s0 = Set Day
s2
where
(Set Day
s1, Set Day
_) = forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split (Integer -> Int -> Int -> Day
fromGregorian (Integer
yforall a. Num a => a -> a -> a
+Integer
1) Int
1 Int
1) Set Day
s0
(Set Day
_ ,Set Day
s2) = forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
1 Int
1) Set Day
s1
skipped :: S.Set Day
skipped :: Set Day
skipped = forall a. Ord a => [a] -> Set a
S.fromList [ Integer -> Int -> Int -> Day
fromGregorian Integer
1995 Int
05 Int
1
, Integer -> Int -> Int -> Day
fromGregorian Integer
2002 Int
05 Int
27
, Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
05 Int
28
, Integer -> Int -> Int -> Day
fromGregorian Integer
2020 Int
05 Int
04
, Integer -> Int -> Int -> Day
fromGregorian Integer
2022 Int
05 Int
30
]
extras :: S.Set Day
= forall a. Ord a => [a] -> Set a
S.fromList [ Integer -> Int -> Int -> Day
fromGregorian Integer
1995 Int
05 Int
08
, Integer -> Int -> Int -> Day
fromGregorian Integer
1999 Int
12 Int
31
, Integer -> Int -> Int -> Day
fromGregorian Integer
2002 Int
06 Int
03
, Integer -> Int -> Int -> Day
fromGregorian Integer
2002 Int
06 Int
04
, Integer -> Int -> Int -> Day
fromGregorian Integer
2011 Int
04 Int
29
, Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
06 Int
04
, Integer -> Int -> Int -> Day
fromGregorian Integer
2012 Int
06 Int
05
, Integer -> Int -> Int -> Day
fromGregorian Integer
2020 Int
05 Int
08
, Integer -> Int -> Int -> Day
fromGregorian Integer
2022 Int
06 Int
02
, Integer -> Int -> Int -> Day
fromGregorian Integer
2022 Int
06 Int
03
, Integer -> Int -> Int -> Day
fromGregorian Integer
2022 Int
09 Int
19
, Integer -> Int -> Int -> Day
fromGregorian Integer
2023 Int
05 Int
08
]
extraYears :: [Integer]
= Set Day -> [Integer]
yearsOf Set Day
extras forall a. Eq a => [a] -> [a] -> [a]
\\ Set Day -> [Integer]
yearsOf Set Day
skipped
where
yearsOf :: Set Day -> [Integer]
yearsOf Set Day
s = [Integer
y | (Integer
y,Int
_,Int
_) <- forall a b. (a -> b) -> [a] -> [b]
map Day -> (Integer, Int, Int)
toGregorian forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Day
s]
isBankHoliday :: Day -> Bool
isBankHoliday :: Day -> Bool
isBankHoliday Day
d = (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
S.member Day
d Set Day
skipped) Bool -> Bool -> Bool
&& (forall a. Ord a => a -> Set a -> Bool
S.member Day
d Set Day
extras Bool -> Bool -> Bool
|| Bool
isStandardHoliday)
where
(Integer
yy,Int
mm,Int
dd) = Day -> (Integer, Int, Int)
toGregorian Day
d
dayOfWeek :: Integer
dayOfWeek = forall a. Integral a => a -> a -> a
mod (Day -> Integer
toModifiedJulianDay Day
d) Integer
7
isMonday :: Bool
isMonday = Integer
dayOfWeek forall a. Eq a => a -> a -> Bool
== Integer
5
isWeekend :: Bool
isWeekend = Integer
dayOfWeek forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer
3,Integer
4]
easterSunday :: Day
easterSunday = Integer -> Day
gregorianEaster Integer
yy
isStandardHoliday :: Bool
isStandardHoliday
| Bool
isWeekend = Bool
False
| Bool
isMonday = (Int
mm forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
dd forall a. Ord a => a -> a -> Bool
<= Int
3)
Bool -> Bool -> Bool
|| (Int
mm forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
&& (Int
dd forall a. Ord a => a -> a -> Bool
<= Int
7 Bool -> Bool -> Bool
|| Int
31forall a. Num a => a -> a -> a
-Int
7 forall a. Ord a => a -> a -> Bool
< Int
dd))
Bool -> Bool -> Bool
|| (Int
mm forall a. Eq a => a -> a -> Bool
== Int
8 Bool -> Bool -> Bool
&& Int
31forall a. Num a => a -> a -> a
-Int
7 forall a. Ord a => a -> a -> Bool
< Int
dd)
Bool -> Bool -> Bool
|| (Int
mm forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
25 forall a. Ord a => a -> a -> Bool
<= Int
dd Bool -> Bool -> Bool
&& Int
dd forall a. Ord a => a -> a -> Bool
< Int
29)
Bool -> Bool -> Bool
|| Day
d forall a. Eq a => a -> a -> Bool
== Integer -> Day -> Day
addDays Integer
1 Day
easterSunday
| Bool
otherwise = (Int
mm,Int
dd) forall a. Eq a => a -> a -> Bool
== (Int
1,Int
1)
Bool -> Bool -> Bool
|| (Int
mm forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
25 forall a. Ord a => a -> a -> Bool
<= Int
dd Bool -> Bool -> Bool
&& (Int
dd forall a. Ord a => a -> a -> Bool
< Int
27 Bool -> Bool -> Bool
|| (Integer
dayOfWeek forall a. Eq a => a -> a -> Bool
== Integer
6 Bool -> Bool -> Bool
&& Int
dd forall a. Ord a => a -> a -> Bool
< Int
29)))
Bool -> Bool -> Bool
|| Day
d forall a. Eq a => a -> a -> Bool
== Integer -> Day -> Day
addDays (-Integer
2) Day
easterSunday
countBankHolidays :: Day -> Day -> Integer
countBankHolidays :: Day -> Day -> Integer
countBankHolidays Day
d0 Day
d1
= if Day
d0 forall a. Ord a => a -> a -> Bool
<= Day
d1 then
if Integer
y0 forall a. Eq a => a -> a -> Bool
== Integer
y1
then forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Day
d1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<Day
d0) forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y0
else forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Day
d1) forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y1)
forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Day
d0) forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y0)
forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<Integer
y0) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<Integer
y1) [Integer]
extraYears))
forall a. Num a => a -> a -> a
+ Integer
8 forall a. Num a => a -> a -> a
* (Integer
y1 forall a. Num a => a -> a -> a
- Integer
y0)
else forall a. Num a => a -> a
negate (Day -> Day -> Integer
countBankHolidays Day
d1 Day
d0)
where
(Integer
y0,Int
_,Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
d0
(Integer
y1,Int
_,Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
d1