module Holidays.DateFinder (
  after,
  before,
  nextOpenDay,
  days,
  years,
  sun,
  mon,
  tues,
  wed,
  thurs,
  fri,
  sat,
  jan,
  feb,
  mar,
  apr,
  may,
  jun,
  jul,
  aug,
  sep,
  oct,
  nov,
  dec,
  easterSunday,
  easterMonday,
  goodFriday,
  christmasDay,
  boxingDay,
  newYearsDay,
  ascensionDay,
  workersDay,
) where

import Data.Maybe
import Data.Set qualified as S
import Data.Time

import Data.Time.Calendar.Easter
import Holidays.Base

data Direction = Past | Future

-- common dates
newYearsDay :: Year -> Day
newYearsDay :: Integer -> Day
newYearsDay = DayOfMonth -> Integer -> Day
jan DayOfMonth
1

easterSunday :: Year -> Day
easterSunday :: Integer -> Day
easterSunday = Integer -> Day
gregorianEaster

easterMonday :: Year -> Day
easterMonday :: Integer -> Day
easterMonday = Integer -> Day -> Day
addDays Integer
1 (Day -> Day) -> (Integer -> Day) -> Integer -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day
easterSunday

goodFriday :: Year -> Day
goodFriday :: Integer -> Day
goodFriday = (Integer
1 `fri`) ((Integer -> Maybe DayOfWeek -> Day) -> Day)
-> (Integer -> Integer -> Maybe DayOfWeek -> Day) -> Integer -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer -> Maybe DayOfWeek -> Day
before (Day -> Integer -> Maybe DayOfWeek -> Day)
-> (Integer -> Day) -> Integer -> Integer -> Maybe DayOfWeek -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day
easterSunday

christmasDay :: Year -> Day
christmasDay :: Integer -> Day
christmasDay = DayOfMonth -> Integer -> Day
dec DayOfMonth
25

boxingDay :: Year -> Day
boxingDay :: Integer -> Day
boxingDay = DayOfMonth -> Integer -> Day
dec DayOfMonth
26

ascensionDay :: Year -> Day
ascensionDay :: Integer -> Day
ascensionDay = (Integer
39 `days`) ((Integer -> Maybe DayOfWeek -> Day) -> Day)
-> (Integer -> Integer -> Maybe DayOfWeek -> Day) -> Integer -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer -> Maybe DayOfWeek -> Day
after (Day -> Integer -> Maybe DayOfWeek -> Day)
-> (Integer -> Day) -> Integer -> Integer -> Maybe DayOfWeek -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Day
easterSunday

workersDay :: Year -> Day
workersDay :: Integer -> Day
workersDay = DayOfMonth -> Integer -> Day
may DayOfMonth
1

days :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
days :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
days Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n Maybe DayOfWeek
forall a. Maybe a
Nothing

years :: (Year -> Bool) -> Day -> Day
years :: (Integer -> Bool) -> Day -> Day
years Integer -> Bool
f Day
d = if Integer -> Bool
f (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) then Day
d else Day
nullDay
  where
    (Integer
y, DayOfMonth
_, DayOfMonth
_) = Day -> (Integer, DayOfMonth, DayOfMonth)
toGregorian Day
d

-- months
jan :: DayOfMonth -> Year -> Day
jan :: DayOfMonth -> Integer -> Day
jan DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
January DayOfMonth
d

feb :: DayOfMonth -> Year -> Day
feb :: DayOfMonth -> Integer -> Day
feb DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
February DayOfMonth
d

mar :: DayOfMonth -> Year -> Day
mar :: DayOfMonth -> Integer -> Day
mar DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
March DayOfMonth
d

apr :: DayOfMonth -> Year -> Day
apr :: DayOfMonth -> Integer -> Day
apr DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
April DayOfMonth
d

may :: DayOfMonth -> Year -> Day
may :: DayOfMonth -> Integer -> Day
may DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
May DayOfMonth
d

jun :: DayOfMonth -> Year -> Day
jun :: DayOfMonth -> Integer -> Day
jun DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
June DayOfMonth
d

jul :: DayOfMonth -> Year -> Day
jul :: DayOfMonth -> Integer -> Day
jul DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
July DayOfMonth
d

aug :: DayOfMonth -> Year -> Day
aug :: DayOfMonth -> Integer -> Day
aug DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
August DayOfMonth
d

sep :: DayOfMonth -> Year -> Day
sep :: DayOfMonth -> Integer -> Day
sep DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
September DayOfMonth
d

oct :: DayOfMonth -> Year -> Day
oct :: DayOfMonth -> Integer -> Day
oct DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
October DayOfMonth
d

nov :: DayOfMonth -> Year -> Day
nov :: DayOfMonth -> Integer -> Day
nov DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
November DayOfMonth
d

dec :: DayOfMonth -> Year -> Day
dec :: DayOfMonth -> Integer -> Day
dec DayOfMonth
d Integer
y = Integer -> DayOfMonth -> DayOfMonth -> Day
day Integer
y DayOfMonth
December DayOfMonth
d

