debug(occurrences): find error in occurrencesAddBusinessDays

This commit is contained in:
Steffen Jost 2023-06-02 11:17:20 +00:00
parent 88d43560ae
commit 79b45be5b6

View File

@ -51,8 +51,8 @@ occurrencesBounds Term{..} Occurrences{..} = (Set.lookupMin occDays, Set.lookupM
getOccDays :: OccurrenceSchedule -> Set Day -> Set Day
getOccDays ScheduleWeekly{scheduleDayOfWeek=wday} = Set.union $ daysOfWeekBetween (termLectureStart,termLectureEnd) wday
occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> Occurrences
occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrences newSchedule newExceptions
occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> (Occurrences,_)
occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = (Occurrences newSchedule newExceptions,(dayDiff, offDays,loff,dgb))
where
newSchedule = Set.map switchDayOfWeek occurrencesScheduled
dayDiff = diffDays dayNew dayOld
@ -64,16 +64,16 @@ occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrenc
switchDayOfWeek os | 0 == dayDiff `mod` 7 = os
switchDayOfWeek os@ScheduleWeekly{scheduleDayOfWeek=wday} = os{scheduleDayOfWeek= toEnum (fromIntegral dayDiff + fromEnum wday)}
newExceptions = snd $ Set.foldr advanceExceptions (dayDiff,mempty) occurrencesExceptions
(loff,newExceptions,dgb) = Set.foldl (flip advanceExceptions) (dayDiff,mempty,mempty) occurrencesExceptions
-- we assume that instance Ord OccurrenceException is ordered chronologically
advanceExceptions :: OccurrenceException -> (Integer, Set OccurrenceException) -> (Integer, Set OccurrenceException)
advanceExceptions ex (offset, acc)
advanceExceptions :: OccurrenceException -> (Integer, Set OccurrenceException,_) -> (Integer, Set OccurrenceException,_)
advanceExceptions ex (offset, acc, dbg)
| ed `Set.notMember` offDays -- skip term-holidays and weekends, unless the original day was a holiday or weekend
, nd `Set.member` offDays
= advanceExceptions ex (succ offset, acc)
= advanceExceptions ex (succ offset, acc, ("skip"<>show offset) :dbg)
| otherwise
= (offset, Set.insert (setDayOfOccurrenceException nd ex) acc)
= (offset, Set.insert (setDayOfOccurrenceException nd ex) acc, show ex : dbg)
where
ed = dayOfOccurrenceException ex
nd = addDays offset ed