diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 2e1880882..9d844abc2 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -4,6 +4,8 @@ FilterTerm !ident-ok: Semester FilterCourseSchoolShort: Institut FilterRegistered: Angemeldet FilterCourseSearch: Volltext-Suche +FilterCourseSearchShorthand: Kürzel-Suche +FilterCourseSearchTitle: Titel-Suche FilterCourseRegistered: Registriert FilterCourseRegisterOpen: Anmeldung möglich FilterCourseAllocation: Zentralanmeldung @@ -279,4 +281,4 @@ LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lTyp CourseExamRegistrationTime: Angemeldet seit CourseParticipantStateIsActiveFilter: Ansicht CourseApply: Zum Kurs bewerben -CourseAdministrator: Kursadministrator:in \ No newline at end of file +CourseAdministrator: Kursadministrator:in diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index c4eda4efc..93ebd52a5 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -4,6 +4,8 @@ FilterTerm: Semester FilterCourseSchoolShort: Department FilterRegistered: Enrolled FilterCourseSearch: Text search +FilterCourseSearchShorthand: Shorthand search +FilterCourseSearchTitle: Title search FilterCourseRegistered: Registered FilterCourseRegisterOpen: Enrolment is allowed FilterCourseAllocation: Central allocation @@ -278,4 +280,4 @@ LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh} CourseExamRegistrationTime: Registered since CourseParticipantStateIsActiveFilter: View CourseApply: Apply for course -CourseAdministrator: Course administrator \ No newline at end of file +CourseAdministrator: Course administrator 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/Course/List.hs b/src/Handler/Course/List.hs index 02c5f7b43..c7ea11753 100644 --- a/src/Handler/Course/List.hs +++ b/src/Handler/Course/List.hs @@ -253,6 +253,12 @@ makeCourseTable colChoices psValidator' = do Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) E.||. (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) E.||. (E.maybe (E.val mempty) (E.castString . esqueletoMarkupOutput) (course E.^. CourseDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + , singletonMap "search-shorthand" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + , singletonMap "search-title" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) , singletonMap "allocation" . FilterColumn $ \row (criteria :: Set AllocationSearch) -> if | Set.null criteria -> E.true | otherwise -> flip E.any criteria $ \case @@ -267,6 +273,8 @@ makeCourseTable colChoices psValidator' = do , pure $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool) , pure $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer) , pure $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgFilterCourseSearch) + , pure $ prismAForm (singletonFilter "search-shorthand") mPrev $ aopt textField (fslI MsgFilterCourseSearchShorthand) + , pure $ prismAForm (singletonFilter "search-title") mPrev $ aopt textField (fslI MsgFilterCourseSearchTitle) , pure $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgFilterCourseRegisterOpen) , guardOn (is _Just muid) $ prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterCourseRegistered)) diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index cde8a0015..69a32fd3f 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -293,9 +293,15 @@ postEGradesR tid ssh csh examn = do isSynced <- view . queryIsSynced $ E.val uid lift $ do - E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse) - E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId) - E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive) + E.on $ E.maybe E.true (\cCourse -> + cCourse E.==. E.val examCourse + ) (courseParticipant E.?. CourseParticipantCourse) + E.&&. E.maybe E.true (\cUser -> + cUser E.==. user E.^. UserId + ) (courseParticipant E.?. CourseParticipantUser) + E.&&. E.maybe E.true (\cState -> + cState E.==. E.val CourseParticipantActive + ) (courseParticipant E.?. CourseParticipantState) E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid) E.&&. occurrence E.?. ExamOccurrenceId E.==. E.joinV (examRegistration E.?. ExamRegistrationOccurrence) E.on $ examRegistration E.?. ExamRegistrationUser E.==. E.just (user E.^. UserId) 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