fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(occurrences): occurringLessons had an erroneously inverted condition

Browse Source
This commit is contained in:
Steffen Jost 2024-09-24 13:05:16 +02:00
parent 384c39b9ec
commit 4c2baa4e9f
2 changed files with 51 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/School/DayTasks.hs
View File

@ -71,9 +71,9 @@ data OccurrenceCacheKey = OccurrenceCacheKeyTutorials SchoolId (Day,Day)
deriving anyclass (Hashable, Binary)
getDayTutorials :: SchoolId -> (Day,Day) -> DB [TutorialId]
getDayTutorials ssh dlimit@(dstart, dend )
getDayTutorials ssh _dlimit@(dstart, dend )
| dstart > dend = return mempty
| otherwise = memcachedByClass MemcachedKeyClassTutorialOccurrences (Just . Right $ 9 * diffDay) (OccurrenceCacheKeyTutorials ssh dlimit) $ do
| otherwise = memcachedByClass MemcachedKeyClassTutorialOccurrences (Just . Right $ 9 * diffDay) (OccurrenceCacheKeyTutorials ssh dlimit) $
candidates <- E.select $ do
(trm :& crs :& tut) <- E.from $ E.table @Term
`E.innerJoin` E.table @Course `E.on` (\(trm :& crs) -> crs E.^. CourseTerm E.==. trm E.^. TermId)
@ -82,11 +82,12 @@ getDayTutorials ssh dlimit@(dstart, dend )
E.&&. trm E.^. TermStart E.<=. E.val dend
E.&&. trm E.^. TermEnd E.>=. E.val dstart
return (trm, tut, E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue dstart))
$logErrorS "DAILY" $ foldMap (\(Entity{entityVal=someTerm},Entity{entityVal=Tutorial{..}},_) -> tshow someTerm <> " *** " <> ciOriginal tutorialName <> ": " <> tshow (unJSONB tutorialTime)) candidates
return $ mapMaybe checkCandidate candidates
where
period = Set.fromAscList [dstart..dend]
checkCandidate (_, Entity{entityKey=tutId}, E.unValue -> True) = Just tutId -- common case
-- TODO: checkCandidate (_, Entity{entityKey=tutId}, E.unValue -> True) = Just tutId -- common case
checkCandidate (Entity{entityVal=trm}, Entity{entityKey=tutId, entityVal=Tutorial{tutorialTime=JSONB occ}},_)
| not $ Set.null $ Set.intersection period $ occurrencesCompute' trm occ
= Just tutId

56
src/Handler/Utils/Occurrences.hs
View File

@ -20,7 +20,7 @@ import Utils.Occurrences
import Handler.Utils.DateTime
-- import Text.Read (read) -- for DEBUGGING only
----------------
@ -38,7 +38,7 @@ occurringLessons t Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept s
where
scheduledLessons = occurrenceScheduleToLessons t `foldMap` occurrencesScheduled
(exceptOcc, exceptNo) = occurrenceExceptionToLessons occurrencesExceptions
isExcept LessonTime{lessonStart} = Set.member lessonStart exceptNo
isExcept LessonTime{lessonStart} = Set.notMember lessonStart exceptNo
occurrenceScheduleToLessons :: Term -> OccurrenceSchedule -> Set LessonTime
occurrenceScheduleToLessons Term{..} =
@ -84,14 +84,13 @@ occurrencesWidget (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
$(widgetFile "widgets/occurrence/cell/except-no-occur")
$(widgetFile "widgets/occurrence/cell")
-- | More precise verison of `occurrencesCompute`, which accounts for TimeOfDay as well
occurrencesCompute' :: Term -> Occurrences -> Set Day
occurrencesCompute' trm occ = Set.map (localDay . lessonStart) $ occurringLessons trm occ
-- | Get all occurrences during a term, excluding term holidays from the regular schedule, but not from exceptions
-- Beware: code currently ignores TimeOfDay, see Model.Types.DateTime.LessonTime for a start to address this if needed
-- | Get all days of occurrences during a term, excluding term holidays from the regular schedule, but not from do-occur exceptions
occurrencesCompute :: Term -> Occurrences -> Set Day
occurrencesCompute Term{..} Occurrences{..} = ((scdDays \\ Set.fromList termHolidays) <> plsDays) \\ excDays
occurrencesCompute trm occ = Set.map (localDay . lessonStart) $ occurringLessons trm occ
-- | Less precise versison of `occurrencesCompute`, which ignores TimeOfDay; might be faster, but could be wrong in some cases
occurrencesCompute' :: Term -> Occurrences -> Set Day
occurrencesCompute' Term{..} Occurrences{..} = ((scdDays \\ Set.fromList termHolidays) <> plsDays) \\ excDays
where
scdDays = Set.foldr getOccDays mempty occurrencesScheduled
(plsDays,excDays) = Set.foldr getExcDays mempty occurrencesExceptions
@ -133,3 +132,42 @@ occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrenc
where
ed = dayOfOccurrenceException ex
nd = addDays offset ed
{-
-----------
-- DEBUG --
-----------
theorieschulung :: Occurrences
theorieschulung =
Occurrences
{occurrencesScheduled = Set.fromList
[ScheduleWeekly {scheduleDayOfWeek = Thursday, scheduleStart = read "11:11:00", scheduleEnd = read "12:22:00"}
,ScheduleWeekly {scheduleDayOfWeek = Friday , scheduleStart = read "13:33:00", scheduleEnd = read "14:44:00"}
,ScheduleWeekly {scheduleDayOfWeek = Sunday , scheduleStart = read "15:55:00", scheduleEnd = read "16:06:00"}
]
, occurrencesExceptions = Set.fromList
[ExceptOccur {exceptDay = read "2024-01-07", exceptStart = read "08:30:00", exceptEnd = read "16:00:00"}
,ExceptOccur {exceptDay = read "2024-01-15", exceptStart = read "09:00:00", exceptEnd = read "16:00:00"}
,ExceptOccur {exceptDay = read "2024-09-24", exceptStart = read "09:10:00", exceptEnd = read "16:10:00"}
,ExceptNoOccur {exceptTime = read "2024-02-25 15:55:00"}
,ExceptNoOccur {exceptTime = read "2024-10-25 13:33:00"}
,ExceptNoOccur {exceptTime = read "2024-11-08 08:08:08"} -- causes difference between occurrencesCompute and occurrencesCompute'
,ExceptNoOccur {exceptTime = read "2024-11-09 11:11:08"}
]
}
exampleTerm :: Term
exampleTerm = Term
{ termName = TermIdentifier {year = 2024}
, termStart = read "2024-01-01"
, termEnd = read "2024-12-29"
, termHolidays = [read "2024-01-01", read "2024-03-29", read "2024-03-31", read "2024-04-01", read "2024-05-01", read "2024-05-09"
,read "2024-05-19", read "2024-05-20", read "2024-05-30", read "2024-10-03", read "2024-12-24", read "2024-12-25", read "2024-12-26" ]
, termLectureStart = read "2024-01-01"
, termLectureEnd = read "2024-12-27"
}
-}