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

feat(schedule): include tutorials

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-20 18:10:59 +02:00
parent 2d38172363
commit 4007122265
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Utils/Schedule.hs
View File

@ -45,9 +45,6 @@ weekSchedule uid _weekOffset = do
-- TODO: fetch course events for this week only?
courseEvents <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
--E.where_ $ E.exists $ E.from $ \term -> E.where_ $
-- term E.^. TermId E.==. course E.^. CourseTerm
-- E.&&. term E.^. TermActive
E.where_ $ (E.exists $ E.from $ \courseParticipant -> E.where_ $
courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
E.&&. courseParticipant E.^. CourseParticipantUser E.==. E.val uid
@ -59,11 +56,8 @@ weekSchedule uid _weekOffset = do
)
return (course, courseEvent)
_tutorials <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
tutorials <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
--E.where_ $ E.exists $ E.from $ \term -> E.where_ $
-- term E.^. TermId E.==. course E.^. CourseTerm
-- E.&&. term E.^. TermActive
E.where_ $ (E.exists $ E.from $ \tutorialParticipant -> E.where_ $
tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
@ -88,6 +82,19 @@ weekSchedule uid _weekOffset = do
exceptions = Set.toList occurrencesExceptions <&> \exception ->
let seOccurrence = Left exception in ScheduleEntry{..}
in scheduleds <> exceptions
tutorialToScheduleEntries :: (Entity Course, Entity Tutorial) -> [ScheduleEntry]
tutorialToScheduleEntries (seCourse@(Entity _ Course{..}), Entity _ Tutorial{tutorialType,tutorialRoom,tutorialTime=Occurrences{..}}) =
let seType = SETTutorial { settType = tutorialType }
seRoom = tutorialRoom
scheduleds
-- omit regular occurrences if the course's term is not currently active
| not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
| otherwise = Set.toList occurrencesScheduled <&> \scheduled ->
let seOccurrence = Right scheduled in ScheduleEntry{..}
exceptions = Set.toList occurrencesExceptions <&> \exception ->
let seOccurrence = Left exception in ScheduleEntry{..}
in scheduleds <> exceptions
seOccurrenceIsInSlot :: Day -> TimeSlot -> ScheduleEntryOccurrence -> Bool
seOccurrenceIsInSlot day slot seOcc =
@ -103,8 +110,9 @@ weekSchedule uid _weekOffset = do
( day
, Map.fromList $ slotsToDisplay <&> \slot ->
( slot
, filter (seOccurrenceIsInSlot day slot . seOccurrence) $ join $ courseEventToScheduleEntries <$> courseEvents
-- TODO: include tutorials
, filter (seOccurrenceIsInSlot day slot . seOccurrence) $ join $
(courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
-- TODO: incluse exams (maybe)
)
)