117 lines
7.4 KiB
Haskell
117 lines
7.4 KiB
Haskell
module Utils.Schedule
|
|
( fetchActiveTerms, fetchCourseEvents, fetchTutorials, fetchExamOccurrences
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
import Utils.Course
|
|
import Utils.Tutorial
|
|
|
|
import Utils.Schedule.Types
|
|
|
|
|
|
fetchActiveTerms :: MonadHandler m => ReaderT SqlBackend m [E.Value TermId]
|
|
fetchActiveTerms = E.select $ E.from $ \term -> do
|
|
E.where_ $ term E.^. TermActive
|
|
return $ term E.^. TermId
|
|
|
|
fetchCourseEvents :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleCourseEventInfo]
|
|
fetchCourseEvents muid ata now = E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
|
|
E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
|
|
E.where_ $ courseEventShouldBeDisplayed muid course courseEvent
|
|
E.&&. mayViewCourse muid ata now course Nothing -- should not be necessary, but let's be on the safe side
|
|
E.&&. ( isCourseParticipant muid ata (course E.^. CourseId)
|
|
E.||. isCourseLecturer muid ata (course E.^. CourseId)
|
|
)
|
|
return (course, courseEvent)
|
|
|
|
fetchTutorials :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleTutorialInfo]
|
|
fetchTutorials muid ata now = E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
|
|
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
|
|
E.where_ $ tutorialShouldBeDisplayed muid course tutorial
|
|
E.&&. mayViewCourse muid ata now course Nothing -- should not be necessary, but let's be on the safe side
|
|
E.&&. ( isTutorialTutor muid ata (tutorial E.^. TutorialId)
|
|
E.||. isTutorialParticipant muid ata (tutorial E.^. TutorialId)
|
|
)
|
|
return (course, tutorial)
|
|
|
|
fetchExamOccurrences :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleExamOccurrenceInfo]
|
|
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 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
|
|
-- not enrolled, me thinks)
|
|
E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom) -- is the exam visible?
|
|
E.&&. E.maybe E.false (\publishOcc -> publishOcc E.<=. E.val now) (exam E.^. ExamPublishOccurrenceAssignments) -- are the exam occurrence assignments visible?
|
|
E.&&. (E.exists $ E.from $ \examRegistration -> E.where_ $
|
|
examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
|
E.&&. E.just (examRegistration E.^. ExamRegistrationUser) E.==. E.val muid
|
|
E.&&. E.maybe E.true (\registrationOccurrence -> hasExamOccurrenceDisplayOptIn examOccurrence E.||. registrationOccurrence E.==. examOccurrence E.^. ExamOccurrenceId) (examRegistration E.^. ExamRegistrationOccurrence) -- if registered for a specific occurrence, get only this one and occurrences with an opt-in, otherwise get every occurrence available
|
|
)
|
|
)
|
|
)
|
|
return (course, exam, examOccurrence)
|
|
where
|
|
hasExamOccurrenceDisplayOptIn examOccurrence = E.exists . E.from $ \examOccurrenceScheduleOpt -> E.where_ $
|
|
examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOccurrence E.^. ExamOccurrenceId
|
|
E.&&. E.just (examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptUser) E.==. E.val muid
|
|
E.&&. examOccurrenceScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
|
|
|
|
|
|
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 ->
|
|
E.where_ $ user E.^. UserId E.==. E.val uid
|
|
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 ->
|
|
E.where_ $ user E.^. UserId E.==. E.val uid
|
|
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 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
|
|
(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
|