bank-holidays-england (empty) → 0.1.0.0
raw patch · 5 files changed
+189/−0 lines, 5 filesdep +QuickCheckdep +bank-holidays-englanddep +basesetup-changed
Dependencies added: QuickCheck, bank-holidays-england, base, containers, hspec, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- bank-holidays-england.cabal +35/−0
- src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs +115/−0
- test/Main.hs +7/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bank-holidays-england.cabal view
@@ -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
+ src/Data/Time/Calendar/BankHoliday/EnglandAndWales.hs view
@@ -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 (<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)+ where+ (y0,_,_) = toGregorian d0+ (y1,_,_) = toGregorian d1
+ test/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import Test.Hspec.Runner+import qualified Spec++main :: IO ()+main = hspec Spec.spec