fix(schedule-week): fix UTCTime handling of exam occurrences

This commit is contained in:
Sarah Vaupel 2020-08-21 13:39:12 +02:00
parent 0aae46a0b9
commit 2a82ac62e4

View File

@ -38,6 +38,7 @@ slotToDisplayTime t = formatTimeRangeW SelFormatTime (TimeOfDay t 0 0) $ Just $
weekSchedule :: UserId -> Maybe Int -> Widget
weekSchedule uid _weekOffset = do
now <- liftIO getCurrentTime
tz <- liftIO getCurrentTimeZone
ata <- getSessionActiveAuthTags
-- TODO: single runDB for all fetches below?
@ -138,14 +139,15 @@ weekSchedule uid _weekOffset = do
-> day == localDay
&& TimeOfDay slot 0 0 <= localTimeOfDay
&& localTimeOfDay < TimeOfDay (slot+slotStep) 0 0
Left ScheduleEntryExamOccurrence{..} -> let slotUTCTime = UTCTime
{ utctDay = day
, utctDayTime = timeOfDayToTime (TimeOfDay slot 0 0)
}
nextSlotUTCTime = UTCTime
{ utctDay = day
, utctDayTime = timeOfDayToTime (TimeOfDay (slot+slotStep) 0 0)
}
Left ScheduleEntryExamOccurrence{..} -> let
( slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz $ TimeOfDay slot 0 0
(nextSlotDayOffset, nextSlotTimeOfDay) = localToUTCTimeOfDay tz $ TimeOfDay (slot+slotStep) 0 0
slotUTCTime = UTCTime { utctDay = slotDayOffset `addDays` day
, utctDayTime = timeOfDayToTime slotTimeOfDay
}
nextSlotUTCTime = UTCTime { utctDay = nextSlotDayOffset `addDays` day
, utctDayTime = timeOfDayToTime nextSlotTimeOfDay
}
in slotUTCTime <= seeoStart
&& seeoStart < nextSlotUTCTime