fix(schedule): consider lecture period & holidays

messages/uniworx/de-de-formal.msg

@@ -141,6 +141,7 @@ ScheduleOffsetWeekForwardDays n@Int: #{n} #{pluralDE n "Tag" "Tage"} vorwärts
 ScheduleOffsetWeekForwardWeek: 1 Woche vorwärts
 
 ScheduleWeekSlotIsCont: Forts.
+ScheduleWeekHoliday: Feiertag
 
 ScheduleOptActions: Terminübersicht
 ScheduleOptOut: Deabonnieren
@@ -1749,6 +1750,7 @@ LecturerType: Rolle
 ScheduleKindWeekly: Wöchentlich
 
 ScheduleRegular: Planmäßiger Termin
+ScheduleRegularTip: Planmäßige Termine werden im Kalender nur während der Vorlesungszeit des relevanten Semesters und nicht an Feiertagen angezeigt. Wenn Sie Termine außerhalb der Vorlesungszeit angeben möchten, muss dies über Termin-Ausnahmen geschehen.
 ScheduleRegularKind: Plan
 WeekDay: Wochentag
 Day: Tag
@@ -1758,7 +1760,7 @@ OccurrenceNever: Nie
 ScheduleExists: Dieser Plan existiert bereits
 
 ScheduleExceptions: Termin-Ausnahmen
-ScheduleExceptionsTip: Ausfälle überschreiben planmäßiges Stattfinden. Außerplanmäßiges Stattfinden überschreibt Ausfall.
+ScheduleExceptionsTip: Ausfälle überschreiben planmäßiges Stattfinden. Außerplanmäßiges Stattfinden überschreibt Ausfall. Außerplanmäßiges Stattfinden wird nur im Kalender angezeigt, solange das relevante Semester aktiv ist.
 ExceptionKind: Termin ...
 ExceptionKindOccur: Findet statt
 ExceptionKindNoOccur: Findet nicht statt

messages/uniworx/en-eu.msg

@@ -1748,6 +1748,7 @@ LecturerType: Role
 ScheduleKindWeekly: Weekly
 
 ScheduleRegular: Regular occurrence
+ScheduleRegularTip: Regular occurrences will only be displayed in the calendar during the relevant term's lecture period and not on holidays. If you wish to specify occurrences outside of the lecture period you have to do so using exceptions.
 ScheduleRegularKind: Schedule
 WeekDay: Day of the week
 Day: Day
@@ -1757,7 +1758,7 @@ OccurrenceNever: Never
 ScheduleExists: This schedule already exists
 
 ScheduleExceptions: Exceptions
-ScheduleExceptionsTip: “Does not occur” overrides the regular schedule. “Does occur” overides “does not occur”.
+ScheduleExceptionsTip: “Does not occur” overrides the regular schedule. “Does occur” overides “does not occur”. “Does occur” will only be displayed in the calendar as long as the relevant term is active.
 ExceptionKind: Event ...
 ExceptionKindOccur: Does occur
 ExceptionKindNoOccur: Does not occur

src/Handler/Utils/Form/Occurrences.hs

