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

feat(schedule): account for course schedule opt in fetches

Browse Source
This commit is contained in:
Sarah Vaupel 2020-11-09 12:56:28 +01:00
parent bab72a5e2e
commit c6a84b314c
2 changed files with 59 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Database/Esqueleto/Utils.hs
View File

@ -20,7 +20,7 @@ module Database.Esqueleto.Utils
, selectExists, selectNotExists
, SqlHashable
, sha256
, maybe, maybeEq, unsafeCoalesce
, maybe, maybeEq, fromMaybe, unsafeCoalesce
, bool
, max, min
, abs
@ -35,7 +35,7 @@ module Database.Esqueleto.Utils
) where
import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe, bool, max, min, abs)
import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe, fromMaybe, bool, max, min, abs)
import Data.Universe
import qualified Data.Set as Set
import qualified Data.List as List
@ -321,6 +321,12 @@ maybeEq a b = E.case_
]
(E.else_ $ a E.==. b)
fromMaybe :: (PersistField a)
=> E.SqlExpr (E.Value a)
-> E.SqlExpr (E.Value (Maybe a))
-> E.SqlExpr (E.Value a)
fromMaybe onNothing = maybe onNothing id
bool :: PersistField a
=> E.SqlExpr (E.Value a)
-> E.SqlExpr (E.Value a)

93
src/Utils/Schedule.hs
View File

@ -65,52 +65,61 @@ fetchExamOccurrences muid ata now = E.select $ E.from $ \(course `E.InnerJoin` e
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 (Just uid) course courseEvent = E.exists . E.from $ \user ->
let
mCourseEventOpt = E.subSelect . E.from $ \courseEventScheduleOpt -> do
E.where_ $ courseEventScheduleOpt E.^. CourseEventScheduleOptCourseEvent E.==. courseEvent E.^. CourseEventId
E.&&. courseEventScheduleOpt E.^. CourseEventScheduleOptUser E.==. user E.^. UserId
return $ courseEventScheduleOpt E.^. CourseEventScheduleOptOpt
mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
mCourseOpt
)
mCourseEventOpt
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 (Just uid) course tutorial = E.exists . E.from $ \user ->
let
mTutorialOpt = E.subSelect . E.from $ \tutorialScheduleOpt -> do
E.where_ $ tutorialScheduleOpt E.^. TutorialScheduleOptTutorial E.==. tutorial E.^. TutorialId
E.&&. tutorialScheduleOpt E.^. TutorialScheduleOptUser E.==. user E.^. UserId
return $ tutorialScheduleOpt E.^. TutorialScheduleOptOpt
mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
mCourseOpt
)
mTutorialOpt
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 (Just uid) course examOcc = E.exists . E.from $ \user ->
let
mExamOccOpt = E.subSelect . E.from $ \examOccScheduleOpt -> do
E.where_ $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOcc E.^. ExamOccurrenceId
E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptUser E.==. user E.^. UserId
return $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
in E.where_ $ user E.^. UserId E.==. E.val uid
E.&&. E.fromMaybe
( E.fromMaybe
(user E.^. UserScheduleOccurrenceDisplayDefault)
mCourseOpt
)
mExamOccOpt
examOccurrenceShouldBeDisplayed _ _ _ = E.false
-- Local helper functions
getCourseScheduleOpt :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (E.Value Bool))
getCourseScheduleOpt course user = E.from $ \courseScheduleOpt -> do
E.where_ $ courseScheduleOpt E.^. CourseScheduleOptCourse E.==. course E.^. CourseId
E.&&. courseScheduleOpt E.^. CourseScheduleOptUser E.==. user E.^. UserId
return $ courseScheduleOpt E.^. CourseScheduleOptOpt