From c4eb2c0f04adc6c7193b602b6bfa570c1ba3483b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 12 Nov 2019 17:05:39 +0100 Subject: [PATCH] feat(corrections-grade): working additional filters --- src/Handler/Corrections.hs | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 2da3ef67f..91e5aa239 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -369,11 +369,22 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d E.where_ $ (\f -> f user $ Set.singleton needle) $ E.mkContainsFilter (E.^. UserMatrikelnummer) ) - -- , ( "pseudonym" - -- , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(pseudonym) -> do - -- E.where_ $ querySheet table E.^. SheetId E.==. pseudonym E.^. SheetPseudonymSheet - -- E.where_ $ E.mkContainsFilter -- DB only stores Pseudonym == Word24. Conversion not possible in DB. - -- ) + , ( "rating-visible" + , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just True -> E.isJust $ submission E.^. SubmissionRatingTime + Just False-> E.isNothing $ submission E.^. SubmissionRatingTime + ) + , ( "rating" + , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) pts -> if + | Set.null pts -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> E.maybe (E.val False :: E.SqlExpr (E.Value Bool)) (\p -> p `E.in_` E.valList (Set.toList pts)) (submission E.^. SubmissionRatingPoints) + ) + , ( "comment" + , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) comm -> case getLast (comm :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> E.maybe (E.val False :: E.SqlExpr (E.Value Bool)) (E.hasInfix $ E.val needle) (submission E.^. SubmissionRatingComment) + ) ] , dbtFilterUI = fromMaybe mempty dbtFilterUI , dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI } @@ -1020,8 +1031,10 @@ postCorrectionsGradeR = do , 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) + , 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) <|> (Map.lookup "comment" =<< mPrev))) ] courseOptions = runDB $ do courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)