@@ -44,7 +44,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
       (\p -> Just . SomeRoute $ cRoute :#: p)
       miLayout'
       (miIdent' <> "__scheduled" :: Text)
-      (fslI MsgScheduleRegular)
+      (fslI MsgScheduleRegular & setTooltip MsgScheduleRegularTip)
       False
       (Set.toList . occurrencesScheduled <$> mPrev)
       where

src/Utils/Schedule.hs

@@ -15,10 +15,10 @@ import Utils.Schedule.Types
 
 
 -- TODO: move to general utils or use general utils function if available
-fetchActiveTerms :: MonadHandler m => ReaderT SqlBackend m [E.Value TermId]
+fetchActiveTerms :: MonadHandler m => ReaderT SqlBackend m [Entity Term]
 fetchActiveTerms = E.select $ E.from $ \term -> do
   E.where_ $ term E.^. TermActive
-  return   $ term E.^. TermId
+  return term
 
 fetchCourseEventsScheduleInfo :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleCourseEventInfo]
 fetchCourseEventsScheduleInfo muid ata now = E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do

src/Utils/Schedule/Types/ScheduleEntry.hs

@@ -11,6 +11,7 @@ data ScheduleEntry = ScheduleCourseEvent
                      , sceRoom       :: CourseEventRoom
                      , sceOccurrence :: Either OccurrenceException OccurrenceSchedule
                      , sceNoOccur    :: Set LocalTime
+                     , sceTerm       :: Entity Term
                      }
                    | ScheduleTutorial
                      { stCourse      :: Entity Course
@@ -19,6 +20,7 @@ data ScheduleEntry = ScheduleCourseEvent
                      , stRoom        :: Maybe Text  -- TODO: introduce TutorialRoom type synonym
                      , stOccurrence  :: Either OccurrenceException OccurrenceSchedule
                      , stNoOccur     :: Set LocalTime
+                     , stTerm        :: Entity Term
                      }
                    | ScheduleExamOccurrence
                      { seoCourse     :: Entity Course

src/Utils/Schedule/Week.hs

@@ -9,8 +9,6 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
-import qualified Database.Esqueleto as E
-
 import Handler.Utils.DateTime (formatTimeRangeW, formatTimeW, utcToLocalTime, localTimeToUTCSimple)
 
 import Utils.Schedule
@@ -84,8 +82,9 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
   let
     dayNowOffset = toInteger (offsetInDays scheduleOffset) `addDays` localDay (utcToLocalTime now)
     week = weekDays now user scheduleOffset
+    lectureDay (Entity _ Term{..}) d = termLectureStart <= d && d <= termLectureEnd
+                                    && d `notElem` termHolidays
 
-  -- TODO: single runDB for all fetches below?
   (activeTerms, courseEvents, tutorials, examOccurrences) <- liftHandler . runDB $ (,,,)
     <$> fetchActiveTerms
     -- TODO: fetch course events for this week only?
@@ -95,29 +94,36 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
     <*> fetchExamOccurrencesScheduleInfo (Just uid) ata now
   
   let
+    holidays = concatMap (termHolidays . entityVal) activeTerms
+
     courseEventToScheduleEntries :: ScheduleCourseEventInfo -> [ScheduleEntry]
-    courseEventToScheduleEntries (sceCourse@(Entity _ Course{..}), Entity _ CourseEvent{courseEventType=sceType,courseEventRoom=sceRoom,courseEventTime=Occurrences{..}}) =
-      let scheduleds
-            -- omit regular occurrences if the course term is not currently active
-            | not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
-            | otherwise = Set.toList occurrencesScheduled  <&> \scheduled ->
-                            let sceOccurrence = Right scheduled in ScheduleCourseEvent{..}
-          exceptions    = Set.toList occurrencesExceptions <&> \exception ->
-                            let sceOccurrence = Left  exception in ScheduleCourseEvent{..}
-          sceNoOccur = setOf (folded . _ExceptNoOccur) occurrencesExceptions
-      in  scheduleds <> exceptions
+    courseEventToScheduleEntries (sceCourse@(Entity _ Course{..}), Entity _ CourseEvent{courseEventType=sceType,courseEventRoom=sceRoom,courseEventTime=Occurrences{..}})
+      | [sceTerm] <- filter ((== courseTerm) . entityKey) activeTerms
+      , termActive $ entityVal sceTerm
+      = let scheduleds
+              = Set.toList occurrencesScheduled  <&> \scheduled ->
+                  let sceOccurrence = Right scheduled in ScheduleCourseEvent{..}
+            exceptions
+              = Set.toList occurrencesExceptions <&> \exception ->
+                  let sceOccurrence = Left  exception in ScheduleCourseEvent{..}
+            sceNoOccur = setOf (folded . _ExceptNoOccur) occurrencesExceptions
+         in scheduleds <> exceptions
+      | otherwise = mempty
 
     tutorialToScheduleEntries :: ScheduleTutorialInfo -> [ScheduleEntry]
-    tutorialToScheduleEntries (stCourse@(Entity _ Course{..}), Entity _ Tutorial{tutorialName=stName,tutorialType=stType,tutorialRoom=stRoom,tutorialTime=Occurrences{..}}) =
-      let scheduleds
-            -- omit regular occurrences if the course term is not currently active
-            | not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
-            | otherwise = Set.toList occurrencesScheduled  <&> \scheduled ->
-                            let stOccurrence = Right scheduled in ScheduleTutorial{..}
-          exceptions    = Set.toList occurrencesExceptions <&> \exception ->
-                            let stOccurrence = Left  exception in ScheduleTutorial{..}
-          stNoOccur = setOf (folded . _ExceptNoOccur) occurrencesExceptions
-      in  scheduleds <> exceptions
+    tutorialToScheduleEntries (stCourse@(Entity _ Course{..}), Entity _ Tutorial{tutorialName=stName,tutorialType=stType,tutorialRoom=stRoom,tutorialTime=Occurrences{..}})
+      | [stTerm] <- filter ((== courseTerm) . entityKey) activeTerms
+      , termActive $ entityVal stTerm
+      = let scheduleds
+              = Set.toList occurrencesScheduled  <&> \scheduled ->
+                  let stOccurrence = Right scheduled in ScheduleTutorial{..}
+            exceptions
+              = Set.toList occurrencesExceptions <&> \exception ->
+                  let stOccurrence = Left  exception in ScheduleTutorial{..}
+            stNoOccur = setOf (folded . _ExceptNoOccur) occurrencesExceptions
+         in scheduleds <> exceptions
+      | otherwise
+      = mempty
 
     -- TODO: introduce type synonym for (Entity Course, Entity Exam, Entity ExamOccurrence)?
     joinParallelExamOccurrences :: [ScheduleExamOccurrenceInfo] -> [ScheduleExamOccurrenceJoinedInfo]
@@ -155,17 +161,20 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
         isRegularWithoutException :: ScheduleEntry -> Bool
         isRegularWithoutException =
           let -- remove regular occurrences if there is a NoOccur exception for the occurrence of this week
-              goPrune noOccurs = \case
-                Right ScheduleWeekly{..} -> flip none noOccurs $
-                  \needle -> let localDay = scheduleDayOfWeek `dayOfWeekToDayWith` dayNowOffset
-                              in    LocalTime{ localDay, localTimeOfDay = scheduleStart } <= needle
-                                 && needle <= LocalTime{ localDay, localTimeOfDay = scheduleEnd }
+              goPrune noOccurs term = \case
+                Right ScheduleWeekly{..} -> and
+                  [ lectureDay term currentDay
+                  , flip none noOccurs $
+                      \needle -> let localDay = scheduleDayOfWeek `dayOfWeekToDayWith` dayNowOffset
+                                  in    LocalTime{ localDay, localTimeOfDay = scheduleStart } <= needle
+                                     && needle <= LocalTime{ localDay, localTimeOfDay = scheduleEnd }
+                  ]
                 Left ExceptOccur{} -> True
                 -- remove NoOccur exceptions
                 Left ExceptNoOccur{} -> False
           in \case
-            ScheduleCourseEvent{..} -> goPrune sceNoOccur sceOccurrence
-            ScheduleTutorial{..}    -> goPrune stNoOccur  stOccurrence
+            ScheduleCourseEvent{..} -> goPrune sceNoOccur sceTerm sceOccurrence
+            ScheduleTutorial{..}    -> goPrune stNoOccur  stTerm  stOccurrence
             _ -> True
       in sortOn (views _1 $ scheduleEntryToStart currentDay) $ filter (views _1 isRegularWithoutException) occurrencesInSlot
 
@@ -174,7 +183,6 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
     events = Map.filterWithKey shouldBeDisplayedOrHasEvents events' where
       shouldBeDisplayedOrHasEvents d entries = dayOfWeek d `elem` userScheduleWeekDays || any (not . null) entries
 
-    -- TODO: avoid overlaps wrt. timeslot length (FIXME!!)
     timeSlotsDefaultDisplay :: Set TimeSlot
     timeSlotsDefaultDisplay = Set.fromList $ timeSlotsFromTo userScheduleWeekTimeslotLength userScheduleWeekTimeFrom userScheduleWeekTimeTo
 

templates/schedule/week.hamlet

@@ -9,6 +9,8 @@ $newline never
           $if is _Just (Map.lookup day events)
             <th .table__th uw-hide-column-header=#{dayTableHeadIdent day}>
               ^{formatTimeW SelFormatDate day}
+              $if elem day holidays
+                \ (_{MsgScheduleWeekHoliday})
     <tbody>
       $forall slot <- allTimeSlots
         $if Set.member slot timeSlotsDefaultDisplay || not (timeSlotIsEmpty slot)