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

filter corrected towards #270

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

2
messages/uniworx/de.msg
View File

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

13
src/Handler/Corrections.hs
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)
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
, dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@ -491,9 +497,10 @@ postCorrectionsR = do
, colRated
] -- Continue here
filterUI = Just $ \mPrev -> mconcat
[ 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 "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< 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 "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
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)

2
src/Handler/Home.hs
View File

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

1
templates/widgets/gradingSummary.hamlet
View File

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