diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 615126c14..1e98b1417 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -4,6 +4,7 @@ RGCourseParticipants: Kursteilnehmer:innen RGCourseLecturers: Kursverwalter:innen RGCourseCorrectors: Korrektor:innen RGCourseTutors: Tutor:innen +RGCourseParticipantsInTutorial: Kursteilnehmer:innen, die in mindestens einem Tutorium angemeldet sind RGCourseUnacceptedApplicants: Nicht akzeptierte Bewerber:innen RecipientToggleAll: Alle/Keine CommCourseTestSubject customSubject@Text !ident-ok: [TEST] #{customSubject} diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 6f1ecad76..db6338b4c 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -4,6 +4,7 @@ RGCourseParticipants: Course participants RGCourseLecturers: Course administrators RGCourseCorrectors: Course correctors RGCourseTutors: Course tutors +RGCourseParticipantsInTutorial: Course participants who are registered for at least one tutorial RGCourseUnacceptedApplicants: Applicants not accepted RecipientToggleAll: All/None CommCourseTestSubject customSubject: [TEST] #{customSubject} diff --git a/src/Handler/Course/Communication.hs b/src/Handler/Course/Communication.hs index eac35ee83..cb9e762d2 100644 --- a/src/Handler/Course/Communication.hs +++ b/src/Handler/Course/Communication.hs @@ -7,8 +7,6 @@ import Import import Handler.Utils import Handler.Utils.Communication -import qualified Data.Map as Map - import qualified Database.Esqueleto.Legacy as E @@ -17,8 +15,8 @@ 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 + tuts'' <- selectKeysList [TutorialCourse ==. cid] [] + tuts' <- forM tuts'' $ \tutid -> do cID <- encrypt tutid return ( RGTutorialParticipants cID , E.from $ \(user `E.InnerJoin` participant) -> do @@ -26,6 +24,18 @@ postCCommR tid ssh csh = do 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 @@ -55,7 +65,7 @@ postCCommR tid ssh csh = do , crUltDest = SomeRoute $ CourseR tid ssh csh CCommR , crJobs = crJobsCourseCommunication cid , crTestJobs = crTestJobsCourseCommunication cid - , crRecipients = Map.fromList $ + , crRecipients = [ ( RGCourseParticipants , E.from $ \(user `E.InnerJoin` participant) -> do E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser @@ -69,14 +79,6 @@ postCCommR tid ssh csh = do E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid 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 - ) , ( RGCourseTutors , E.from $ \user -> do E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do @@ -85,7 +87,16 @@ postCCommR tid ssh csh = do E.&&. user E.^. UserId E.==. tutor E.^. TutorUser return user ) - , ( RGCourseUnacceptedApplicants + , ( 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 ++ + [ ( RGCourseUnacceptedApplicants , E.from $ \user -> do E.where_ . E.exists . E.from $ \courseApplication -> E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid @@ -96,7 +107,7 @@ postCCommR tid ssh csh = do E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive return user ) - ] ++ tuts ++ exams ++ sheets + ] , crRecipientAuth = Just $ \uid -> do cID <- encrypt uid evalAccessDB (CourseR tid ssh csh $ CUserR cID) False diff --git a/src/Handler/Tutorial/Communication.hs b/src/Handler/Tutorial/Communication.hs index c01464eec..84670801e 100644 --- a/src/Handler/Tutorial/Communication.hs +++ b/src/Handler/Tutorial/Communication.hs @@ -10,8 +10,6 @@ import Handler.Utils.Communication import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E -import qualified Data.Map as Map - getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html getTCommR = postTCommR @@ -36,21 +34,13 @@ postTCommR tid ssh csh tutn = do , crUltDest = SomeRoute $ CTutorialR tid ssh csh tutn TCommR , crJobs = crJobsCourseCommunication cid , crTestJobs = crTestJobsCourseCommunication cid - , crRecipients = Map.fromList $ + , crRecipients = [ ( 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 ) - , ( 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.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId - return user - ) , ( RGCourseTutors , E.from $ \user -> do E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do @@ -59,6 +49,14 @@ postTCommR tid ssh csh tutn = do E.&&. tutor E.^. TutorUser E.==. user E.^. UserId 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.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId + return user + ) ] ++ usertuts , crRecipientAuth = Just $ \uid -> do isTutorialUser <- E.selectExists . E.from $ \tutorialUser -> diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 39e1681ce..81b266fa6 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -22,7 +22,7 @@ import qualified Data.Set as Set import qualified Data.Conduit.Combinators as C -data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseUnacceptedApplicants +data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseParticipantsInTutorial | RGCourseUnacceptedApplicants | RGTutorialParticipants CryptoUUIDTutorial | RGExamRegistered CryptoUUIDExam | RGSheetSubmittor CryptoUUIDSheet @@ -69,7 +69,7 @@ instance Button UniWorX CommunicationButton where data CommunicationRoute = CommunicationRoute - { crRecipients :: Map RecipientGroup (E.SqlQuery (E.SqlExpr (Entity User))) + { crRecipients :: [(RecipientGroup, E.SqlQuery (E.SqlExpr (Entity User)))] , crRecipientAuth :: Maybe (UserId -> DB AuthResult) -- ^ Only resolve userids given as GET-Parameter if they fulfil this criterion , crJobs, crTestJobs :: Communication -> ConduitT () Job (YesodDB UniWorX) () , crHeading :: SomeMessage UniWorX @@ -111,7 +111,8 @@ commR CommunicationRoute{..} = do mbCurrentRoute <- getCurrentRoute (suggestedRecipients, chosenRecipients) <- runDB $ do - suggested <- for crRecipients $ \user -> E.select user + suggestedUsers <- for crRecipients $ \(_,user) -> E.select user + let suggested = zip (view _1 <$> crRecipients) suggestedUsers let decrypt' :: CryptoUUIDUser -> DB (Maybe (Entity User)) @@ -127,21 +128,21 @@ commR CommunicationRoute{..} = do let lookupUser :: UserId -> User lookupUser lId - = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (Map.elems suggestedRecipients) ++ chosenRecipients + = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (view _2 <$> suggestedRecipients) ++ chosenRecipients let chosenRecipients' = Map.fromList $ [ ( (BoundedPosition $ RecipientGroup g, pos) , (Right recp, recp `elem` map entityKey chosenRecipients) ) - | (g, recps) <- Map.toList suggestedRecipients + | (g, recps) <- suggestedRecipients , (pos, recp) <- zip [0..] $ map entityKey recps ] ++ [ ( (BoundedPosition RecipientCustom, pos) , (Right recp, True) ) - | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ Map.elems suggestedRecipients) + | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ view _2 <$> suggestedRecipients) ] - activeCategories = map RecipientGroup (Map.keys suggestedRecipients) `snoc` RecipientCustom + activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom let recipientAForm :: AForm Handler (Set (Either UserEmail UserId)) recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients') diff --git a/templates/widgets/communication/recipientLayout.hamlet b/templates/widgets/communication/recipientLayout.hamlet index ad63a7eb7..b925e632e 100644 --- a/templates/widgets/communication/recipientLayout.hamlet +++ b/templates/widgets/communication/recipientLayout.hamlet @@ -16,14 +16,16 @@ $if not (null activeCategories) _{MsgRGCourseCorrectors} $of RecipientGroup RGCourseTutors _{MsgRGCourseTutors} + $of RecipientGroup RGCourseParticipantsInTutorial + _{MsgRGCourseParticipantsInTutorial} $of RecipientGroup (RGTutorialParticipants tutid) ^{rgTutorialParticipantsCaption tutid} - $of RecipientGroup RGCourseUnacceptedApplicants - _{MsgRGCourseUnacceptedApplicants} $of RecipientGroup (RGExamRegistered eid) ^{rgExamRegisteredCaption eid} $of RecipientGroup (RGSheetSubmittor sid) ^{rgSheetSubmittorCaption sid} + $of RecipientGroup RGCourseUnacceptedApplicants + _{MsgRGCourseUnacceptedApplicants} $if hasContent category