fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(course-visibility): no invisible courses in course list

Browse Source
This commit is contained in:
Sarah Vaupel 2020-07-25 15:10:59 +02:00
parent b7535d764d
commit 24f12896e0
1 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Handler/Course/List.hs
View File

@ -69,6 +69,35 @@ course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \cou
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
-- Is this user affiliated with the course in any way (except for being registered)?
course2Affiliated :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
course2Affiliated muid (course `E.InnerJoin` _school) = (E.exists (E.from (\(user `E.InnerJoin` lecturer) -> do
E.on (user E.^. UserId E.==. lecturer E.^. LecturerUser)
E.where_ (E.just (user E.^. UserId) E.==. E.val muid
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId)
))
) E.||. (E.exists (E.from (\(user `E.InnerJoin` (tutor `E.InnerJoin` tutorial)) -> do
E.on (user E.^. UserId E.==. tutor E.^. TutorUser)
E.on (tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId)
E.where_ (E.just (user E.^. UserId) E.==. E.val muid
E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId)
))
) E.||. (E.exists (E.from (\(user `E.InnerJoin` (sheetCorrector `E.InnerJoin` sheet)) -> do
E.on (user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser)
E.on (sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId)
E.where_ (E.just (user E.^. UserId) E.==. E.val muid
E.&&. sheet E.^. SheetCourse E.==. course E.^. CourseId)
))
)
--) E.||. (E.exists (E.from (\(user `E.InnerJoin` (submissionUser `E.InnerJoin` (submission `E.InnerJoin` sheet))) -> do
-- E.on (user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser)
-- E.on (submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId)
-- E.on (submission E.^. SubmissionSheet E.==. sheet E.^. SheetId)
-- E.where_ (E.just (user E.^. UserId) E.==. E.val muid
-- E.&&. sheet E.^. SheetCourse E.==. course E.^. CourseId)
-- ))
--)
makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
makeCourseTable whereClause colChoices psValidator = do
@ -79,7 +108,8 @@ makeCourseTable whereClause colChoices psValidator = do
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
let participants = course2Participants qin
let registered = course2Registered muid qin
E.where_ $ whereClause (course, participants, registered)
let affiliated = course2Affiliated muid qin
E.where_ $ whereClause (course, participants, registered, affiliated)
return (course, participants, registered, school)
lecturerQuery cid (user `E.InnerJoin` lecturer) = do
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
@ -191,6 +221,7 @@ makeCourseTable whereClause colChoices psValidator = do
getCourseListR :: Handler Html
getCourseListR = do
muid <- maybeAuthId
now <- liftIO getCurrentTime
let colonnade = widgetColonnade $ mconcat
[ colCourse -- colCourseDescr
, colDescription
@ -199,7 +230,13 @@ getCourseListR = do
, colCShort
, maybe mempty (const colRegistered) muid
]
whereClause = const $ E.val True
mnow = E.val $ Just now
whereClause (course, _, registered, affiliated) = registered E.||. affiliated
E.||. (E.isJust (course E.^. CourseVisibleFrom)
E.&&. course E.^. CourseVisibleFrom E.<=. mnow
E.&&. (E.isNothing (course E.^. CourseVisibleTo)
E.||. mnow E.<=. course E.^. CourseVisibleTo)
)
validator = def
& defaultSorting [SortDescBy "term",SortAscBy "course"]
coursesTable <- runDB $ makeCourseTable whereClause colonnade validator