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): omit regular occurrences of inactive terms

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-20 17:37:53 +02:00
parent 2ea234259b
commit 38fc5fa986
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Utils/Schedule.hs
View File

@ -31,17 +31,18 @@ slotToDisplayTime t = formatTimeRangeW SelFormatTime (TimeOfDay t 0 0) $ Just $
-- TODO: implement weekOffset -- TODO: implement weekOffset
weekSchedule :: UserId weekSchedule :: UserId -> Maybe Int -> Widget
-> Maybe Int -- weekOffset
-> Widget
weekSchedule uid _weekOffset = do weekSchedule uid _weekOffset = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
ata <- getSessionActiveAuthTags ata <- getSessionActiveAuthTags
-- TODO: single runDB for all fetches below? -- TODO: single runDB for all fetches below?
-- TODO: filter by activeTerm only for regular occurrences, i.e. not for exceptions
activeTerms <- liftHandler . runDB $ E.select $ E.from $ \term -> do
E.where_ $ term E.^. TermActive
return $ term E.^. TermId
-- TODO: fetch course events for this week only: -- TODO: fetch course events for this week only?
courseEvents'' <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do courseEvents'' <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
--E.where_ $ E.exists $ E.from $ \term -> E.where_ $ --E.where_ $ E.exists $ E.from $ \term -> E.where_ $
@ -77,13 +78,16 @@ weekSchedule uid _weekOffset = do
let let
courseEventToScheduleEntries :: (Entity Course, Entity CourseEvent) -> [ScheduleEntry] courseEventToScheduleEntries :: (Entity Course, Entity CourseEvent) -> [ScheduleEntry]
courseEventToScheduleEntries (seCourse, Entity _ CourseEvent{courseEventType,courseEventRoom,courseEventTime=Occurrences{..}}) = courseEventToScheduleEntries (seCourse@(Entity _ Course{..}), Entity _ CourseEvent{courseEventType,courseEventRoom,courseEventTime=Occurrences{..}}) =
let seType = SETCourseEvent { setceType = courseEventType } let seType = SETCourseEvent { setceType = courseEventType }
seRoom = Just courseEventRoom seRoom = Just courseEventRoom
scheduleds = Set.toList occurrencesScheduled <&> \scheduled -> scheduleds
let seOccurrence = Right scheduled in ScheduleEntry{..} -- omit regular occurrences if the course's term is not currently active
exceptions = Set.toList occurrencesExceptions <&> \exception -> | not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
let seOccurrence = Left exception in ScheduleEntry{..} | 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 in scheduleds <> exceptions
seOccurrenceIsInSlot :: Day -> TimeSlot -> ScheduleEntryOccurrence -> Bool seOccurrenceIsInSlot :: Day -> TimeSlot -> ScheduleEntryOccurrence -> Bool
@ -144,7 +148,7 @@ weekSchedule uid _weekOffset = do
, (MsgScheduleWeekDaySunday , "sun") , (MsgScheduleWeekDaySunday , "sun")
] ]
formatOccurrenceW :: Either OccurrenceException OccurrenceSchedule -> Widget formatOccurrenceW :: ScheduleEntryOccurrence -> Widget
formatOccurrenceW = \case formatOccurrenceW = \case
Right ScheduleWeekly{..} -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd) Right ScheduleWeekly{..} -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd)
Left ExceptOccur{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatDateTime (LocalTime exceptDay exceptStart) (Just (LocalTime exceptDay exceptEnd)) Left ExceptOccur{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatDateTime (LocalTime exceptDay exceptStart) (Just (LocalTime exceptDay exceptEnd))