chore: merge fill_avn_a

This commit is contained in:
Sarah Vaupel 2021-10-07 16:26:05 +02:00
commit 629b6e7d3f

View File

@ -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