{-|
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]