-- time travel

-- | Time-travel to the past in number of days. Excludes the specified Day.
before :: Day -> Integer -> Maybe DayOfWeek -> Day
before :: Day -> Integer -> Maybe DayOfWeek -> Day
before = Direction -> Day -> Integer -> Maybe DayOfWeek -> Day
timeTravel Direction
Past

-- | Time-travel to the past in number of days. Includes the specified Day.
after :: Day -> Integer -> Maybe DayOfWeek -> Day
after :: Day -> Integer -> Maybe DayOfWeek -> Day
after = Direction -> Day -> Integer -> Maybe DayOfWeek -> Day
timeTravel Direction
Future

-- | Time-travels to the past or future by adding a number of days.
timeTravel :: Direction -> Day -> Integer -> Maybe DayOfWeek -> Day
timeTravel :: Direction -> Day -> Integer -> Maybe DayOfWeek -> Day
timeTravel Direction
Past Day
d Integer
n Maybe DayOfWeek
w
  | Maybe DayOfWeek -> Bool
forall a. Maybe a -> Bool
isNothing Maybe DayOfWeek
w = Integer -> Day -> Day
addDays (Integer -> Integer
forall a. Num a => a -> a
negate Integer
n) Day
d
  | Bool
otherwise =
      let diff :: Integer
diff = DayOfMonth -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DayOfMonth -> Integer) -> DayOfMonth -> Integer
forall a b. (a -> b) -> a -> b
$ if Day -> DayOfWeek
dayOfWeek Day
d DayOfWeek -> DayOfWeek -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe DayOfWeek -> DayOfWeek
forall a. HasCallStack => Maybe a -> a
fromJust Maybe DayOfWeek
w then DayOfMonth
7 else DayOfWeek -> DayOfWeek -> DayOfMonth
dayOfWeekDiff (Day -> DayOfWeek
dayOfWeek Day
d) (Maybe DayOfWeek -> DayOfWeek
forall a. HasCallStack => Maybe a -> a
fromJust Maybe DayOfWeek
w)
      in  Integer -> Day -> Day
addDays (Integer -> Integer
forall a. Num a => a -> a
negate Integer
diff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- ((Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7)) Day
d
timeTravel Direction
Future Day
d Integer
n Maybe DayOfWeek
w
  | Maybe DayOfWeek -> Bool
forall a. Maybe a -> Bool
isNothing Maybe DayOfWeek
w = Integer -> Day -> Day
addDays Integer
n Day
d
  | Bool
otherwise =
      let diff :: Integer
diff = DayOfMonth -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DayOfMonth -> Integer) -> DayOfMonth -> Integer
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> DayOfWeek -> DayOfMonth
dayOfWeekDiff (Maybe DayOfWeek -> DayOfWeek
forall a. HasCallStack => Maybe a -> a
fromJust Maybe DayOfWeek
w) (Day -> DayOfWeek
dayOfWeek Day
d)
      in  Integer -> Day -> Day
addDays (Integer
diff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ((Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7)) Day
d

-- week days
sun :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
sun :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
sun Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Sunday)

mon :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
mon :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
mon Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Monday)

tues :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
tues :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
tues Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Tuesday)

wed :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
wed :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
wed Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Wednesday)

thurs :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
thurs :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
thurs Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Thursday)

fri :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
fri :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
fri Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Friday)

sat :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
sat :: Integer -> (Integer -> Maybe DayOfWeek -> Day) -> Day
sat Integer
n Integer -> Maybe DayOfWeek -> Day
f = Integer -> Maybe DayOfWeek -> Day
f Integer
n (DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just DayOfWeek
Saturday)

-- | Get the next open day by skipping days which are already holidays or specified days of the week.
nextOpenDay :: [DayOfWeek] -> S.Set Holiday -> Holiday -> Holiday
nextOpenDay :: [DayOfWeek] -> Set Holiday -> Holiday -> Holiday
nextOpenDay [DayOfWeek]
ds Set Holiday
s Holiday
d
  | Day -> DayOfWeek
dayOfWeek Day
d' DayOfWeek -> [DayOfWeek] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DayOfWeek]
ds = [DayOfWeek] -> Set Holiday -> Holiday -> Holiday
nextOpenDay [DayOfWeek]
ds Set Holiday
s (Holiday
d {holidayValue :: Day
holidayValue = Integer -> Day -> Day
addDays Integer
1 Day
d'})
  | Holiday -> Set Holiday -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Holiday
d Set Holiday
s = [DayOfWeek] -> Set Holiday -> Holiday -> Holiday
nextOpenDay [DayOfWeek]
ds Set Holiday
s (Holiday
d {holidayValue :: Day
holidayValue = Integer -> Day -> Day
addDays Integer
1 Day
d'})
  | Bool
otherwise = Holiday
d
  where
    d' :: Day
d' = Holiday -> Day
holidayValue Holiday
d