diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 65db94981..4accc76cf 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -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 diff --git a/src/Handler/Submission/Grade.hs b/src/Handler/Submission/Grade.hs index 2ee574b5b..41a869ff2 100644 --- a/src/Handler/Submission/Grade.hs +++ b/src/Handler/Submission/Grade.hs @@ -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) diff --git a/src/Handler/Submission/List.hs b/src/Handler/Submission/List.hs index b8151d625..99b47cdda 100644 --- a/src/Handler/Submission/List.hs +++ b/src/Handler/Submission/List.hs @@ -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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 18203825d..50e666ed0 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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