From c7e6c3c086e8560267480e62a08f54f83cc82166 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel <> Date: Wed, 4 Nov 2020 00:05:44 +0100 Subject: [PATCH] feat(schedule): add occurrence-wise opt-in/out TODO: add interface triggers to insert, update and delete opt-in/out --- models/courses.model | 6 +++++ models/exams.model | 5 ++++ models/tutorials.model | 5 ++++ src/Utils/Schedule.hs | 53 +++++++++++++++++++++++++++++++----------- 4 files changed, 55 insertions(+), 14 deletions(-) diff --git a/models/courses.model b/models/courses.model index 5ddc24d0f..ad28201f8 100644 --- a/models/courses.model +++ b/models/courses.model @@ -28,6 +28,7 @@ Course -- Information about a single course; contained info is always visible TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester TermSchoolCourseName term school name -- name must be unique within school and semester deriving Generic + CourseEvent type CourseEventType course CourseId @@ -35,6 +36,11 @@ CourseEvent time Occurrences note Html Maybe lastChanged UTCTime default=now() +CourseEventScheduleOpt -- opt-in/-out for course event display in a user's schedule (TODO: currently for all occurrences of a course event; separate opt-ins/-outs per occurrence in CourseEventTime instead?) + courseEvent CourseEventId + user UserId + opt Bool -- whether the course event should be displayed; False <=> opt-out, True <=> opt-in + UniqueCourseEventScheduleOpt courseEvent user CourseAppInstructionFile course CourseId diff --git a/models/exams.model b/models/exams.model index 459cac9fb..2aa52ca80 100644 --- a/models/exams.model +++ b/models/exams.model @@ -37,6 +37,11 @@ ExamOccurrence end UTCTime Maybe description Html Maybe UniqueExamOccurrence exam name +ExamOccurrenceScheduleOpt + examOccurrence ExamOccurrenceId + user UserId + opt Bool + UniqueExamOccurrenceScheduleOpt examOccurrence user ExamRegistration exam ExamId user UserId diff --git a/models/tutorials.model b/models/tutorials.model index 113dc179b..b5877360e 100644 --- a/models/tutorials.model +++ b/models/tutorials.model @@ -22,3 +22,8 @@ TutorialParticipant user UserId UniqueTutorialParticipant tutorial user deriving Eq Ord Show +TutorialScheduleOpt + tutorial TutorialId + user UserId + opt Bool + UniqueTutorialScheduleOpt tutorial user diff --git a/src/Utils/Schedule.hs b/src/Utils/Schedule.hs index f9f58d746..372fba5ca 100644 --- a/src/Utils/Schedule.hs +++ b/src/Utils/Schedule.hs @@ -42,7 +42,7 @@ fetchExamOccurrences :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTi fetchExamOccurrences muid ata now = E.select $ E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examOccurrence) -> do E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam - E.where_ $ examOccurrenceShouldBeDisplayed muid course exam examOccurrence + E.where_ $ examOccurrenceShouldBeDisplayed muid course examOccurrence E.&&. ( isCourseLecturer muid ata (course E.^. CourseId) E.||. ( mayViewCourse muid ata now course Nothing -- do NOT remove, this is actually necessary here! -- (There can be exam participants that are @@ -59,28 +59,53 @@ fetchExamOccurrences muid ata now = E.select $ E.from $ \(course `E.InnerJoin` e return (course, exam, examOccurrence) --- TODO: find better names - courseEventShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity CourseEvent) -> E.SqlExpr (E.Value Bool) -courseEventShouldBeDisplayed (Just uid) _course _courseEvent = E.exists . E.from $ \user -> +courseEventShouldBeDisplayed (Just uid) _course courseEvent = E.exists . E.from $ \user -> E.where_ $ user E.^. UserId E.==. E.val uid - E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course or course event - user E.^. UserScheduleOccurrenceDisplayDefault + E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course + (E.exists . E.from $ \courseEventScheduleOpt -> E.where_ $ + courseEventScheduleOpt E.^. CourseEventScheduleOptCourseEvent E.==. courseEvent E.^. CourseEventId + E.&&. courseEventScheduleOpt E.^. CourseEventScheduleOptUser E.==. user E.^. UserId + E.&&. courseEventScheduleOpt E.^. CourseEventScheduleOptOpt + ) + E.||. user E.^. UserScheduleOccurrenceDisplayDefault + ) E.&&. (E.notExists . E.from $ \courseEventScheduleOpt -> E.where_ $ + courseEventScheduleOpt E.^. CourseEventScheduleOptCourseEvent E.==. courseEvent E.^. CourseEventId + E.&&. courseEventScheduleOpt E.^. CourseEventScheduleOptUser E.==. user E.^. UserId + E.&&. E.not_ (courseEventScheduleOpt E.^. CourseEventScheduleOptOpt) ) courseEventShouldBeDisplayed _ _ _ = E.false tutorialShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Tutorial) -> E.SqlExpr (E.Value Bool) -tutorialShouldBeDisplayed (Just uid) _course _tutorial = E.exists . E.from $ \user -> +tutorialShouldBeDisplayed (Just uid) _course tutorial = E.exists . E.from $ \user -> E.where_ $ user E.^. UserId E.==. E.val uid - E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course or tutorial - user E.^. UserScheduleOccurrenceDisplayDefault + E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course + (E.exists . E.from $ \tutorialScheduleOpt -> E.where_ $ + tutorialScheduleOpt E.^. TutorialScheduleOptTutorial E.==. tutorial E.^. TutorialId + E.&&. tutorialScheduleOpt E.^. TutorialScheduleOptUser E.==. user E.^. UserId + E.&&. tutorialScheduleOpt E.^. TutorialScheduleOptOpt + ) + E.||. user E.^. UserScheduleOccurrenceDisplayDefault + ) E.&&. (E.notExists . E.from $ \tutorialScheduleOpt -> E.where_ $ + tutorialScheduleOpt E.^. TutorialScheduleOptTutorial E.==. tutorial E.^. TutorialId + E.&&. tutorialScheduleOpt E.^. TutorialScheduleOptUser E.==. user E.^. UserId + E.&&. E.not_ (tutorialScheduleOpt E.^. TutorialScheduleOptOpt) ) tutorialShouldBeDisplayed _ _ _ = E.false -examOccurrenceShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Exam) -> E.SqlExpr (Entity ExamOccurrence) -> E.SqlExpr (E.Value Bool) -examOccurrenceShouldBeDisplayed (Just uid) _course _exam _examOcc = E.exists . E.from $ \user -> +examOccurrenceShouldBeDisplayed :: Maybe UserId -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity ExamOccurrence) -> E.SqlExpr (E.Value Bool) +examOccurrenceShouldBeDisplayed (Just uid) _course examOcc = E.exists . E.from $ \user -> E.where_ $ user E.^. UserId E.==. E.val uid - E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course or exam or exam occurrence - user E.^. UserScheduleOccurrenceDisplayDefault + E.&&. ( -- TODO: also check whether there is a display opt-in/out for this course + (E.exists . E.from $ \examOccScheduleOpt -> E.where_ $ + examOccScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOcc E.^. ExamOccurrenceId + E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptUser E.==. user E.^. UserId + E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptOpt + ) + E.||. user E.^. UserScheduleOccurrenceDisplayDefault + ) E.&&. (E.notExists . E.from $ \examOccScheduleOpt -> E.where_ $ + examOccScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOcc E.^. ExamOccurrenceId + E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptUser E.==. user E.^. UserId + E.&&. E.not_ (examOccScheduleOpt E.^. ExamOccurrenceScheduleOptOpt) ) -examOccurrenceShouldBeDisplayed _ _ _ _ = E.false +examOccurrenceShouldBeDisplayed _ _ _ = E.false