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

refactor(schedule-week): refactor and fix sql queries

Browse Source
This commit is contained in:
Sarah Vaupel 2020-08-24 11:47:16 +02:00
parent ed5101c26c
commit ed40b89bfe
2 changed files with 44 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -14,7 +14,8 @@ import qualified Database.Esqueleto.Utils as E
import Handler.Utils.DateTime (formatTimeRangeW, formatTimeW)
import Utils.Course (mayViewCourse, isCourseLecturer)
import Utils.Course (mayViewCourse, isCourseLecturer, isCourseParticipant)
import Utils.Tutorial (isTutorialTutor, isTutorialParticipant)
import Utils.Schedule.Types
import Utils.Schedule.Week.TimeSlot
@ -37,26 +38,17 @@ weekSchedule uid dayOffset = do
-- TODO: fetch course events for this week only?
courseEvents <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
E.where_ $ (E.exists $ E.from $ \courseParticipant -> E.where_ $
courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
E.&&. courseParticipant E.^. CourseParticipantUser E.==. E.val uid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.&&. mayViewCourse (Just uid) ata now course Nothing -- should not be necessary, but let's be on the safe side
) E.||. (E.exists $ E.from $ \lecturer -> E.where_ $
lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.&&. lecturer E.^. LecturerUser E.==. E.val uid
E.where_ $ mayViewCourse (Just uid) ata now course Nothing -- should not be necessary, but let's be on the safe side
E.&&. ( isCourseParticipant (Just uid) ata (course E.^. CourseId)
E.||. isCourseLecturer (Just uid) ata (course E.^. CourseId)
)
return (course, courseEvent)
tutorials <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
E.where_ $ (E.exists $ E.from $ \tutorialParticipant -> E.where_ $
tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
E.&&. mayViewCourse (Just uid) ata now course Nothing -- should not be necessary, but let's be on the safe side
) E.||. (E.exists $ E.from $ \tutor -> E.where_ $
tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
E.&&. tutor E.^. TutorUser E.==. E.val uid
E.where_ $ mayViewCourse (Just uid) ata now course Nothing -- should not be necessary, but let's be on the safe side
E.&&. ( isTutorialTutor (Just uid) ata (tutorial E.^. TutorialId)
E.||. isTutorialParticipant (Just uid) ata (tutorial E.^. TutorialId)
)
return (course, tutorial)
@ -65,12 +57,17 @@ weekSchedule uid dayOffset = do
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
E.where_ $ isCourseLecturer (Just uid) ata (course E.^. CourseId)
E.||. (E.exists $ E.from $ \examRegistration -> E.where_ $
examRegistration E.^. ExamRegistrationUser E.==. 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)
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)
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.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
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)
let

25
src/Utils/Tutorial.hs Normal file
View File

@ -0,0 +1,25 @@
module Utils.Tutorial
( isTutorialTutor, isTutorialParticipant
) where
import Import
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
isTutorialTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value TutorialId) -> E.SqlExpr (E.Value Bool)
isTutorialTutor muid AuthTagActive{..} tid
| Just uid <- muid, authTagIsActive AuthTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
E.where_ $ tutorial E.^. TutorialId E.==. tid
E.&&. tutor E.^. TutorUser E.==. E.val uid
| otherwise = E.false
isTutorialParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value TutorialId) -> E.SqlExpr (E.Value Bool)
isTutorialParticipant muid AuthTagActive{..} tid
| Just uid <- muid, authTagIsActive AuthTutorialRegistered = E.exists . E.from $ \(tutorialParticipant `E.InnerJoin` tutorial) -> do
E.on $ tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
E.where_ $ tutorial E.^. TutorialId E.==. tid
E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
| otherwise = E.false