fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(corrections-r): allow filtering by matriculation

Browse Source
This commit is contained in:
Gregor Kleen 2021-08-17 11:44:14 +02:00
parent abdc2a8926
commit 1b6b781e82
4 changed files with 86 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Handler/Course/User.hs
View File

@ -257,15 +257,14 @@ courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
, colCorrector , colCorrector
, colAssigned , colAssigned
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ mconcat
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseCourseMembers) [ filterUIUserNameEmail
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr) , filterUIUserMatrikelnummer
-- "pseudonym" TODO DB only stores Word24 , filterUISheetSearch
, Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev))) , filterUICorrectorNameEmail
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector) , filterUIIsAssigned
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector) , filterUIIsRated
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime) , filterUISubmission
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission)
] ]
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
(cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList (cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList

18
src/Handler/Submission/Grade.hs
View File

@ -38,15 +38,15 @@ postCorrectionsGradeR = do
, colMaxPointsField , colMaxPointsField
, colCommentField , colCommentField
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ mconcat
[ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgTableCourse) [ filterUICourse courseOptions
, prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTableTerm) , filterUITerm termOptions
, prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgTableCourseSchool) , filterUISchool schoolOptions
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev))) , filterUISheetSearch
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime) , filterUIIsRated
, prismAForm (singletonFilter "rating-visible" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone) -- , flip (prismAForm $ singletonFilter "rating-visible" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
, prismAForm (singletonFilter "rating" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` pointsField) (fslI MsgColumnRatingPoints) , filterUIRating
, Map.singleton "comment" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgRatingComment) (Just <$> listToMaybe =<< (Map.lookup "comment" =<< mPrev)) , filterUIComment
] ]
courseOptions = runDB $ do courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)

91
src/Handler/Submission/List.hs
View File

@ -9,6 +9,7 @@ module Handler.Submission.List
, restrictAnonymous, restrictCorrector , restrictAnonymous, restrictCorrector
, ratedBy, courseIs, sheetIs, userIs , ratedBy, courseIs, sheetIs, userIs
, colTerm, colSchool, colCourse, colSheet, colCorrector, colSubmissionLink, colSelect, colSubmittors, colSMatrikel, colRating, colAssigned, colRated, colPseudonyms, colRatedField, colPointsField, colMaxPointsField, colCommentField, colLastEdit, colSGroups , 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 , makeCorrectionsTable
, CorrectionTableData, CorrectionTableWhere , CorrectionTableData, CorrectionTableWhere
, ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction , 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 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 ) 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) => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> DBParams m x -> DB (DBResult m x)
makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams = do 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 , 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.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
E.where_ $ dbtRowKey row E.==. submissionUser E.^. SubmissionUserSubmission 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 , 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 $ submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser E.^. SubmissionGroupUserUser
E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
@ -663,13 +704,13 @@ postCorrectionsR = do
, colRating , colRating
, colRated , colRated
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ mconcat
[ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgTableCourse) [ filterUICourse courseOptions
, prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTableTerm) , filterUITerm termOptions
, prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgTableCourseSchool) , filterUISchool schoolOptions
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgTableSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev))) , filterUISheetSearch
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime) , filterUIIsRated
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission) , filterUISubmission
] ]
courseOptions = runDB $ do courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
@ -709,16 +750,16 @@ postCCorrectionsR tid ssh csh = do
, colCorrector , colCorrector
, colAssigned , colAssigned
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ mconcat
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgTableCourseMembers) [ filterUIUserNameEmail
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr) , filterUIUserMatrikelnummer
-- "pseudonym" TODO DB only stores Word24 -- "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))) , filterUISheetSearch
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector) , filterUICorrectorNameEmail
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector) , filterUIIsAssigned
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime) , filterUIIsRated
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgTableSubmissionGroup) , filterUISubmissionGroup
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission) , filterUISubmission
] ]
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
@ -744,14 +785,14 @@ postSSubsR tid ssh csh shn = do
, colCorrector , colCorrector
, colAssigned , colAssigned
] ]
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ mconcat
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgTableCourseMembers) [ filterUIUserNameEmail
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgTableMatrikelNr) , filterUIUserMatrikelnummer
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgTableCorrector) , filterUICorrectorNameEmail
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableHasCorrector) , filterUIIsAssigned
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableRatingTime) , filterUIIsRated
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgTableSubmissionGroup) , filterUISubmissionGroup
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission) , filterUISubmission
-- "pseudonym" TODO DB only stores Word24 -- "pseudonym" TODO DB only stores Word24
] ]
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway

7
src/Handler/Utils/Table/Pagination.hs
View File

@ -1171,7 +1171,6 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
&& all (is _Just) filterSql && all (is _Just) filterSql
psLimit' = bool PagesizeAll psLimit selectPagesize psLimit' = bool PagesizeAll psLimit selectPagesize
rows' <- E.select . E.from $ \t -> do rows' <- E.select . E.from $ \t -> do
res <- dbtSQLQuery t res <- dbtSQLQuery t
@ -1184,10 +1183,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
Nothing Nothing
| PagesizeLimit l <- psLimit' | PagesizeLimit l <- psLimit'
, selectPagesize , selectPagesize
, hasn't (_FormSuccess . _DBCsvExport) csvMode
-> do -> do
unless (has (_FormSuccess . _DBCsvExport) csvMode) $ E.limit l
E.limit l E.offset $ psPage * l
E.offset (psPage * l)
Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps
_other -> return () _other -> return ()
Map.foldr (\fc expr -> maybe (return ()) (E.where_ . ($ t)) fc >> expr) (return ()) filterSql Map.foldr (\fc expr -> maybe (return ()) (E.where_ . ($ t)) fc >> expr) (return ()) filterSql