107 lines
4.8 KiB
Haskell
107 lines
4.8 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Course.Communication
|
|
( postCCommR, getCCommR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Communication
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
|
|
|
|
getCCommR, postCCommR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
|
getCCommR = postCCommR
|
|
postCCommR tid ssh csh = do
|
|
(cid, tuts, exams, sheets) <- runDB $ do
|
|
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
|
tuts'' <- selectKeysList [TutorialCourse ==. cid] []
|
|
tuts' <- forM tuts'' $ \tutid -> do
|
|
cID <- encrypt tutid
|
|
return ( RGTutorialParticipants cID
|
|
, E.from $ \(user `E.InnerJoin` participant) -> do
|
|
E.on $ user E.^. UserId E.==. participant E.^. TutorialParticipantUser
|
|
E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
|
|
return user
|
|
)
|
|
let
|
|
tuts | length tuts' < 2 = tuts'
|
|
| otherwise = ( RGCourseParticipantsInTutorial
|
|
, E.from $ \(user `E.InnerJoin` participant) -> do
|
|
E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
|
|
E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
|
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
E.&&. (E.exists . E.from $ \tutParticipant -> E.where_ $
|
|
tutParticipant E.^. TutorialParticipantUser E.==. user E.^. UserId
|
|
)
|
|
return user
|
|
) : tuts'
|
|
|
|
exams' <- selectKeysList [ExamCourse ==. cid] []
|
|
exams <- forM exams' $ \examid -> do
|
|
cID <- encrypt examid
|
|
return ( RGExamRegistered cID
|
|
, E.from $ \(user `E.InnerJoin` examRegistration) -> do
|
|
E.on $ user E.^. UserId E.==. examRegistration E.^. ExamRegistrationUser
|
|
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val examid
|
|
return user
|
|
)
|
|
|
|
sheets' <- selectKeysList [SheetCourse ==. cid] []
|
|
sheets <- forM sheets' $ \sheetid -> do
|
|
cID <- encrypt sheetid
|
|
return ( RGSheetSubmittor cID
|
|
, E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission) -> E.distinctOnOrderBy [E.asc $ user E.^. UserIdent] $ do
|
|
E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
|
|
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
|
|
E.where_ $ submission E.^. SubmissionSheet E.==. E.val sheetid
|
|
return user
|
|
)
|
|
|
|
return (cid, tuts, exams, sheets)
|
|
|
|
commR CommunicationRoute
|
|
{ crHeading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
|
|
, crUltDest = SomeRoute $ CourseR tid ssh csh CCommR
|
|
, crJobs = crJobsCourseCommunication cid
|
|
, crTestJobs = crTestJobsCourseCommunication cid
|
|
, crRecipients =
|
|
[ ( RGCourseParticipants
|
|
, E.from $ \(user `E.InnerJoin` participant) -> do
|
|
E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
|
|
E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
|
|
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
|
return user
|
|
)
|
|
, ( RGCourseLecturers
|
|
, E.from $ \(user `E.InnerJoin` lecturer) -> do
|
|
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
|
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
|
return user
|
|
)
|
|
, ( RGCourseTutors
|
|
, E.from $ \user -> do
|
|
E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
|
|
E.on $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
|
|
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
|
|
E.&&. user E.^. UserId E.==. tutor E.^. TutorUser
|
|
return user
|
|
)
|
|
, ( RGCourseCorrectors
|
|
, E.from $ \user -> do
|
|
E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
|
|
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
|
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
|
E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
|
|
return user
|
|
)
|
|
] ++ tuts ++ exams ++ sheets
|
|
, crRecipientAuth = Just $ \uid -> do
|
|
cID <- encrypt uid
|
|
evalAccessDB (CourseR tid ssh csh $ CUserR cID) False
|
|
}
|