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

feat(corrections): submission filter

Browse Source
This commit is contained in:
Gregor Kleen 2020-03-06 10:12:21 +01:00
parent 38945c99c4
commit 38dbfe73b2
2 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Handler/Corrections.hs
View File

@ -383,6 +383,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> E.maybe (E.val False :: E.SqlExpr (E.Value Bool)) (E.isInfixOf $ E.val needle) (submission E.^. SubmissionRatingComment)
)
, ( "submission"
, FilterProjected $ \(DBRow{..} :: CorrectionTableData) (criteria :: Set Text) ->
let cid = map CI.mk . unpack . toPathPiece $ dbrOutput ^. _7
criteria' = map CI.mk . unpack <$> Set.toList criteria
in any (\c -> c `isInfixOf` cid) criteria'
)
]
, dbtFilterUI = fromMaybe mempty dbtFilterUI
, dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@ -616,6 +622,7 @@ postCorrectionsR = do
, 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)))
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
]
courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
@ -661,6 +668,7 @@ postCCorrectionsR tid ssh csh = do
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
]
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
@ -691,6 +699,7 @@ postSSubsR tid ssh csh shn = do
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
-- "pseudonym" TODO DB only stores Word24
]
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway

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

@ -1167,9 +1167,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
_other -> return ()
let
rowCount
| (E.Value n, _, _):_ <- rows' = n
| otherwise = 0
rowCount = olength64 rows
rawAction = tblLink
$ setParam (wIdent "sorting") Nothing