diff --git a/src/Utils/Holidays.hs b/src/Utils/Holidays.hs index 71235acf6..5b8d317a3 100644 --- a/src/Utils/Holidays.hs +++ b/src/Utils/Holidays.hs @@ -2,7 +2,8 @@ Module: Utils.Holidays Description: German bank holidays -Following module Data.Time.Calendar.BankHoliday.EnglandAndWales +Interfaces follows module Data.Time.Calendar.BankHoliday.EnglandAndWales +isBankHolidayArea uses laziness to provide some simple memoization for a fixed range of years -} module Utils.Holidays ( Feiertagsgebiet(..) @@ -13,7 +14,7 @@ module Utils.Holidays import Import.NoModel -import qualified Data.Set as Set (Set, member, unions) +import qualified Data.Set as Set (Set, member) import qualified Data.Map as Map --import Data.Time.Calendar.WeekDate @@ -104,20 +105,35 @@ isBankHolidayArea land dd = dd `Set.member` holidays -} -- | Returns whether a day is a bank holiday for years >= 1995 --- | Repeated calls are handled efficiently using a lazy cache for 2020--2075 +-- | Repeated calls are handled efficiently using lazy memoization isBankHolidayArea :: Feiertagsgebiet -> Day -> Bool isBankHolidayArea land dd = dd `Set.member` holidays where (year, _, _) = toGregorian dd holidays - | year >= cacheMinYear - , year <= cacheMaxYear - , (Just hds) <- Map.lookup land cacheHolidays = hds + | (Just hys) <- Map.lookup land memoHolidays + , (Just hds) <- index hys $ fromInteger $ year2index year = hds | otherwise = bankHolidaysAreaSet land year -cacheMinYear, cacheMaxYear :: Integer -cacheMinYear = 2020 -cacheMaxYear = 2075 +-- memoize holidays +memoHolidays :: Map.Map Feiertagsgebiet [Set.Set Day] +memoHolidays = Map.fromList [(land, + [bankHolidaysAreaSet land year + | i <- [0..], let year = index2year i]) + | land <- universeF] -cacheHolidays :: Map.Map Feiertagsgebiet (Set.Set Day) -cacheHolidays = Map.fromList [ (land, Set.unions $ bankHolidaysAreaSet land <$> [cacheMinYear..cacheMaxYear]) | land <- universeF ] +-- year with fastest access +memoTip :: Integer +memoTip = 2030 + +year2index :: Integer -> Integer +year2index y + | y < memoTip = 2 * (memoTip - y) - 1 + | otherwise = 2 * (y - memoTip) + +index2year :: Integer -> Integer +index2year y = result + where + (x,r) = y `divMod` 2 + result | r == 0 = memoTip + x + | otherwise = memoTip - x - 1