{-|

Calculation of bank holidays in England and Wales, using the rules that have
been in place since 1978, and including all exceptions to the rules in the
years 1995 to 2020. I do not know of any exceptions from 1978 until 1995, so
the calculations may be correct for those years too. Calculations for future
dates are predictions which may be rendered false if exceptions to the rules
are announced.

There are normally 8 bank holidays in England and Wales:

  * New Year's Day
  * Good Friday
  * Easter Monday
  * May Day
  * Spring Bank Holiday
  * Summer Bank Holiday
  * Christmas Day
  * Boxing Day

The rules for determining the precise date of each of these in any given year
are a little involved, since holidays may be moved to avoid falling on a
weekend:

  * The New Year's Day holiday is the 1st of January, or the following Monday if
    the 1st is a weekend.
  * Good Friday and Easter Monday are the Friday and Monday either side of
    Easter Sunday (as calculated by the Gregorian method).
  * May Day is the first Monday in May.
  * The Spring Bank Holiday is the last Monday in May.
  * The Summer Bank Holiday is the last Monday in August.
  * Christmas Day is the 25th of December unless that's a weekend,
    in which case it's the 27th.
  * Boxing Day is the 26th of December unless that's a weekend,
    in which case it's the 28th.

Exceptions may be made to these rules on a year-by-year basis.

This package is a reasonably efficient (constant-time) implementation of these
rules.

-}

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
  )

{-| List the bank holidays for the given year, in ascending order. Bank
holidays never fall on a weekend. -}
bankHolidays :: Integer -> [Day]
bankHolidays :: Integer -> [Day]
bankHolidays Integer
yy = Set Day -> [Day]
forall a. Set a -> [a]
S.toList (Set Day -> [Day]) -> Set Day -> [Day]
forall a b. (a -> b) -> a -> b
$ Set Day
standardHolidays Set Day -> Set Day -> Set Day
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Integer -> Set Day -> Set Day
filterByYear Integer
yy Set Day
skipped Set Day -> Set Day -> Set Day
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 = [Day] -> Set Day
forall a. Ord a => [a] -> Set a
S.fromList
    ([Day] -> Set Day) -> [Day] -> Set Day
forall a b. (a -> b) -> a -> b
$  [ Day
newYearsDay
       , (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
may
       , Day -> Day
weekBefore (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
jun
       , Day -> Day
weekBefore (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ (Int -> Day) -> Day
forall t. Num t => (t -> Day) -> Day
firstMondayIn Int -> Day
sep ]
    [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Day]
easter
    [Day] -> [Day] -> [Day]
forall a. [a] -> [a] -> [a]
++ [Day]
christmas

  newYearsDay :: Day
newYearsDay = case (Int -> Day) -> Int -> Integer
forall t. (t -> Day) -> t -> Integer
wd Int -> Day
jan Int
1 of
    Integer
3 {- Sat -} -> Int -> Day
jan Int
3
    Integer
4 {- Sun -} -> 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 (Int -> Day) -> Int -> Integer
forall t. (t -> Day) -> t -> Integer
wd Int -> Day
dec Int
25 of
    Integer
2 {- Fri -} -> [Int -> Day
dec Int
25, Int -> Day
dec Int
28]
    Integer
3 {- Sat -} -> [Int -> Day
dec Int
27, Int -> Day
dec Int
28]
    Integer
4 {- Sun -} -> [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] = (Int -> Int -> Day) -> [Int] -> [Int -> Day]
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 (Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ (t -> Day) -> t -> Integer
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) Integer -> Integer -> Integer
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
_) = Day -> Set Day -> (Set Day, Set Day)
forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split                (Integer -> Int -> Int -> Day
fromGregorian (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Int
1 Int
1) Set Day
s0
  (Set Day
_ ,Set Day
s2) = Day -> Set Day -> (Set Day, Set Day)
forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split (Integer -> Day -> Day
addDays (-Integer
1) (Day -> Day) -> Day -> Day
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 = [Day] -> Set Day
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
extras :: Set Day
extras  = [Day] -> 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
                      ]

extraYears :: [Integer]
extraYears :: [Integer]
extraYears = Set Day -> [Integer]
yearsOf Set Day
extras [Integer] -> [Integer] -> [Integer]
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
_) <- (Day -> (Integer, Int, Int)) -> [Day] -> [(Integer, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Day -> (Integer, Int, Int)
toGregorian ([Day] -> [(Integer, Int, Int)]) -> [Day] -> [(Integer, Int, Int)]
forall a b. (a -> b) -> a -> b
$ Set Day -> [Day]
forall a. Set a -> [a]
S.toList Set Day
s]

{-| Returns whether a day is a bank holiday. -}
isBankHoliday :: Day -> Bool
isBankHoliday :: Day -> Bool
isBankHoliday Day
d = (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Day -> Set Day -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Day
d Set Day
skipped) Bool -> Bool -> Bool
&& (Day -> Set Day -> 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    = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Day -> Integer
toModifiedJulianDay Day
d) Integer
7
  isMonday :: Bool
isMonday     = Integer
dayOfWeek Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
5
  isWeekend :: Bool
isWeekend    = Integer
dayOfWeek Integer -> [Integer] -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  Bool -> Bool -> Bool
&&  Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3)
                Bool -> Bool -> Bool
|| (Int
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5  Bool -> Bool -> Bool
&& (Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 Bool -> Bool -> Bool
|| Int
31Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dd))
                Bool -> Bool -> Bool
|| (Int
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8  Bool -> Bool -> Bool
&&             Int
31Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dd)
                Bool -> Bool -> Bool
|| (Int
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
25 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dd Bool -> Bool -> Bool
&& Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
29)
                Bool -> Bool -> Bool
|| Day
d Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Day -> Day
addDays Integer
1 Day
easterSunday
    | Bool
otherwise =  (Int
mm,Int
dd) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1,Int
1)
                Bool -> Bool -> Bool
|| (Int
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& Int
25 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dd Bool -> Bool -> Bool
&& (Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
27 Bool -> Bool -> Bool
|| (Integer
dayOfWeek Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
6 Bool -> Bool -> Bool
&& Int
dd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
29)))
                Bool -> Bool -> Bool
|| Day
d Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Day -> Day
addDays (-Integer
2) Day
easterSunday

{-| Count the number of bank holidays between two 'Day's.

If @d0 <= d1@ then @countBankHolidays d0 d1@ is the number of 'Day's @d@ for
which @isBankHoliday d && d0 <= d && d < d1@. Note the count includes @d0@ but
excludes @d1@.

Additionally, @countBankHolidays d0 d1 == negate (countBankHolidays d1 d0)@ and
@countBankHolidays d0 d2 == countBankHolidays d0 d1 + countBankHolidays d1 d2@.

 -}
countBankHolidays :: Day -> Day -> Integer
countBankHolidays :: Day -> Day -> Integer
countBankHolidays Day
d0 Day
d1
  = if Day
d0 Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
d1 then
      if Integer
y0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y1
        then Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Day] -> Int) -> [Day] -> Int
forall a b. (a -> b) -> a -> b
$ (Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<Day
d1) ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ (Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<Day
d0) ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y0
        else Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<Day
d1) ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y1)
                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Day] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Day -> Bool) -> [Day] -> [Day]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<Day
d0) ([Day] -> [Day]) -> [Day] -> [Day]
forall a b. (a -> b) -> a -> b
$ Integer -> [Day]
bankHolidays Integer
y0)
                         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
y0) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
y1) [Integer]
extraYears))
           Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y0)
    else Integer -> Integer
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