feat(schedule): highlight current day/timeslot

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%
 

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

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