diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index 273427f35..ae3ad0dc4 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -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 diff --git a/src/Handler/Utils/Occurrences.hs b/src/Handler/Utils/Occurrences.hs index e2ddf5964..a4d8e7b14 100644 --- a/src/Handler/Utils/Occurrences.hs +++ b/src/Handler/Utils/Occurrences.hs @@ -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" + } + +-} \ No newline at end of file