fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(schedule-week): exclude exams without occurrences by join

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-23 17:25:00 +02:00
parent d19be72f58
commit 5bd0e7d050
1 changed files with 10 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Utils/Schedule/Week.hs
View File

@ -20,7 +20,6 @@ import Utils.Schedule.Types
import Utils.Schedule.Week.TimeSlot
-- TODO: implement dayOffset
weekSchedule :: UserId -> Maybe Integer -> Widget
weekSchedule uid dayOffset = do
now <- liftIO getCurrentTime
@ -59,14 +58,14 @@ weekSchedule uid dayOffset = do
)
return (course, tutorial)
-- TODO: this makes the exam table redundant once the weekOffset is implemented
-- TODO: this makes the exam table partly redundant => maybe remove?
-- TODO: for lecturers, do not display one entry for each exam occurrences, but instead collect all occurrences happening at the same time in a list
examOccurrences <- liftHandler . runDB $ E.select $ E.from $ \((course `E.InnerJoin` exam) `E.LeftOuterJoin` examOccurrence) -> do
examOccurrences <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examOccurrence) -> do
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
E.on $ E.just (exam E.^. ExamId) E.==. examOccurrence E.?. ExamOccurrenceExam
E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
E.where_ $ isCourseLecturer (Just uid) ata (course E.^. CourseId)
E.||. (E.exists $ E.from $ \examRegistration -> E.where_ $
examRegistration E.?. ExamRegistrationUser E.==. E.just (E.val uid)
examRegistration E.^. ExamRegistrationUser E.==. E.val uid
E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom)
E.&&. mayViewCourse (Just uid) ata now course Nothing) -- do NOT remove, this is actually necessary here!
-- (There can be exam participants that are
@ -100,8 +99,8 @@ weekSchedule uid dayOffset = do
let seOccurrence = Right (Left exception) in ScheduleEntry{..}
in scheduleds <> exceptions
examOccurrenceToScheduleEntry :: (Entity Course, Entity Exam, Maybe (Entity ExamOccurrence)) -> Maybe ScheduleEntry
examOccurrenceToScheduleEntry (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Just (Entity _ ExamOccurrence{..})) =
examOccurrenceToScheduleEntry :: (Entity Course, Entity Exam, Entity ExamOccurrence) -> ScheduleEntry
examOccurrenceToScheduleEntry (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Entity _ ExamOccurrence{..}) =
let seType = SETExamOccurrence
{ seteoExamName = examName
}
@ -110,8 +109,7 @@ weekSchedule uid dayOffset = do
{ seeoStart = examOccurrenceStart
, seeoEnd = examOccurrenceEnd
}
in Just ScheduleEntry{..}
examOccurrenceToScheduleEntry _ = Nothing -- TODO: exclude (_,_,Nothing) case via join
in ScheduleEntry{..}
seOccurrenceIsInSlot :: Day -> TimeSlot -> ScheduleEntryOccurrence -> Bool
seOccurrenceIsInSlot day slot = \case
@ -131,9 +129,9 @@ weekSchedule uid dayOffset = do
, Map.fromList $ slotsToDisplay <&> \slot ->
( slot
, filter (seOccurrenceIsInSlot day slot . seOccurrence) $ join $
(courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
<> (pure . catMaybes) (examOccurrenceToScheduleEntry <$> examOccurrences)
(courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
<> pure (examOccurrenceToScheduleEntry <$> examOccurrences)
)
)
@ -144,13 +142,11 @@ weekSchedule uid dayOffset = do
isRegularWithoutException = \case
-- remove regular occurrences if there is a NoOccur exception for the occurrence of this week
ScheduleEntry{seOccurrence=Right (Right ScheduleWeekly{..})} ->
-- TODO: is equality on scheduleStart sane?
not $ Right (Left $ ExceptNoOccur $ LocalTime (scheduleDayOfWeek `dayOfWeekToDayWith` now) scheduleStart)
`elem` (seOccurrence <$> occurrencesInSlot)
-- remove NoOccur exceptions if there is no regular occurrence to override
ScheduleEntry{seOccurrence=Right (Left ExceptNoOccur{exceptTime=LocalTime{..}})} ->
any (\case
-- TODO: is equality on scheduleStart sane?
Right (Right ScheduleWeekly{..}) -> scheduleDayOfWeek `dayOfWeekToDayWith` now == localDay
&& scheduleStart == localTimeOfDay
_ -> False