From 99475ed2537bf7fcecf6701e1c3e18c67df31ab0 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Thu, 12 Nov 2020 13:07:12 +0100
Subject: [PATCH] feat(schedule): highlight current day/timeslot

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

diff --git a/frontend/src/app.sass b/frontend/src/app.sass
index 7c43f62b2..220a2f42d 100644
--- a/frontend/src/app.sass
+++ b/frontend/src/app.sass
@@ -1448,6 +1448,9 @@ table.schedule
   a.schedule--entry-link + a.schedule--entry-link > .schedule--entry
     margin-top: 5px
 
+  .table__th.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 9aecb42e4..aee5d59fb 100644
--- a/src/Utils/Schedule/Week.hs
+++ b/src/Utils/Schedule/Week.hs
@@ -78,12 +78,15 @@ weekDays now (Entity _ User{userWeekStart}) scheduleOffset = go dayNowOffset
 weekSchedule :: UTCTime -> Entity User -> ScheduleOffset -> Widget
 weekSchedule now user@(Entity uid User{userScheduleWeekDays = ScheduleWeekDays userScheduleWeekDays, ..}) scheduleOffset = do
   ata <- getSessionActiveAuthTags
+  let localNow = utcToLocalTime now
 
   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
+    isToday d = d == localDay localNow
+    isCurrentSlot = isInTimeSlot $ localTimeOfDay localNow
 
   (activeTerms, courseEvents, tutorials, examOccurrences) <- liftHandler . runDB $ (,,,)
     <$> fetchActiveTerms
diff --git a/templates/schedule/week.hamlet b/templates/schedule/week.hamlet
index 04d9976c9..7c29f28b0 100644
--- a/templates/schedule/week.hamlet
+++ b/templates/schedule/week.hamlet
@@ -7,7 +7,7 @@ $newline never
           _{MsgScheduleTableHeadTime}
         $forall day <- week
           $if is _Just (Map.lookup day events)
-            <th .table__th uw-hide-column-header=#{dayTableHeadIdent day}>
+            <th .table__th :isToday day:.schedule-current uw-hide-column-header=#{dayTableHeadIdent day}>
               ^{formatTimeW SelFormatDate day}
               $if elem day holidays
                 \ (_{MsgScheduleWeekHoliday})
@@ -15,7 +15,7 @@ $newline never
       $forall slot <- allTimeSlots
         $if Set.member slot timeSlotsDefaultDisplay || not (timeSlotIsEmpty slot)
           <tr .table__row>
-            <th .table__th uw-hide-columns--no-hide>
+            <th .table__th uw-hide-columns--no-hide :any isToday week && isCurrentSlot slot:.schedule-current>
               ^{formatTimeSlotW slot}
             $forall day <- week
               $maybe dayEvents <- Map.lookup day events