bank-holiday-germany-1.0.0.2: German bank holidays and public holidays
Safe HaskellSafe-Inferred
LanguageGHC2021

Data.Time.Calendar.BankHoliday.Germany.ExtraHolidays

Description

This module provides additional German public holidays that are not covered by the bank holidays.

Public holidays – except for GermanUnityDay – are under federal obligations in Germany („Ländersache“).

Most bank holidays are also federal public holidays (see isPublicHoliday). But there are some additional extra holidays which may differ between federal states.

For example Heilige Drei Könige is not a bank holiday but it is a public holiday in Bavaria.

Note: The extra holidays are currently only implemented for Bavaria.

Example for computing all public holidays in Bavaria (Landkreis Miesbach, Oberbayern) in the next couple years:

  import Data.List
  import Data.Time
  import qualified Data.Time.Calendar.BankHoliday.Germany as BH
  import qualified Data.Time.Calendar.BankHoliday.Germany.ExtraHolidays as EH

  start = fromGregorian 2024 1 1

  end = fromGregorian 2026 12 31

  holidays :: [[String]]
  holidays = map ((x,y) -> [show x, BH.germanHolidayName y]) (filter (BH.isPublicHoliday . snd) $ BH.holidaysBetween start end)
          ++ map ((x,y) -> [show x, EH.germanHolidayName y]) (filter ((/=EH.Friedensfest) . snd) $ EH.holidaysBetween EH.Bayern start end)

  putStrLn $ unlines $ sort $ map unwords holidays

Resources:

Synopsis

Documentation

data ExtraHoliday Source #

Extra federal holidays, no overlap with BankHoliday. Spezielle Feiertage der Bundesländer.

Note: Currently, only Bavaria's extra holidays are implemented.

Constructors

HeiligeDreiKoenige

Heilige Drei Könige (Bayern, …)

Fronleichnam

Fronleichnam (Bayern, …)

Friedensfest

Friedensfest (Bayern (Augsburg), …)

MariaeHimmelfahrt

Mariä Himmelfahrt (Bayern (regional), …)

Allerheiligen

Allerheiligen (Bayern, …)

data FederalState Source #

Germany's federal states – Deutsche Bundesländer.

holidaysBetween :: FederalState -> Day -> Day -> [(Day, ExtraHoliday)] Source #

Compute pairs of date and holiday from start to end for the given federal state.

>>> map snd $ holidaysBetween Bayern (fromGregorian 2024 8 8) (fromGregorian 2024 8 15)
[Friedensfest,MariaeHimmelfahrt]

fromDay :: Day -> Maybe ExtraHoliday Source #

Compute Maybe the holiday for a given date.

>>> fromDay (fromGregorian 2024 11 1)
Just Allerheiligen
>>> fromDay (fromGregorian 2024 5 5)
Nothing

toDay :: Year -> ExtraHoliday -> Day Source #

Compute the date for a given year and extra holiday.

>>> toDay 2024 HeiligeDreiKoenige
2024-01-06

germanHolidayName :: ExtraHoliday -> String Source #

Translate the holiday name to German.

isHolidayInState :: FederalState -> ExtraHoliday -> Bool Source #

Check if ExtraHoliday is a holiday in the given federal state.

>>> isHolidayInState Bayern Allerheiligen
True
>>> isHolidayInState Berlin Allerheiligen
False