From 9f954061e3c3fab51a058a46f1bf37f608ac87ca Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
Date: Thu, 6 May 2021 12:21:56 +0200
Subject: [PATCH] style(schedule): highlight running schedule entries

---
 frontend/src/app.sass               |  3 +++
 src/Utils/Schedule/Week.hs          | 12 ++++++++++++
 src/Utils/Schedule/Week/TimeSlot.hs |  4 ++--
 templates/schedule/week.hamlet      |  2 +-
 4 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/frontend/src/app.sass b/frontend/src/app.sass
index 8c4b998b7..416e49528 100644
--- a/frontend/src/app.sass
+++ b/frontend/src/app.sass
@@ -1657,6 +1657,9 @@ table.schedule
   .table__th.schedule-current
     background-color: var(--color-primary)
 
+  .schedule--entry.schedule-current
+    background-color: var(--color-primary)
+
 form.schedule-options
   --schedule-option-radius: 20px 50%
 
diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs
index 54ec77852..6b8f8373b 100644
--- a/src/Utils/Schedule/Week.hs
+++ b/src/Utils/Schedule/Week.hs
@@ -90,6 +90,18 @@ weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays u
                                     && d `notElem` termHolidays
     isToday d = d == localDay localNow
     isCurrentSlot = isInTimeSlot $ localTimeOfDay localNow
+    isCurrentScheduleEntry d ts = \case
+      ScheduleCourseEvent{sceOccurrence,sceNoOccur} -> not (localNow `Set.member` sceNoOccur) && case sceOccurrence of
+        Left ExceptNoOccur{..} -> localNow /= exceptTime  -- TODO: sceNoOccur and Left ExceptNoOccur{..} seem to be the same case
+        Left ExceptOccur{..} -> d == exceptDay && timeOfDayToUTC exceptStart <= now && now < timeOfDayToUTC exceptEnd
+        Right ScheduleWeekly{..} -> scheduleDayOfWeek == dayOfWeek d && timeOfDayToUTC scheduleStart <= now && now < timeOfDayToUTC scheduleEnd
+      ScheduleTutorial{stOccurrence,stNoOccur} -> not (localNow `Set.member` stNoOccur) && case stOccurrence of
+        Left ExceptNoOccur{..} -> localNow /= exceptTime  -- TODO: sceNoOccur and Left ExceptNoOccur{..} seem to be the same case
+        Left ExceptOccur{..} -> d == exceptDay && timeOfDayToUTC exceptStart <= now && now < timeOfDayToUTC exceptEnd
+        Right ScheduleWeekly{..} -> scheduleDayOfWeek == dayOfWeek d && timeOfDayToUTC scheduleStart <= now && now < timeOfDayToUTC scheduleEnd
+      ScheduleExamOccurrence{seoStart,seoEnd} -> seoStart <= now && now < (fromMaybe (view _2 $ timeSlotToUTCTime d ts) seoEnd)
+      where
+        timeOfDayToUTC = localTimeToUTCSimple . LocalTime d
 
   (activeTerms, courseEvents, tutorials, examOccurrences) <- liftHandler . runDB $ (,,,)
     <$> fetchActiveTerms
diff --git a/src/Utils/Schedule/Week/TimeSlot.hs b/src/Utils/Schedule/Week/TimeSlot.hs
index 41c3f1b45..b44817853 100644
--- a/src/Utils/Schedule/Week/TimeSlot.hs
+++ b/src/Utils/Schedule/Week/TimeSlot.hs
@@ -59,8 +59,8 @@ nextTimeSlot slotStep TimeSlot{..} = TimeSlot{ tsFrom = tsTo, tsTo = tsTo + slot
 
 -- | Convert a TimeSlot to UTCTime for a given TimeZone
 timeSlotToUTCTime :: Day -> TimeSlot -> (UTCTime, UTCTime)
-timeSlotToUTCTime d TimeSlot{..} = (timeOfDayToUTC tsFrom, timeOfDayToUTC tsTo)
-  where timeOfDayToUTC = localTimeToUTCSimple . LocalTime d . nominalTimeToTimeOfDay
+timeSlotToUTCTime d TimeSlot{..} = (nominalDiffTimeToUTC tsFrom, nominalDiffTimeToUTC tsTo)
+  where nominalDiffTimeToUTC = localTimeToUTCSimple . LocalTime d . nominalTimeToTimeOfDay
 
 -- | Format a given TimeSlot as time range
 formatTimeSlotW :: TimeSlot -> Widget
diff --git a/templates/schedule/week.hamlet b/templates/schedule/week.hamlet
index f5fd56ee6..164d82aa2 100644
--- a/templates/schedule/week.hamlet
+++ b/templates/schedule/week.hamlet
@@ -24,7 +24,7 @@ $newline never
                     <div .table__td-content>
                       $forall (scheduleEntry, slotAssociation) <- slotEvents
                         <a href=@{scheduleEntryToHref scheduleEntry} .schedule--entry-link>
-                          <div .schedule--entry .schedule--entry__#{toPathPiece slotAssociation} :slotAssocIsCont slotAssociation:.schedule--entry__continuation>
+                          <div .schedule--entry .schedule--entry__#{toPathPiece slotAssociation} :slotAssocIsCont slotAssociation:.schedule--entry__continuation :isCurrentScheduleEntry day slot scheduleEntry:.schedule-current>
                             $case scheduleEntry
                               $of ScheduleCourseEvent{sceCourse=Entity _ Course{courseName},sceType,sceRoom,sceShowRoom,sceOccurrence}
                                 #{CI.original courseName}: #{CI.original sceType} #