filter corrected towards #270

This commit is contained in:
SJost 2019-01-23 14:48:17 +01:00
parent 9c4879f5b0
commit 55fed0f378
5 changed files with 16 additions and 5 deletions

3
.vscode/settings.json vendored Normal file
View File

@ -0,0 +1,3 @@
{
"AllAutocomplete.showCurrentDocument": false
}

View File

@ -565,7 +565,7 @@ MenuCorrections: Korrekturen
MenuSubmissions: Abgaben MenuSubmissions: Abgaben
MenuSheetList: Übungsblätter MenuSheetList: Übungsblätter
MenuSheetNew: Neues Übungsblatt anlegen MenuSheetNew: Neues Übungsblatt anlegen
MenuSheetCurrent: Akutelles Übungsblatt MenuSheetCurrent: Aktuelles Übungsblatt
MenuSheetLastInactive: Zuletzt abgegebenes Übungsblatt MenuSheetLastInactive: Zuletzt abgegebenes Übungsblatt
MenuCourseEdit: Kurs editieren MenuCourseEdit: Kurs editieren
MenuCourseNewTemplate: Als neuen Kurs klonen MenuCourseNewTemplate: Als neuen Kurs klonen

View File

@ -289,6 +289,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
| otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails) | otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False) E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
) )
, ( "israted"
, 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.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
)
] ]
, dbtFilterUI = fromMaybe mempty dbtFilterUI , dbtFilterUI = fromMaybe mempty dbtFilterUI
, dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI } , dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@ -491,9 +497,10 @@ postCorrectionsR = do
, colRated , colRated
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ \mPrev -> mconcat
[ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev) [ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev)
, Map.singleton "term" . maybeToList <$> aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) (Just <$> listToMaybe =<< Map.lookup "term" =<< mPrev) , Map.singleton "term" . maybeToList <$> aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) (Just <$> listToMaybe =<< Map.lookup "term" =<< mPrev)
, Map.singleton "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< mPrev) , Map.singleton "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< mPrev)
, Map.singleton "israted" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgRatingTime) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "israted" =<< mPrev)
] ]
courseOptions = runDB $ do courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False) courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)

View File

@ -139,7 +139,7 @@ homeUser uid = do
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR) (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
tickmark tickmark
] ]
let validator = def & defaultSorting [SortDescBy "done", SortDescBy "deadline"] let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
sheetTable <- runDB $ dbTableWidget' validator DBTable sheetTable <- runDB $ dbTableWidget' validator DBTable
{ dbtSQLQuery = tableData { dbtSQLQuery = tableData
, dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` sheet) `E.LeftOuterJoin` _) -> sheet E.^. SheetId , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` sheet) `E.LeftOuterJoin` _) -> sheet E.^. SheetId

View File

@ -5,6 +5,7 @@ $# hasPasses :: Maybe Int -- Should Passing be displayed?
$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets $# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets
$# hasPoints :: Maybe Points -- Should Points be displayed? $# hasPoints :: Maybe Points -- Should Points be displayed?
$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets $# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets
$# rowWdgts :: Liste von Widgets für jede Zeile (Normal,Bonus,KeineWertung)
$# -- $# --
<div> <div>
<h3>_{MsgSummaryTitle} _{title $ getSum $ numSheets $ sumSummaries} <h3>_{MsgSummaryTitle} _{title $ getSum $ numSheets $ sumSummaries}