style(schedule): highlight running schedule entries

This commit is contained in:
Sarah Vaupel 2021-05-06 12:21:56 +02:00
parent 4a726f09fb
commit 9f954061e3
4 changed files with 18 additions and 3 deletions

View File

@ -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%

View File

@ -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

View File

@ -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

View File

@ -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} #