128 lines
4.9 KiB
Haskell
128 lines
4.9 KiB
Haskell
{-|
|
|
Module: Utils.Holidays
|
|
Description: German bank holidays
|
|
|
|
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(..)
|
|
, feiertage
|
|
, bankHolidays, bankHolidaysArea, bankHolidaysAreaSet
|
|
, isBankHoliday, isBankHolidayArea
|
|
) where
|
|
|
|
import Import.NoModel
|
|
|
|
import qualified Data.Set as Set (Set, member)
|
|
import qualified Data.Map as Map
|
|
|
|
--import Data.Time.Calendar.WeekDate
|
|
import Data.Time.Calendar.Easter (gregorianEaster)
|
|
|
|
|
|
-- | Some areas / companies within Germany.
|
|
-- | The datatype is not yet complete.
|
|
data Feiertagsgebiet = Deutschland | Hessen | Bayern | Munich | Fraport
|
|
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
|
deriving anyclass (Universe, Finite)
|
|
|
|
-- | List the bank holidays for the given year >= 1995, in ascending order.
|
|
-- | Holidays on a weekend are legally considered holidays in some German states, hence
|
|
-- | the behaviour differs from Data.Time.Calendar.BankHoliday.EnglandAndWales by including holidays on Sundays.
|
|
-- | Included for compatibility with Data.Time.Calendar.BankHoliday.EnglandAndWales
|
|
bankHolidays :: Integer -> [Day]
|
|
bankHolidays = bankHolidaysArea Deutschland
|
|
|
|
-- | Bank holidays for a region within Germany and a given year >= 1995.
|
|
-- | Holidays may occur on a sunday.
|
|
-- | For convenience and compatibility.
|
|
bankHolidaysArea :: Feiertagsgebiet -> Integer -> [Day]
|
|
bankHolidaysArea land year = Map.keys $ feiertage land year
|
|
|
|
-- | Bank holidays for a region within Germany and a given year >= 1995.
|
|
-- | Holidays may occur on a sunday.
|
|
bankHolidaysAreaSet :: Feiertagsgebiet -> Integer -> Set.Set Day
|
|
bankHolidaysAreaSet land year = Map.keysSet $ feiertage land year
|
|
|
|
-- | Bank holidays for a region within Germany and a given year >= 1995,
|
|
-- | mapped to the german name of each day.
|
|
-- | Holidays may occur on a sunday.
|
|
feiertage :: Feiertagsgebiet -> Integer -> Map.Map Day String
|
|
feiertage land year = case land of
|
|
Deutschland -> standardHolidays
|
|
Bayern -> bavarianHolidays
|
|
Munich -> munichHolidays
|
|
Hessen -> hessianHolidays
|
|
Fraport -> fraportHolidays
|
|
where
|
|
easterSunday = gregorianEaster year
|
|
easterSundayPlus = flip addDays easterSunday
|
|
|
|
standardHolidays = Map.fromList
|
|
[ (fromGregorian year 1 1, "Neujahr")
|
|
, (easterSundayPlus (-2) , "Karfreitag")
|
|
, (easterSunday , "Ostersonntag")
|
|
, (easterSundayPlus 1 , "Ostermontag")
|
|
, (fromGregorian year 5 1, "Erster Mai")
|
|
, (easterSundayPlus 39 , "Himmelfahrt")
|
|
, (easterSundayPlus 49 , "Pfingstsonntag")
|
|
, (easterSundayPlus 50 , "Pfingstmontag")
|
|
, (fromGregorian year 10 3, "Tag der deutschen Einheit")
|
|
, (fromGregorian year 12 25, "Erster Weihnachtstag")
|
|
, (fromGregorian year 12 26, "Zweiter Weihnachtstag")
|
|
]
|
|
|
|
hessianHolidays = standardHolidays <> map_singleton
|
|
(easterSundayPlus 60 , "Fronleichnam")
|
|
|
|
bavarianHolidays = hessianHolidays <> Map.fromList
|
|
[ (fromGregorian year 1 6, "Heilige Drei Könige")
|
|
, (fromGregorian year 11 1, "Allerheiligen")
|
|
]
|
|
|
|
munichHolidays = bavarianHolidays <> map_singleton
|
|
(fromGregorian year 8 15, "Maria Himmelfahrt")
|
|
|
|
fraportHolidays = hessianHolidays <> Map.fromList
|
|
[ (fromGregorian year 12 24, "Heiligabend")
|
|
, (fromGregorian year 12 31, "Sylvester")
|
|
]
|
|
|
|
map_singleton = uncurry Map.singleton
|
|
|
|
-- | For compatibility with with Data.Time.Calendar.BankHoliday.EnglandAndWales
|
|
-- | only for works for year >= 1995
|
|
isBankHoliday :: Day -> Bool
|
|
isBankHoliday = isBankHolidayArea Deutschland
|
|
|
|
{-- Inefficient, since entire year of holidays is computed for each call
|
|
isBankHolidayArea :: Feiertagsgebiet -> Day -> Bool
|
|
isBankHolidayArea land dd = dd `Set.member` holidays
|
|
where
|
|
(year, _, _) = toGregorian dd
|
|
holidays = bankHolidaysAreaSet land year
|
|
-}
|
|
|
|
-- | Returns whether a day is a bank holiday for years >= 1995
|
|
-- | Repeated calls are handled efficiently using a lazy cache for 2020--2075
|
|
isBankHolidayArea :: Feiertagsgebiet -> Day -> Bool
|
|
isBankHolidayArea land dd = dd `Set.member` holidays
|
|
where
|
|
(year, _, _) = toGregorian dd
|
|
holidays
|
|
| year >= cacheMinYear
|
|
, year <= cacheMaxYear
|
|
, (Just hys) <- Map.lookup land cacheHolidays
|
|
, (Just hds) <- Map.lookup year hys = hds
|
|
| otherwise = bankHolidaysAreaSet land year
|
|
|
|
cacheMinYear, cacheMaxYear :: Integer
|
|
cacheMinYear = 2020
|
|
cacheMaxYear = 2075
|
|
|
|
cacheHolidays :: Map.Map Feiertagsgebiet (Map.Map Integer (Set.Set Day))
|
|
cacheHolidays = Map.fromList [(land, Map.fromList
|
|
[(year, bankHolidaysAreaSet land year)
|
|
| year <- [cacheMinYear..cacheMaxYear]])
|
|
| land <- universeF] |