packages feed

bank-holidays-england 0.1.0.1 → 0.1.0.2

raw patch · 2 files changed

+118/−54 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

bank-holidays-england.cabal view
@@ -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
src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs view
@@ -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 (<d1) $ dropWhile (<d0) $ bankHolidays y0-      else fromIntegral (length (takeWhile (<d1) $ bankHolidays y1)-                       - length (takeWhile (<d0) $ bankHolidays y0)-                       + length (dropWhile (<y0) $ takeWhile (<y1) [1999,2002,2011,2012]))-         + 8 * (y1 - y0)+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