feat(corrections-r): filter/sort by pseudonym
This commit is contained in:
Gregor Kleen
parent
1b6b781e82
commit
153af8c6b4
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -260,6 +260,7 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUIUserNameEmail
|
||||
, filterUIUserMatrikelnummer
|
||||
, filterUIPseudonym
|
||||
, filterUISheetSearch
|
||||
, filterUICorrectorNameEmail
|
||||
, filterUIIsAssigned
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user