diff --git a/bank-holidays-england.cabal b/bank-holidays-england.cabal --- a/bank-holidays-england.cabal +++ b/bank-holidays-england.cabal @@ -1,7 +1,11 @@ name: bank-holidays-england -version: 0.1.0.1 -synopsis: Calculation of bank holidays in England and Wales, including special cases 1995-2014. -description: Calculation of bank holidays in England and Wales, including special cases 1995-2014. +version: 0.1.0.2 +synopsis: Calculation of bank holidays in England and Wales +description: + 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 2014. + homepage: https://bitbucket.org/davecturner/bank-holidays-england license: BSD3 license-file: LICENSE diff --git a/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs b/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs --- a/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs +++ b/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs @@ -1,44 +1,89 @@ -{-| Reasonably efficient (constant-time) calculation of standard bank holidays -in England and Wales, including special cases 1995-2014. May become out-of-date -as future special cases are announced. -} +{-| +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 2014. 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 -import Data.Time.Calendar.Easter + ( 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 yy = standardHolidays ++ if yy == 1999 then [dec 31] else [] - +bankHolidays yy = S.toList $ standardHolidays S.\\ filterByYear yy skipped `S.union` filterByYear yy extras where - [jan, apr, may, jun, sep, dec] = map (fromGregorian yy) - [1, 4, 5, 6, 9, 12] - wd mm dd = toModifiedJulianDay (mm dd) `mod` 7 - - standardHolidays = newYearsDay ++ easter ++ mayDay ++ spring ++ [weekBefore $ firstMondayIn sep] ++ christmas - - mayDay = case yy of - 2011 -> [apr 29, may 2] - 1995 -> [may 8] - _ -> [firstMondayIn may] - - spring = case yy of - 2002 -> [jun 3, jun 4] - 2012 -> [jun 4, jun 5] - _ -> [weekBefore $ firstMondayIn jun] + standardHolidays = S.fromList + $ [ newYearsDay + , firstMondayIn may + , weekBefore $ firstMondayIn jun + , weekBefore $ firstMondayIn sep ] + ++ easter + ++ christmas newYearsDay = case wd jan 1 of - 3 {- Sat -} -> [jan 3] - 4 {- Sun -} -> [jan 2] - _ -> [jan 1] + 3 {- Sat -} -> jan 3 + 4 {- Sun -} -> jan 2 + _ -> jan 1 easter = let easterSunday = gregorianEaster yy in [addDays (-2) easterSunday, addDays 1 easterSunday] @@ -48,25 +93,45 @@ 4 {- Sun -} -> [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 + ] + +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 + ] + +extraYears :: [Integer] +extraYears = yearsOf extras \\ yearsOf skipped + where + yearsOf s = [y | (y,_,_) <- map toGregorian $ S.toList s] + {-| Returns whether a day is a bank holiday. -} isBankHoliday :: Day -> Bool isBankHoliday d = (not $ S.member d skipped) && (S.member d extras || isStandardHoliday) where - skipped = S.fromList [ fromGregorian 1995 05 1 - , fromGregorian 2002 05 27 - , fromGregorian 2012 05 28 - ] - 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 - ] (yy,mm,dd) = toGregorian d dayOfWeek = mod (toModifiedJulianDay d) 7 isMonday = dayOfWeek == 5 @@ -84,12 +149,6 @@ || (mm == 12 && 25 <= dd && (dd < 27 || (dayOfWeek == 6 && dd < 29))) || d == addDays (-2) easterSunday -countDaysWrapper :: (Day -> Day -> Integer) -> Day -> Day -> Integer -countDaysWrapper f d0 d1 = case compare d0 d1 of - LT -> f d0 d1 - EQ -> 0 - GT -> negate $ f d1 d0 - {-| 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 @@ -101,15 +160,16 @@ -} countBankHolidays :: Day -> Day -> Integer -countBankHolidays = countDaysWrapper go - where - go d0 d1 = - if y0 == y1 - then fromIntegral $ length $ takeWhile (