diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, David Turner + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of David Turner nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bank-holidays-england.cabal b/bank-holidays-england.cabal new file mode 100644 --- /dev/null +++ b/bank-holidays-england.cabal @@ -0,0 +1,35 @@ +name: bank-holidays-england +version: 0.1.0.0 +synopsis: Algorithm for calculating bank holidays in England and Wales +description: Algorithm for calculating bank holidays in England and Wales +homepage: https://bitbucket.org/davecturner/bank-holidays-england +license: BSD3 +license-file: LICENSE +author: David Turner +maintainer: dave.c.turner@gmail.com +copyright: (c) David Turner 2014 +category: Data +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Data.Time.Calendar.BankHoliday.EnglandAndWales + build-depends: base ==4.7.* + , time + , containers + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base ==4.7.* + , bank-holidays-england + , QuickCheck + , containers + , hspec + , time diff --git a/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs b/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs @@ -0,0 +1,115 @@ +{-| 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. -} + +module Data.Time.Calendar.BankHoliday.EnglandAndWales + ( bankHolidays + , isBankHoliday + , countBankHolidays + ) where + +import Data.Time +import Data.Time.Calendar.Easter +import qualified Data.Set as S + +{-| 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 [] + + 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] + + newYearsDay = case wd jan 1 of + 3 {- Sat -} -> [jan 3] + 4 {- Sun -} -> [jan 2] + _ -> [jan 1] + + easter = let easterSunday = gregorianEaster yy in [addDays (-2) easterSunday, addDays 1 easterSunday] + + christmas = case wd dec 25 of + 2 {- Fri -} -> [dec 25, dec 28] + 3 {- Sat -} -> [dec 27, dec 28] + 4 {- Sun -} -> [dec 26, dec 27] + _ -> [dec 25, dec 26] + + firstMondayIn mm = addDays (negate $ wd mm 02) (mm 07) + weekBefore = addDays (-7) + +{-| 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 + 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 + +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 +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 = countDaysWrapper go + where + go d0 d1 = + if y0 == y1 + then fromIntegral $ length $ takeWhile (