diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `bank-holiday-germany` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2024 Jakob Schöttl + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# bank-holiday-germany + +This module provides calculation of bank holidays in Germany. + +Most of these bank holidays are also public aka legal holidays +throughout Germany. You can use `isPublicHoliday` to check if a +holiday is also a legal holiday. + +Legal holidays are generally off for all employees. Bank holidays that +are no legal holidays as well are generally only off for bank employees. + +Note: There are even more public holidays in each federal state which +are not covered by this module. + +https://de.wikipedia.org/wiki/Bankfeiertag diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bank-holiday-germany.cabal b/bank-holiday-germany.cabal new file mode 100644 --- /dev/null +++ b/bank-holiday-germany.cabal @@ -0,0 +1,60 @@ +cabal-version: 3.6 + +name: bank-holiday-germany +version: 1.0.0.0 +synopsis: German bank holidays and public holidays +description: Calculation of bank holidays and most public holidays in Germany. +homepage: https://github.com/schoettl/bank-holiday-germany#readme +license: MIT +license-file: LICENSE +author: Jakob Schöttl +maintainer: jakob.schoettl@intensovet.de +copyright: 2024 Jakob Schöttl +category: Time +build-type: Simple +extra-source-files: README.md + CHANGELOG.md + +library + hs-source-dirs: src + exposed-modules: Data.Time.Calendar.BankHoliday.Germany + build-depends: base >= 4.7 && < 5 + , time >= 1.12.2 && < 1.13 + default-language: GHC2021 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Data.Time.Calendar.BankHoliday.Germany + hs-source-dirs: test + , src + build-depends: base + , bank-holiday-germany + , time >= 1.12.2 && < 1.13 + , doctest >= 0.22.2 && < 0.23 + , hedgehog >= 1.4 && < 1.5 + , hspec >= 2.11.7 && < 2.12 + , hspec-hedgehog >= 0.1.0 && < 0.2 + default-language: GHC2021 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +source-repository head + type: git + location: https://github.com/schoettl/bank-holiday-germany diff --git a/src/Data/Time/Calendar/BankHoliday/Germany.hs b/src/Data/Time/Calendar/BankHoliday/Germany.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Calendar/BankHoliday/Germany.hs @@ -0,0 +1,139 @@ + +{-| +Description: Calculation of bank holidays in Germany. + +This module computes general bank holidays. +Most of these bank holidays are also public aka legal holidays +throughout Germany. You can use 'isPublicHoliday' to check if a +holiday is also a legal holiday. + +Note: There are even more public holidays in each federal state which +are not covered by this module. + +https://de.wikipedia.org/wiki/Bankfeiertag + +-} + +module Data.Time.Calendar.BankHoliday.Germany ( + BankHoliday(..), + isBankHoliday, + isPublicHoliday, + calculateEasterSunday, + holidaysBetween, + fromDay, + toDay, + germanHolidayName +) where + +import Data.Time.Calendar +import Data.Maybe + +-- | Data type specifying German bank holidays. +-- +-- Note: This type cannot be an instance of class 'Ord' because due to +-- Easter day calculation the order can change from year to year. +data BankHoliday + = NewYearsDay + | GoodFriday -- ^ Karfreitag + | EasterMonday + | LabourDay + | AscensionDay -- ^ Christi Himmelfahrt + | WhitMonday -- ^ Pfingstmontag + | GermanUnityDay + | ChristmasEve + | ChristmasDay + | SecondChristmasDay + | NewYearsEve + deriving (Enum, Eq, Bounded, Show, Read) + + +-- | Check if a given day is a 'BankHoliday'. +-- +-- >>> isBankHoliday (fromGregorian 2024 1 1) +-- True +isBankHoliday :: Day -> Bool +isBankHoliday = isJust . fromDay + +-- | Helper to extract the year from a date. +-- +-- >>> yearFromDay $ fromGregorian 2020 1 1 +-- 2020 +yearFromDay :: Day -> Year +yearFromDay = (\(y, _, _) -> y) . toGregorian + +-- | Calculate Easter Sunday using Spencer's algorithm. +calculateEasterSunday :: Year -> Day +calculateEasterSunday year = + let + a = year `rem` 19 + b = year `quot` 100 + c = year `rem` 100 + d = b `quot` 4 + e = b `rem` 4 + f = (b + 8) `quot` 25 + g = (b - f + 1) `quot` 3 + h = (19 * a + b - d - g + 15) `rem` 30 + i = c `quot` 4 + k = c `rem` 4 + l = (32 + 2 * e + 2 * i - h - k) `rem` 7 + m = (a + 11 * h + 22 * l) `quot` 451 + n = (h + l - 7 * m + 114) `quot` 31 + o = (h + l - 7 * m + 114) `rem` 31 + in + fromGregorian year (fromIntegral n) (fromIntegral o + 1) + +-- | Compute the date for a given year and bank holiday. +-- +-- >>> toDay 2024 LabourDay +-- 2024-05-01 +toDay :: Year -> BankHoliday -> Day +toDay year NewYearsDay = fromGregorian year 1 1 +toDay year GoodFriday = addDays (-2) (calculateEasterSunday year) +toDay year EasterMonday = addDays 1 (calculateEasterSunday year) +toDay year LabourDay = fromGregorian year 5 1 +toDay year AscensionDay = addDays 39 (calculateEasterSunday year) +toDay year WhitMonday = addDays 50 (calculateEasterSunday year) +toDay year GermanUnityDay = fromGregorian year 10 3 +toDay year ChristmasEve = fromGregorian year 12 24 +toDay year ChristmasDay = fromGregorian year 12 25 +toDay year SecondChristmasDay = fromGregorian year 12 26 +toDay year NewYearsEve = fromGregorian year 12 31 + +-- | Compute 'Maybe' the holiday for a given date. +-- +-- >>> fromDay (fromGregorian 2024 1 1) +-- Just NewYearsDay +-- +-- >>> fromDay (fromGregorian 2024 5 5) +-- Nothing +fromDay :: Day -> Maybe BankHoliday +fromDay day = listToMaybe $ filter (\d -> day == toDay (yearFromDay day) d) [minBound..maxBound] + +-- | Compute pairs of date and holiday from start to end. +-- +-- >>> map snd $ holidaysBetween (fromGregorian 2024 12 25) (fromGregorian 2024 12 26) +-- [ChristmasDay,SecondChristmasDay] +holidaysBetween :: Day -> Day -> [(Day, BankHoliday)] +holidaysBetween start end = catMaybes $ map (\d -> (d,) <$> fromDay d) [start..end] + +-- | Translate the holiday name to German. +germanHolidayName :: BankHoliday -> String +germanHolidayName d = case d of + NewYearsDay -> "Neujahrstag" + GoodFriday -> "Karfreitag" + EasterMonday -> "Ostermontag" + LabourDay -> "Tag der Arbeit" + AscensionDay -> "Christi Himmelfahrt" + WhitMonday -> "Pfingstmontag" + GermanUnityDay -> "Tag der Deutschen Einheit" + ChristmasEve -> "Heilig Abend" + ChristmasDay -> "1. Weihnachtsfeiertag" + SecondChristmasDay -> "2. Weihnachtsfeiertag" + NewYearsEve -> "Silvestertag" + +-- | True only for German public holidays aka legal holidays. +-- Chrismas Eve and New Year's Eve are bank holidays but not public holidays. +isPublicHoliday :: BankHoliday -> Bool +isPublicHoliday ChristmasEve = False +isPublicHoliday NewYearsEve = False +isPublicHoliday _ = True diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,61 @@ + +module Main (main) where + +import Data.Time.Calendar.BankHoliday.Germany +import Data.Time.Calendar.WeekDate +import Data.Time + +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Hspec (describe, hspec, it, shouldBe) +import Test.Hspec.Hedgehog (forAll, hedgehog, (===)) +import Test.DocTest + +day :: Year -> Int -> Int -> Day +day = fromGregorian + +year :: Day -> Year +year = (\(y, _, _) -> y) . toGregorian + +main :: IO () +main = do + doctest ["src/"] + hspec $ do + describe "holidaysBetween" $ do + it "works for Christmas" $ + holidaysBetween (day 2024 12 1) (day 2024 12 30) + `shouldBe` [(day 2024 12 24, ChristmasEve), (day 2024 12 25, ChristmasDay), (day 2024 12 26, SecondChristmasDay)] + it "is empty list when there are no holidays" $ + holidaysBetween (day 2024 12 1) (day 2024 12 3) + `shouldBe` [] + it "counts 11 bank holidays and 9 public holidays per year (2010 to 2020)" $ hedgehog $ do + y <- forAll $ Gen.integral (Range.linear 2010 2020) + let bankHolidays = holidaysBetween (day y 1 1) (day y 12 31) + length bankHolidays === 11 + length (filter (isPublicHoliday . snd) bankHolidays) === 9 + describe "toDay" $ do + it "always returns a day in the given year" $ hedgehog $ do + y <- forAll $ Gen.integral (Range.linear 0 5000) + d <- forAll Gen.enumBounded + year (toDay y d) === y + it "Easter Monday is always a Monday" $ hedgehog $ do + y <- forAll $ Gen.integral (Range.linear 0 5000) + let (_, _, d) = toWeekDate $ toDay y EasterMonday + d === 1 -- 1 = Monday + describe "calculateEasterSunday" $ do + it "is always between Mar 22 and Apr 25" $ hedgehog $ do + y <- forAll $ Gen.integral (Range.linear 0 10000) + (calculateEasterSunday y >= day y 3 22) === True + (calculateEasterSunday y <= day y 4 25) === True + it "is correct for some years" $ do + calculateEasterSunday 2024 `shouldBe` day 2024 3 31 + calculateEasterSunday 2025 `shouldBe` day 2025 4 20 + calculateEasterSunday 2026 `shouldBe` day 2026 4 5 + it "is always a Sunday" $ hedgehog $ do + y <- forAll $ Gen.integral (Range.linear 0 5000) + let (_, _, d) = toWeekDate $ calculateEasterSunday y + d === 7 -- 7 = Sunday + describe "isPublicHoliday" $ do + it "is False only for Chrismas Eve and New Year's Eve" $ + length (filter (not . isPublicHoliday) [minBound..maxBound]) + `shouldBe` 2