feat(corrections-r): filter/sort by pseudonym

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

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

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

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

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
@@ -308,6 +310,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