From d03fd4bee6d645624c30297907c91bf4697aa2f8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 12 Nov 2019 12:15:48 +0100 Subject: [PATCH] feat(corrections-grade): basic filter UI with pseudonyms --- src/Handler/Corrections.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index da2e47096..2da3ef67f 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1015,6 +1015,23 @@ postCorrectionsGradeR = do , colPointsField , colCommentField ] -- Continue here + filterUI = Just $ \mPrev -> mconcat + [ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) + , prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) + , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) + , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev))) + , Map.singleton "pseudonym" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgPseudonyms) (Just <$> listToMaybe =<< ((Map.lookup "pseudonym" =<< mPrev) <|> (Map.lookup "pseudonym" =<< mPrev))) + , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime) + ] + courseOptions = runDB $ do + courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) + optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses + termOptions = runDB $ do + courses <- selectList [] [Asc CourseTerm] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) + optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses + schoolOptions = runDB $ do + courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand) + optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses psValidator = def & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData)) unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) @@ -1023,7 +1040,7 @@ postCorrectionsGradeR = do void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True return i - (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns mempty psValidator dbtProj' $ def + (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator dbtProj' $ def { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR }