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

feat(corrections-grade): working additional filters

Browse Source
This commit is contained in:
Sarah Vaupel 2019-11-12 17:05:39 +01:00 committed by Gregor Kleen
parent d03fd4bee6
commit c4eb2c0f04
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Handler/Corrections.hs
View File

@ -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)