fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

refactor(schedule-week): first step to replace TimeSlot

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-21 17:24:50 +02:00
parent 428b8cf739
commit c0fb5adec0
2 changed files with 25 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Utils/Schedule/Week.hs
View File

@ -113,36 +113,31 @@ weekSchedule uid _dayOffset = do
in Just ScheduleEntry{..}
examOccurrenceToScheduleEntry _ = Nothing -- TODO: exclude (_,_,Nothing) case via join
seOccurrenceIsInSlot :: Day -> TimeSlot -> ScheduleEntryOccurrence -> Bool
seOccurrenceIsInSlot day slot = \case
Right (Right ScheduleWeekly{..}) -> day == (scheduleDayOfWeek `dayOfWeekToDayWith` now)
&& TimeOfDay slot 0 0 <= scheduleStart
&& scheduleStart < TimeOfDay (slot+slotStep) 0 0
Right (Left ExceptOccur{..}) -> day == exceptDay
&& TimeOfDay slot 0 0 <= exceptStart
&& exceptStart < TimeOfDay (slot+slotStep) 0 0
Right (Left ExceptNoOccur{exceptTime=LocalTime{..}})
-> day == localDay
&& TimeOfDay slot 0 0 <= localTimeOfDay
&& localTimeOfDay < TimeOfDay (slot+slotStep) 0 0
Left ScheduleEntryExamOccurrence{..} -> let slotUTCTime = timeSlotToUTCTime tz day slot
nextSlotUTCTime = timeSlotToUTCTime tz day (slot+slotStep)
seOccurrenceIsInSlot :: TimeSlot -> ScheduleEntryOccurrence -> Bool
seOccurrenceIsInSlot timeSlot@(day,slot) = \case
Right occurrence -> occStart `isInTimeSlot` timeSlot where
occStart = case occurrence of
Right ScheduleWeekly{..} -> (scheduleDayOfWeek `dayOfWeekToDayWith` now, scheduleStart)
Left ExceptOccur{..} -> (exceptDay, exceptStart)
Left ExceptNoOccur{exceptTime=LocalTime{..}} -> (localDay, localTimeOfDay)
Left ScheduleEntryExamOccurrence{..} -> let slotUTCTime = timeSlotToUTCTime tz timeSlot
nextSlotUTCTime = timeSlotToUTCTime tz (day,slot+slotStep)
in slotUTCTime <= seeoStart
&& seeoStart < nextSlotUTCTime
events' :: Map Day (Map TimeSlot [ScheduleEntry])
events' :: Map Day (Map Int [ScheduleEntry])
events' = Map.fromList $ week <&> \day ->
( day
, Map.fromList $ slotsToDisplay <&> \slot ->
( slot
, filter (seOccurrenceIsInSlot day slot . seOccurrence) $ join $
, filter (seOccurrenceIsInSlot (day,slot) . seOccurrence) $ join $
(courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
<> (pure . catMaybes) (examOccurrenceToScheduleEntry <$> examOccurrences)
)
)
events :: Map Day (Map TimeSlot [ScheduleEntry])
events :: Map Day (Map Int [ScheduleEntry])
events = events' <&> \slotsPerDay -> slotsPerDay <&> \occurrencesInSlot ->
let
isRegularWithoutException :: ScheduleEntry -> Bool

22
src/Utils/Schedule/Week/TimeSlot.hs
View File

@ -1,5 +1,5 @@
module Utils.Schedule.Week.TimeSlot
( TimeSlot, firstSlot, lastSlot, slotStep, slotsToDisplay
( TimeSlot, firstSlot, lastSlot, slotStep, slotsToDisplay, isInTimeSlot
, timeSlotToUTCTime
, formatTimeSlotW
) where
@ -11,25 +11,29 @@ 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
type TimeSlot = (Day, Int)
firstSlot, lastSlot, slotStep :: TimeSlot
firstSlot, lastSlot, slotStep :: Int
firstSlot = 8
lastSlot = 18
slotStep = 2
slotsToDisplay :: [TimeSlot]
slotsToDisplay = enumFromThenTo firstSlot slotStep lastSlot
slotsToDisplay :: [Int]
slotsToDisplay = [firstSlot,firstSlot+slotStep..lastSlot]
isInTimeSlot :: (Day, TimeOfDay) -> TimeSlot -> Bool
isInTimeSlot (day,time) (slotDay,slotHour) = day == slotDay && TimeOfDay slotHour 0 0 <= time && time < TimeOfDay (slotHour+slotStep) 0 0
-- | Convert a TimeSlot to UTCTime for a given TimeZone and Day
timeSlotToUTCTime :: TimeZone -> Day -> TimeSlot -> UTCTime
timeSlotToUTCTime tz day slot = UTCTime{..} where
-- | Convert a TimeSlot to UTCTime for a given TimeZone
timeSlotToUTCTime :: TimeZone -> TimeSlot -> UTCTime
timeSlotToUTCTime tz (day,slot) = UTCTime{..} where
utctDay = slotDayOffset `addDays` day
utctDayTime = timeOfDayToTime slotTimeOfDay
(slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz $ TimeOfDay slot 0 0
-- TODO: refactor in progress
-- | Format a given TimeSlot t as time range from t until the next TimeSlot
formatTimeSlotW :: TimeSlot -> Widget
formatTimeSlotW :: Int -> Widget
formatTimeSlotW slot = formatTimeRangeW SelFormatTime (TimeOfDay slot 0 0) $ Just $ TimeOfDay (slot+slotStep) 0 0