diff --git a/src/Utils/Schedule/Types.hs b/src/Utils/Schedule/Types.hs index a77b68bb4..79530aae9 100644 --- a/src/Utils/Schedule/Types.hs +++ b/src/Utils/Schedule/Types.hs @@ -23,9 +23,7 @@ data ScheduleEntryType = SETCourseEvent { setceType :: CI Text , settName :: TutorialName } -- TODO: TutorialType not possible here (comes from data family instance) | SETExamOccurrence { seteoExamName :: ExamName - , seteoOccurrenceName :: ExamOccurrenceName } - -- TODO: more? deriving (Eq, Ord, Show, Read, Generic, Typeable) type ScheduleEntryRoom = Maybe Text -- TODO: is Maybe Text okay for every ScheduleEntryType? diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs index 827d5b52c..59523c04c 100644 --- a/src/Utils/Schedule/Week.hs +++ b/src/Utils/Schedule/Week.hs @@ -5,22 +5,25 @@ module Utils.Schedule.Week import Import import qualified Data.CaseInsensitive as CI + import qualified Data.Map as Map import qualified Data.Set as Set import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E import Handler.Utils.DateTime (formatTimeRangeW, formatTimeW) -import Utils.Schedule.Types import Utils.Course (mayViewCourse, isCourseLecturer) +import Utils.Schedule.Types + -- TODO: very temporary slot representation type TimeSlot = Int firstSlot, lastSlot, slotStep :: Int firstSlot = 8 -lastSlot = 20 +lastSlot = 18 slotStep = 2 slotsToDisplay :: [TimeSlot] @@ -69,17 +72,18 @@ weekSchedule uid _weekOffset = do return (course, tutorial) -- TODO: this makes the exam table redundant once the weekOffset is implemented - -- TODO: check for exam visibility for participants! - exams <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` (exam `E.InnerJoin` examOccurrence) `E.LeftOuterJoin` examRegistration) -> do + -- TODO: for lecturers, do not display one entry for each exam occurrences, but instead collect all occurrences happening at the same time in a list + exams <- liftHandler . runDB $ E.select $ E.from $ \((course `E.InnerJoin` exam) `E.LeftOuterJoin` examOccurrence) -> do E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse - E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam - E.on $ E.just (exam E.^. ExamId) E.==. examRegistration E.?. ExamRegistrationExam + E.on $ E.just (exam E.^. ExamId) E.==. examOccurrence E.?. ExamOccurrenceExam E.where_ $ isCourseLecturer (Just uid) ata (course E.^. CourseId) - E.||. (examRegistration E.?. ExamRegistrationUser E.==. E.just (E.val uid) - E.&&. mayViewCourse (Just uid) ata now course Nothing) -- do NOT remove, this is actually necessary here! - -- (There can be exam participants that are - -- not enrolled, me thinks) - return (course, exam, examOccurrence, examRegistration) + E.||. (E.exists $ E.from $ \examRegistration -> E.where_ $ + examRegistration E.?. ExamRegistrationUser E.==. E.just (E.val uid) + E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom) + E.&&. mayViewCourse (Just uid) ata now course Nothing) -- do NOT remove, this is actually necessary here! + -- (There can be exam participants that are + -- not enrolled, me thinks) + return (course, exam, examOccurrence) let courseEventToScheduleEntries :: (Entity Course, Entity CourseEvent) -> [ScheduleEntry] @@ -108,13 +112,11 @@ weekSchedule uid _weekOffset = do let seOccurrence = Right (Left exception) in ScheduleEntry{..} in scheduleds <> exceptions - -- TODO: work in progress - -- TODO: maybe exam registration is not even necessary here => refactor select to exists check for registration - examToScheduleEntries :: (Entity Course, Entity Exam, Entity ExamOccurrence, Maybe (Entity ExamRegistration)) -> [ScheduleEntry] - examToScheduleEntries (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Entity _ ExamOccurrence{..}, _mbExamRegistration) = + examToScheduleEntries :: (Entity Course, Entity Exam, Maybe (Entity ExamOccurrence)) -> [ScheduleEntry] + examToScheduleEntries (_, _, Nothing) = mempty + examToScheduleEntries (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Just (Entity _ ExamOccurrence{..})) = let seType = SETExamOccurrence { seteoExamName = examName - , seteoOccurrenceName = examOccurrenceName } seRoom = Just examOccurrenceRoom seOccurrence = Left $ ScheduleEntryExamOccurrence @@ -167,15 +169,16 @@ weekSchedule uid _weekOffset = do _ -> True -- TODO: maybe filter out ExceptNoOccurs? (Should NoOccurs be displayed or not?) in filter isRegularWithoutException occurrencesInSlot + -- TODO: Internationalize week start (and/or make configurable) + -- TODO: auto-hide saturday and sunday (if there are no events scheduled)? + -- TODO: weekday messages deprecated / not used => remove + currentWeek :: [Day] currentWeek = currentWeekAux $ utctDay now where currentWeekAux day | Monday <- dayOfWeek day = [day .. toEnum (fromEnum day + 6)] | otherwise = currentWeekAux $ pred day - -- TODO: Internationalize week start (and/or make configurable) - -- TODO: auto-hide saturday and sunday (if there are no events scheduled)? - -- TODO: weekday messages deprecated / not used => remove weekDays :: [(Day, UniWorXMessage, Text)] weekDays = zipWith (\x (y,z) -> (x,y,z)) currentWeek [ (MsgScheduleWeekDayMonday , "mon") @@ -187,23 +190,25 @@ weekSchedule uid _weekOffset = do , (MsgScheduleWeekDaySunday , "sun") ] - formatOccurrenceW :: ScheduleEntryOccurrence -> Widget - formatOccurrenceW = \case - Right (Right ScheduleWeekly{..}) -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd) - Right (Left ExceptOccur{..}) -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just $ LocalTime exceptDay exceptEnd) - Right (Left ExceptNoOccur{}) -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime - Left ScheduleEntryExamOccurrence{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime seeoDay seeoStart) (LocalTime seeoDay <$> seeoEnd) - - scheduleEntryToHref :: ScheduleEntry -> Route UniWorX - scheduleEntryToHref ScheduleEntry{seCourse=Entity _ Course{..},seType} = case seType of - SETCourseEvent{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to events table? (TODO currently has no id) - SETTutorial{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to table with id "tutorials"? - SETExamOccurrence{..} -> CExamR courseTerm courseSchool courseShorthand seteoExamName EShowR - $(widgetFile "widgets/schedule/week") --- Helper functions for this module +-- Local helper functions + +-- | To which route should each schedule entry link to? +scheduleEntryToHref :: ScheduleEntry -> Route UniWorX +scheduleEntryToHref ScheduleEntry{seCourse=Entity _ Course{..},seType} = case seType of + SETCourseEvent{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to events table? (TODO currently has no id) + SETTutorial{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to table with id "tutorials"? + SETExamOccurrence{..} -> CExamR courseTerm courseSchool courseShorthand seteoExamName EShowR + +-- | Calls formatTimeRangeW with the correct arguments and prepends an occurrence descriptor based on the occurrence type +formatOccurrenceW :: ScheduleEntryOccurrence -> Widget +formatOccurrenceW = \case + Right (Right ScheduleWeekly{..}) -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd) + Right (Left ExceptOccur{..}) -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just $ LocalTime exceptDay exceptEnd) + Right (Left ExceptNoOccur{}) -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime + Left ScheduleEntryExamOccurrence{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime seeoDay seeoStart) (LocalTime seeoDay <$> seeoEnd) -- | Convert from DayOfWeek to Day of this week using the current time (as UTCTime) dayOfWeekToDayWith :: DayOfWeek -> UTCTime -> Day diff --git a/templates/widgets/schedule/week.hamlet b/templates/widgets/schedule/week.hamlet index a9d1a8582..d2624b022 100644 --- a/templates/widgets/schedule/week.hamlet +++ b/templates/widgets/schedule/week.hamlet @@ -30,7 +30,6 @@ $newline never (#{CI.original settType}) $of SETExamOccurrence{..} #{seteoExamName} # - (#{seteoOccurrenceName})
$maybe room <- seRoom