diff --git a/messages/uniworx/categories/courses/submission/de-de-formal.msg b/messages/uniworx/categories/courses/submission/de-de-formal.msg index 165cfe9a9..54a7795d5 100644 --- a/messages/uniworx/categories/courses/submission/de-de-formal.msg +++ b/messages/uniworx/categories/courses/submission/de-de-formal.msg @@ -68,6 +68,7 @@ Corrected: Korrigiert HeadingSubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen SubmissionUsers: Studenten AssignedTime: Zuteilung +SubmissionPseudonym !ident-ok: Pseudonym Pseudonyms: Pseudonyme CourseCorrectionsTitle: Korrekturen für diesen Kurs SubmissionArchiveName: abgaben diff --git a/messages/uniworx/categories/courses/submission/en-eu.msg b/messages/uniworx/categories/courses/submission/en-eu.msg index f9efeb3a0..e7f96147c 100644 --- a/messages/uniworx/categories/courses/submission/en-eu.msg +++ b/messages/uniworx/categories/courses/submission/en-eu.msg @@ -66,6 +66,7 @@ Corrected: Marked HeadingSubmissionEditHead tid ssh csh sheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Edit/Create submission SubmissionUsers: Submittors AssignedTime: Assigned +SubmissionPseudonym !ident-ok: Pseudonym Pseudonyms: Pseudonyms CourseCorrectionsTitle: Corrections for this course SubmissionArchiveName: submissions diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 4accc76cf..5db9da78b 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -260,6 +260,7 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do filterUI = Just $ mconcat [ filterUIUserNameEmail , filterUIUserMatrikelnummer + , filterUIPseudonym , filterUISheetSearch , filterUICorrectorNameEmail , filterUIIsAssigned diff --git a/src/Handler/Submission/Grade.hs b/src/Handler/Submission/Grade.hs index 41a869ff2..e848d2901 100644 --- a/src/Handler/Submission/Grade.hs +++ b/src/Handler/Submission/Grade.hs @@ -43,6 +43,7 @@ postCorrectionsGradeR = do , filterUITerm termOptions , filterUISchool schoolOptions , filterUISheetSearch + , filterUIPseudonym , filterUIIsRated -- , flip (prismAForm $ singletonFilter "rating-visible" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone) , filterUIRating diff --git a/src/Handler/Submission/List.hs b/src/Handler/Submission/List.hs index 99b47cdda..72bce9202 100644 --- a/src/Handler/Submission/List.hs +++ b/src/Handler/Submission/List.hs @@ -9,7 +9,7 @@ module Handler.Submission.List , restrictAnonymous, restrictCorrector , ratedBy, courseIs, sheetIs, userIs , colTerm, colSchool, colCourse, colSheet, colCorrector, colSubmissionLink, colSelect, colSubmittors, colSMatrikel, colRating, colAssigned, colRated, colPseudonyms, colRatedField, colPointsField, colMaxPointsField, colCommentField, colLastEdit, colSGroups - , filterUICourse, filterUITerm, filterUISchool, filterUISheetSearch, filterUIIsRated, filterUISubmission, filterUIUserNameEmail, filterUIUserMatrikelnummer, filterUICorrectorNameEmail, filterUIIsAssigned, filterUISubmissionGroup, filterUIRating, filterUIComment + , filterUICourse, filterUITerm, filterUISchool, filterUISheetSearch, filterUIIsRated, filterUISubmission, filterUIUserNameEmail, filterUIUserMatrikelnummer, filterUICorrectorNameEmail, filterUIIsAssigned, filterUISubmissionGroup, filterUIRating, filterUIComment, filterUIPseudonym , makeCorrectionsTable , CorrectionTableData, CorrectionTableWhere , ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction @@ -40,13 +40,15 @@ import Database.Persist.Sql (updateWhereCount) import Data.List (genericLength) -newtype CorrectionTableFilterProj = CorrectionTableFilterProj +data CorrectionTableFilterProj = CorrectionTableFilterProj { corrProjFilterSubmission :: Maybe (Set [CI Char]) + , corrProjFilterPseudonym :: Maybe (Set [CI Char]) } instance Default CorrectionTableFilterProj where def = CorrectionTableFilterProj { corrProjFilterSubmission = Nothing + , corrProjFilterPseudonym = Nothing } makeLenses_ ''CorrectionTableFilterProj @@ -307,6 +309,9 @@ filterUIIsRated = flip (prismAForm $ singletonFilter "israted" . maybePrism _Pat filterUISubmission :: DBFilterUI filterUISubmission = flip (prismAForm $ singletonFilter "submission") $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission) + +filterUIPseudonym :: DBFilterUI +filterUIPseudonym = flip (prismAForm $ singletonFilter "pseudonym") $ aopt (lift `hoistField` textField) (fslI MsgSubmissionPseudonym) filterUIUserNameEmail :: DBFilterUI filterUIUserNameEmail = flip (prismAForm $ singletonFilter "user-name-email") $ aopt textField (fslI MsgTableCourseMembers) @@ -357,6 +362,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams return (submission, sheet, crse, corrector, lastEdit) dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do (submission@(Entity sId _), sheet@(Entity shId Sheet{..}), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector, E.Value mbLastEdit) <- view $ _dbtProjRow . _dbrOutput + cid <- encrypt sId forMM_ (view $ _dbtProjFilter . _corrProjFilterSubmission) $ \criteria -> let haystack = map CI.mk . unpack $ toPathPiece cid @@ -377,6 +383,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams return (user, pseudonym E.?. SheetPseudonymPseudonym, submissionGroup') let submittorMap = List.foldr (\(Entity userId user, E.Value pseudo, E.Value sGroup) -> Map.insert userId (user, pseudo, sGroup)) Map.empty submittors + + forMM_ (view $ _dbtProjFilter . _corrProjFilterPseudonym) $ \criteria -> + let haystacks = setOf (folded . resultUserPseudonym . re _PseudonymText . to (map CI.mk . unpack)) submittorMap + in guard $ any (\haystack -> any (`isInfixOf` haystack) criteria) haystacks + nonAnonymousAccess <- lift . lift $ or2M (return $ not sheetAnonymousCorrection) (hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR) @@ -409,6 +420,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams , singletonMap "submittors" . SortProjected . comparing $ \x -> guardOn @Maybe (x ^. resultNonAnonymousAccess) $ setOf (resultSubmittors . resultUserUser . $(multifocusG 2) _userSurname _userDisplayName) x , singletonMap "submittors-matriculation" . SortProjected . comparing $ \x -> guardOn @Maybe (x ^. resultNonAnonymousAccess) $ setOf (resultSubmittors . resultUserUser . _userMatrikelnummer . _Just) x , singletonMap "submittors-group" . SortProjected . comparing $ \x -> guardOn @Maybe (x ^. resultNonAnonymousAccess) $ setOf (resultSubmittors . resultUserSubmissionGroup) x + , singletonMap "submittors-pseudonyms" . SortProjected . comparing $ \x -> setOf (resultSubmittors . resultUserPseudonym . re _PseudonymText) x , singletonMap "comment" . SortColumn $ views querySubmission (E.^. SubmissionRatingComment) -- sorting by comment specifically requested by correctors to easily see submissions to be done , singletonMap "last-edit" . SortColumn $ view queryLastEdit , singletonMap "submission" . SortProjected . comparing $ toPathPiece . view resultCryptoID @@ -453,6 +465,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams , singletonMap "rating" . FilterColumn . E.mkExactFilterWith Just $ views querySubmission (E.^. SubmissionRatingPoints) , singletonMap "comment" . FilterColumn . E.mkContainsFilterWith Just $ views querySubmission (E.^. SubmissionRatingComment) , singletonMap "submission" $ FilterProjected (_corrProjFilterSubmission ?~) + , singletonMap "pseudonym" $ FilterProjected (_corrProjFilterPseudonym ?~) ] , dbtFilterUI = fromMaybe mempty dbtFilterUI , dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (const defaultDBSFilterLayout) dbtFilterUI } @@ -705,7 +718,8 @@ postCorrectionsR = do , colRated ] -- Continue here filterUI = Just $ mconcat - [ filterUICourse courseOptions + [ filterUIPseudonym + , filterUICourse courseOptions , filterUITerm termOptions , filterUISchool schoolOptions , filterUISheetSearch @@ -753,7 +767,7 @@ postCCorrectionsR tid ssh csh = do filterUI = Just $ mconcat [ filterUIUserNameEmail , filterUIUserMatrikelnummer - -- "pseudonym" TODO DB only stores Word24 + , filterUIPseudonym , filterUISheetSearch , filterUICorrectorNameEmail , filterUIIsAssigned @@ -788,12 +802,12 @@ postSSubsR tid ssh csh shn = do filterUI = Just $ mconcat [ filterUIUserNameEmail , filterUIUserMatrikelnummer + , filterUIPseudonym , filterUICorrectorNameEmail , filterUIIsAssigned , filterUIIsRated , filterUISubmissionGroup , filterUISubmission - -- "pseudonym" TODO DB only stores Word24 ] psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway correctionsR whereClause colonnade filterUI psValidator $ Map.fromList