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

feat(schedule-week): display slots outside default range (WIP)

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-25 12:00:37 +02:00
parent 67302a5dd1
commit 3be331f043
2 changed files with 48 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -80,14 +80,14 @@ weekSchedule uid dayOffset = do
events' :: Map Day (Map TimeSlot [ScheduleEntry])
events' = Map.fromList $ week <&> \day ->
( day
, Map.fromList $ timeSlotsToDisplay <&> \slot ->
, Map.fromList $ allTimeSlots <&> \slot ->
( slot
, filter (seIsInSlot tz day slot) $ join $
(courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
<> pure (examOccurrenceToScheduleEntry <$> (joinParallelExamOccurrences examOccurrences))
, filter (seIsInSlot tz day slot) scheduleEntries
)
)
) where
scheduleEntries = join $ (courseEventToScheduleEntries <$> courseEvents)
<> (tutorialToScheduleEntries <$> tutorials)
<> pure (examOccurrenceToScheduleEntry <$> (joinParallelExamOccurrences examOccurrences))
events :: Map Day (Map TimeSlot [ScheduleEntry])
events = events' <&> \slotsPerDay -> slotsPerDay <&> \occurrencesInSlot ->
@ -118,8 +118,14 @@ weekSchedule uid dayOffset = do
firstDay = toEnum $ fromEnum Monday + fromInteger (fromMaybe 0 dayOffset)
-- TODO: make this configurable
timeSlotsToDisplay :: [TimeSlot]
timeSlotsToDisplay = timeSlot <$> [8,10..18]
timeSlotsDefaultDisplay :: Set TimeSlot
timeSlotsDefaultDisplay = Set.fromList $ timeSlot <$> [8,10..18]
allTimeSlots :: [TimeSlot]
allTimeSlots = timeSlot <$> [0,2..24]
timeSlotIsEmpty :: TimeSlot -> Bool
timeSlotIsEmpty slot = foldr (\day acc -> acc && maybe True null (day Map.!? slot)) True events
$(widgetFile "widgets/schedule/week")

67
templates/widgets/schedule/week.hamlet
View File

@ -9,37 +9,38 @@ $newline never
<th .table__th uw-hide-column-header=#{dayTableHeadIdent day}>
^{formatTimeW SelFormatDate day}
<tbody>
$forall slot <- timeSlotsToDisplay
<tr .table__row>
<td .table__td>
^{formatTimeSlotW slot}
$forall day <- week
$forall slot <- allTimeSlots
$if Set.member slot timeSlotsDefaultDisplay || not (timeSlotIsEmpty slot)
<tr .table__row>
<td .table__td>
<div .table__td-content>
$maybe dayEvents <- Map.lookup day events
$maybe slotEvents <- Map.lookup slot dayEvents
$forall scheduleEntry <- slotEvents
<a href=@{scheduleEntryToHref scheduleEntry} .schedule--entry-link>
<div .schedule--entry>
$case scheduleEntry
$of ScheduleCourseEvent{sceCourse=Entity _ Course{courseName},sceType,sceRoom,sceOccurrence}
#{CI.original courseName}: #{CI.original sceType} <br/>
_{MsgScheduleRoom}: #{sceRoom} <br/>
^{formatEitherOccurrenceW sceOccurrence}
$of ScheduleTutorial{stCourse=Entity _ Course{courseName},stName,stType,stRoom,stOccurrence}
#{CI.original courseName}: #{stName} (#{CI.original stType}) <br/>
_{MsgScheduleRoom}: #{stRoom} <br/>
^{formatEitherOccurrenceW stOccurrence}
$of ScheduleExamOccurrence{seoCourse=Entity _ Course{courseName},seoExamName,seoRooms,seoStart,seoEnd}
#{CI.original courseName}: #{seoExamName} <br/>
$case toList seoRooms
$of [room]
_{MsgScheduleRoom}: #{room}
$of more
_{MsgScheduleRooms}: #{intercalate ", " more}
<br>
_{MsgScheduleOccur}: #
$if Just (utctDay seoStart) == fmap utctDay seoEnd
^{formatTimeRangeW SelFormatTime seoStart seoEnd}
$else
^{formatTimeRangeW SelFormatDateTime seoStart seoEnd}
^{formatTimeSlotW slot}
$forall day <- week
<td .table__td>
<div .table__td-content>
$maybe dayEvents <- Map.lookup day events
$maybe slotEvents <- Map.lookup slot dayEvents
$forall scheduleEntry <- slotEvents
<a href=@{scheduleEntryToHref scheduleEntry} .schedule--entry-link>
<div .schedule--entry>
$case scheduleEntry
$of ScheduleCourseEvent{sceCourse=Entity _ Course{courseName},sceType,sceRoom,sceOccurrence}
#{CI.original courseName}: #{CI.original sceType} <br/>
_{MsgScheduleRoom}: #{sceRoom} <br/>
^{formatEitherOccurrenceW sceOccurrence}
$of ScheduleTutorial{stCourse=Entity _ Course{courseName},stName,stType,stRoom,stOccurrence}
#{CI.original courseName}: #{stName} (#{CI.original stType}) <br/>
_{MsgScheduleRoom}: #{stRoom} <br/>
^{formatEitherOccurrenceW stOccurrence}
$of ScheduleExamOccurrence{seoCourse=Entity _ Course{courseName},seoExamName,seoRooms,seoStart,seoEnd}
#{CI.original courseName}: #{seoExamName} <br/>
$case toList seoRooms
$of [room]
_{MsgScheduleRoom}: #{room}
$of more
_{MsgScheduleRooms}: #{intercalate ", " more}
<br>
_{MsgScheduleOccur}: #
$if Just (utctDay seoStart) == fmap utctDay seoEnd
^{formatTimeRangeW SelFormatTime seoStart seoEnd}
$else
^{formatTimeRangeW SelFormatDateTime seoStart seoEnd}