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: avoid day shadowing

Browse Source
This commit is contained in:
Sarah Vaupel 2020-10-10 15:14:22 +02:00
parent a9b791c554
commit eeb365ab5c
2 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/Utils/Schedule/Week.hs
View File

@ -83,11 +83,11 @@ weekSchedule uid scheduleOffset = do
in ScheduleExamOccurrence{..}
events' :: Map Day (Map TimeSlot [ScheduleEntry])
events' = Map.fromList $ week <&> \day ->
( day
events' = Map.fromList $ week <&> \d ->
( d
, Map.fromList $ allTimeSlots <&> \slot ->
( slot
, filter (seIsInSlot tz day slot) scheduleEntries
, filter (seIsInSlot tz d slot) scheduleEntries
)
) where
scheduleEntries = join $ (courseEventToScheduleEntries <$> courseEvents)
@ -117,9 +117,9 @@ weekSchedule uid scheduleOffset = do
-- TODO: auto-hide saturday and sunday (if there are no events scheduled)?
week :: [Day]
week = go dayNowOffset
where go day
| dayOfWeek day == firstDay = [day .. toEnum (fromEnum day + 6)]
| otherwise = go $ pred day
where go d
| dayOfWeek d == firstDay = [d .. toEnum (fromEnum d + 6)]
| otherwise = go $ pred d
firstDay = toEnum $ fromEnum Monday + dayOffset
-- TODO: make this configurable
@ -130,7 +130,7 @@ weekSchedule uid scheduleOffset = do
allTimeSlots = timeSlotsFromTo 0 22
timeSlotIsEmpty :: TimeSlot -> Bool
timeSlotIsEmpty slot = foldr (\day acc -> acc && maybe True null (day Map.!? slot)) True events
timeSlotIsEmpty slot = foldr (\d acc -> acc && maybe True null (d Map.!? slot)) True events
$(widgetFile "schedule/week")
@ -139,16 +139,16 @@ weekSchedule uid scheduleOffset = do
-- | Check whether a given ScheduleEntry lies in a given TimeSlot
seIsInSlot :: TimeZone -> Day -> TimeSlot -> ScheduleEntry -> Bool
seIsInSlot tz day slot =
let occurrenceIsInSlot occurrence = occDay == day && occTime `isInTimeSlot` slot where
seIsInSlot tz d slot =
let occurrenceIsInSlot occurrence = occDay == d && occTime `isInTimeSlot` slot where
(occDay, occTime) = case occurrence of
Right ScheduleWeekly{..} -> (scheduleDayOfWeek `dayOfWeekToDayWith` day, scheduleStart)
Right ScheduleWeekly{..} -> (scheduleDayOfWeek `dayOfWeekToDayWith` d, scheduleStart)
Left ExceptOccur{..} -> (exceptDay, exceptStart)
Left ExceptNoOccur{exceptTime=LocalTime{..}} -> (localDay, localTimeOfDay)
in \case
ScheduleCourseEvent{sceOccurrence} -> occurrenceIsInSlot sceOccurrence
ScheduleTutorial{stOccurrence} -> occurrenceIsInSlot stOccurrence
ScheduleExamOccurrence{seoStart} -> let (slotTime,nextSlotTime) = timeSlotToUTCTime tz day slot
ScheduleExamOccurrence{seoStart} -> let (slotTime,nextSlotTime) = timeSlotToUTCTime tz d slot
in slotTime <= seoStart
&& seoStart < nextSlotTime
@ -188,7 +188,7 @@ dayTableHeadIdent = tshow . toModifiedJulianDay
-- | Convert from DayOfWeek to Day of this week using the current day
dayOfWeekToDayWith :: DayOfWeek -> Day -> Day
dayOfWeekToDayWith weekDay = go where
go day | weekDay' == weekDay = day
| weekDay' > weekDay = go $ pred day
| otherwise = go $ succ day
where weekDay' = dayOfWeek day
go d | weekDay' == weekDay = d
| weekDay' > weekDay = go $ pred d
| otherwise = go $ succ d
where weekDay' = dayOfWeek d

4
src/Handler/Utils/Schedule/Week/TimeSlot.hs
View File

@ -43,10 +43,10 @@ nextTimeSlot TimeSlot{tsTo=tsFrom} = let tsTo = TimeOfDay (todHour tsFrom + slot
-- | Convert a TimeSlot to UTCTime for a given TimeZone
timeSlotToUTCTime :: TimeZone -> Day -> TimeSlot -> (UTCTime, UTCTime)
timeSlotToUTCTime tz day TimeSlot{..} = (timeOfDayToUTC tsFrom, timeOfDayToUTC tsTo) where
timeSlotToUTCTime tz d TimeSlot{..} = (timeOfDayToUTC tsFrom, timeOfDayToUTC tsTo) where
timeOfDayToUTC time =
let (slotDayOffset, slotTimeOfDay) = localToUTCTimeOfDay tz time
utctDay = slotDayOffset `addDays` day
utctDay = slotDayOffset `addDays` d
utctDayTime = timeOfDayToTime slotTimeOfDay
in UTCTime{..}