fix(corrections-r): allow filtering by matriculation
This commit is contained in:
Gregor Kleen
parent
abdc2a8926
commit
1b6b781e82
@ -257,15 +257,14 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
|
||||
, colCorrector
|
||||
, colAssigned
|
||||
] -- Continue here
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr)
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUIUserNameEmail
|
||||
, filterUIUserMatrikelnummer
|
||||
, filterUISheetSearch
|
||||
, filterUICorrectorNameEmail
|
||||
, filterUIIsAssigned
|
||||
, filterUIIsRated
|
||||
, filterUISubmission
|
||||
]
|
||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||
(cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList
|
||||
|
||||
@ -38,15 +38,15 @@ postCorrectionsGradeR = do
|
||||
, colMaxPointsField
|
||||
, colCommentField
|
||||
] -- Continue here
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgTableCourse)
|
||||
, prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTableTerm)
|
||||
, prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgTableCourseSchool)
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
, prismAForm (singletonFilter "rating-visible" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
|
||||
, prismAForm (singletonFilter "rating" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` pointsField) (fslI MsgColumnRatingPoints)
|
||||
, Map.singleton "comment" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgRatingComment) (Just <$> listToMaybe =<< (Map.lookup "comment" =<< mPrev))
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUICourse courseOptions
|
||||
, filterUITerm termOptions
|
||||
, filterUISchool schoolOptions
|
||||
, filterUISheetSearch
|
||||
, filterUIIsRated
|
||||
-- , flip (prismAForm $ singletonFilter "rating-visible" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
|
||||
, filterUIRating
|
||||
, filterUIComment
|
||||
]
|
||||
courseOptions = runDB $ do
|
||||
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
|
||||
|
||||
@ -9,6 +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
|
||||
, makeCorrectionsTable
|
||||
, CorrectionTableData, CorrectionTableWhere
|
||||
, ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction
|
||||
@ -289,6 +290,46 @@ colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m
|
||||
colLastEdit = sortable (Just "last-edit") (i18nCell MsgTableLastEdit) $ \x -> maybeCell (x ^? resultLastEdit) dateTimeCell
|
||||
|
||||
|
||||
filterUICourse :: Handler (OptionList Text) -> DBFilterUI
|
||||
filterUICourse courseOptions = flip (prismAForm $ singletonFilter "course") $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgTableCourse)
|
||||
|
||||
filterUITerm :: Handler (OptionList Text) -> DBFilterUI
|
||||
filterUITerm termOptions = flip (prismAForm $ singletonFilter "term") $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTableTerm)
|
||||
|
||||
filterUISchool :: Handler (OptionList Text) -> DBFilterUI
|
||||
filterUISchool schoolOptions = flip (prismAForm $ singletonFilter "school") $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgTableCourseSchool)
|
||||
|
||||
filterUISheetSearch :: DBFilterUI
|
||||
filterUISheetSearch mPrev = singletonMap "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
|
||||
filterUIIsRated :: DBFilterUI
|
||||
filterUIIsRated = flip (prismAForm $ singletonFilter "israted" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
|
||||
filterUISubmission :: DBFilterUI
|
||||
filterUISubmission = flip (prismAForm $ singletonFilter "submission") $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
|
||||
|
||||
filterUIUserNameEmail :: DBFilterUI
|
||||
filterUIUserNameEmail = flip (prismAForm $ singletonFilter "user-name-email") $ aopt textField (fslI MsgTableCourseMembers)
|
||||
|
||||
filterUIUserMatrikelnummer :: DBFilterUI
|
||||
filterUIUserMatrikelnummer = flip (prismAForm $ singletonFilter "user-matriclenumber") $ aopt textField (fslI MsgTableMatrikelNr)
|
||||
|
||||
filterUICorrectorNameEmail :: DBFilterUI
|
||||
filterUICorrectorNameEmail = flip (prismAForm $ singletonFilter "corrector-name-email") $ aopt textField (fslI MsgTableCorrector)
|
||||
|
||||
filterUIIsAssigned :: DBFilterUI
|
||||
filterUIIsAssigned = flip (prismAForm $ singletonFilter "isassigned" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector)
|
||||
|
||||
filterUISubmissionGroup :: DBFilterUI
|
||||
filterUISubmissionGroup = flip (prismAForm $ singletonFilter "submittors-group") $ aopt textField (fslI MsgTableSubmissionGroup)
|
||||
|
||||
filterUIRating :: DBFilterUI
|
||||
filterUIRating = flip (prismAForm $ singletonFilter "rating" . maybePrism _PathPiece) $ aopt (lift `hoistField` pointsField) (fslI MsgColumnRatingPoints)
|
||||
|
||||
filterUIComment :: DBFilterUI
|
||||
filterUIComment mPrev = singletonMap "comment" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgRatingComment) (Just <$> listToMaybe =<< (Map.lookup "comment" =<< mPrev))
|
||||
|
||||
|
||||
makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
|
||||
=> CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> DBParams m x -> DB (DBResult m x)
|
||||
makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams = do
|
||||
@ -401,7 +442,7 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
|
||||
, singletonMap "user-matriclenumber" . FilterColumn $ E.mkExistsFilter $ \row needle -> E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
||||
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
|
||||
E.where_ $ dbtRowKey row E.==. submissionUser E.^. SubmissionUserSubmission
|
||||
E.where_ $ E.mkContainsFilter (E.^. UserMatrikelnummer) user (Set.singleton needle)
|
||||
E.where_ $ E.mkContainsFilterWith Just (E.^. UserMatrikelnummer) user (Set.singleton needle)
|
||||
, singletonMap "submission-group" . FilterColumn $ E.mkExistsFilter $ \row needle -> E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser `E.InnerJoin` submissionUser) -> do
|
||||
E.on $ submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser E.^. SubmissionGroupUserUser
|
||||
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
|
||||
@ -663,13 +704,13 @@ postCorrectionsR = do
|
||||
, colRating
|
||||
, colRated
|
||||
] -- Continue here
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgTableCourse)
|
||||
, prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTableTerm)
|
||||
, prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgTableCourseSchool)
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUICourse courseOptions
|
||||
, filterUITerm termOptions
|
||||
, filterUISchool schoolOptions
|
||||
, filterUISheetSearch
|
||||
, filterUIIsRated
|
||||
, filterUISubmission
|
||||
]
|
||||
courseOptions = runDB $ do
|
||||
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
|
||||
@ -709,16 +750,16 @@ postCCorrectionsR tid ssh csh = do
|
||||
, colCorrector
|
||||
, colAssigned
|
||||
] -- Continue here
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgTableCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr)
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUIUserNameEmail
|
||||
, filterUIUserMatrikelnummer
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgTableSubmissionGroup)
|
||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
|
||||
, filterUISheetSearch
|
||||
, filterUICorrectorNameEmail
|
||||
, filterUIIsAssigned
|
||||
, filterUIIsRated
|
||||
, filterUISubmissionGroup
|
||||
, filterUISubmission
|
||||
]
|
||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
|
||||
@ -744,14 +785,14 @@ postSSubsR tid ssh csh shn = do
|
||||
, colCorrector
|
||||
, colAssigned
|
||||
]
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgTableCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr)
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime)
|
||||
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgTableSubmissionGroup)
|
||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
|
||||
filterUI = Just $ mconcat
|
||||
[ filterUIUserNameEmail
|
||||
, filterUIUserMatrikelnummer
|
||||
, 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
|
||||
|
||||
@ -1171,7 +1171,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
&& all (is _Just) filterSql
|
||||
|
||||
psLimit' = bool PagesizeAll psLimit selectPagesize
|
||||
|
||||
|
||||
rows' <- E.select . E.from $ \t -> do
|
||||
res <- dbtSQLQuery t
|
||||
@ -1184,10 +1183,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
Nothing
|
||||
| PagesizeLimit l <- psLimit'
|
||||
, selectPagesize
|
||||
, hasn't (_FormSuccess . _DBCsvExport) csvMode
|
||||
-> do
|
||||
unless (has (_FormSuccess . _DBCsvExport) csvMode) $
|
||||
E.limit l
|
||||
E.offset (psPage * l)
|
||||
E.limit l
|
||||
E.offset $ psPage * l
|
||||
Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps
|
||||
_other -> return ()
|
||||
Map.foldr (\fc expr -> maybe (return ()) (E.where_ . ($ t)) fc >> expr) (return ()) filterSql
|
||||
|
||||
Loading…
Reference in New Issue
Block a user