diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs index 0ac761659..852b55fa1 100644 --- a/src/Utils/Schedule/Week.hs +++ b/src/Utils/Schedule/Week.hs @@ -87,15 +87,15 @@ weekSchedule uid dayOffset = do in \case ScheduleCourseEvent{sceOccurrence} -> occurrenceIsInSlot sceOccurrence ScheduleTutorial{stOccurrence} -> occurrenceIsInSlot stOccurrence - ScheduleExamOccurrence{seoStart} -> let slotTime = timeSlotToUTCTime tz day slot - nextSlotTime = timeSlotToUTCTime tz day (slot+slotStep) + ScheduleExamOccurrence{seoStart} -> let slotTime = timeSlotToUTCTime tz day slot + nextSlotTime = timeSlotToUTCTime tz day $ nextTimeSlot slot in slotTime <= seoStart && seoStart < nextSlotTime events' :: Map Day (Map TimeSlot [ScheduleEntry]) events' = Map.fromList $ week <&> \day -> ( day - , Map.fromList $ slotsToDisplay <&> \slot -> + , Map.fromList $ timeSlotsToDisplay <&> \slot -> ( slot , filter (seIsInSlot day slot) $ join $ (courseEventToScheduleEntries <$> courseEvents) @@ -144,6 +144,10 @@ weekSchedule uid dayOffset = do | otherwise = go $ pred day firstDay = toEnum $ fromEnum Monday + fromInteger (fromMaybe 0 dayOffset) + -- TODO: make configurable + timeSlotsToDisplay :: [TimeSlot] + timeSlotsToDisplay = timeSlot <$> [8,10..18] + $(widgetFile "widgets/schedule/week") diff --git a/src/Utils/Schedule/Week/TimeSlot.hs b/src/Utils/Schedule/Week/TimeSlot.hs index 72afb0a10..eb811c7fb 100644 --- a/src/Utils/Schedule/Week/TimeSlot.hs +++ b/src/Utils/Schedule/Week/TimeSlot.hs @@ -1,5 +1,8 @@ module Utils.Schedule.Week.TimeSlot - ( TimeSlot, firstSlot, lastSlot, slotStep, slotsToDisplay, isInTimeSlot + ( TimeSlot(..) + , timeSlot + , isInTimeSlot + , nextTimeSlot , timeSlotToUTCTime , formatTimeSlotW ) where @@ -9,31 +12,37 @@ import Import import Handler.Utils.DateTime (formatTimeRangeW) --- TODO: very temporary slot representation, WORK IN PROGRESS --- TODO: include UTCTime stamps for begin and end (end timestamp excluded) -type TimeSlot = Int - -firstSlot, lastSlot, slotStep :: TimeSlot -firstSlot = 8 -lastSlot = 18 +slotStep :: Int slotStep = 2 -slotsToDisplay :: [TimeSlot] -slotsToDisplay = [firstSlot,firstSlot+slotStep..lastSlot] + +data TimeSlot = TimeSlot + { tsFrom :: TimeOfDay + , tsTo :: TimeOfDay -- end excluded + } + deriving (Eq, Ord, Show, Read, Generic, Typeable) + +timeSlot :: Int -> TimeSlot +timeSlot h = TimeSlot{..} where + tsFrom = TimeOfDay h 0 0 + tsTo = TimeOfDay (h+slotStep) 0 0 -- | Check whether a given time of day lies within a given time slot isInTimeSlot :: TimeOfDay -> TimeSlot -> Bool -isInTimeSlot time slot = TimeOfDay slot 0 0 <= time && time < TimeOfDay (slot+slotStep) 0 0 +isInTimeSlot time TimeSlot{..} = tsFrom <= time && time < tsTo + +-- | Get the successor of a time slot +nextTimeSlot :: TimeSlot -> TimeSlot +nextTimeSlot TimeSlot{tsTo=tsFrom} = let tsTo = TimeOfDay (todHour tsFrom + slotStep) 0 0 in TimeSlot{..} -- | Convert a TimeSlot to UTCTime for a given TimeZone timeSlotToUTCTime :: TimeZone -> Day -> TimeSlot -> UTCTime -timeSlotToUTCTime tz day slot = UTCTime{..} where +timeSlotToUTCTime tz day TimeSlot{..} = UTCTime{..} where utctDay = slotDayOffset `addDays` day utctDayTime = timeOfDayToTime slotTimeOfDay - (slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz $ TimeOfDay slot 0 0 + (slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz tsFrom --- TODO: refactor in progress -- | Format a given TimeSlot t as time range from t until the next TimeSlot formatTimeSlotW :: TimeSlot -> Widget -formatTimeSlotW slot = formatTimeRangeW SelFormatTime (TimeOfDay slot 0 0) $ Just $ TimeOfDay (slot+slotStep) 0 0 +formatTimeSlotW TimeSlot{..} = formatTimeRangeW SelFormatTime tsFrom $ Just tsTo diff --git a/templates/widgets/schedule/week.hamlet b/templates/widgets/schedule/week.hamlet index 477482f01..678245e11 100644 --- a/templates/widgets/schedule/week.hamlet +++ b/templates/widgets/schedule/week.hamlet @@ -9,7 +9,7 @@ $newline never ^{formatTimeW SelFormatDate day} - $forall slot <- slotsToDisplay + $forall slot <- timeSlotsToDisplay ^{formatTimeSlotW slot}