77 lines
4.3 KiB
Haskell
77 lines
4.3 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_ $ 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 -> registrationOccurrence E.==. examOccurrence E.^. ExamOccurrenceId) (examRegistration E.^. ExamRegistrationOccurrence) -- if registered for a specific occurrence, get only this one, otherwise get every occurrence available
|
|
)
|
|
)
|
|
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 ->
|
|
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
|
|
)
|
|
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 or tutorial
|
|
user E.^. UserScheduleOccurrenceDisplayDefault
|
|
)
|
|
tutorialShouldBeDisplayed _ _ _ = E.false
|