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

single runDB for correction statistics ensures match

Browse Source
This commit is contained in:
SJost 2018-12-12 15:20:13 +01:00
parent 306fb351ad
commit 553d14e809
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Handler/Corrections.hs
View File

@ -301,7 +301,18 @@ data ActionCorrectionsData = CorrDownloadData
correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
tableForm <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator return (tableForm, statistics) <- runDB $ do
-- Query for Table
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator return
-- Similar Query for Statistics over alle possible Table elements (not just the ones shown)
gradingSummary <- do
let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
-- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
return (tableForm,statistics)
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
(fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf
(actionRes, action) <- multiAction actions Nothing (actionRes, action) <- multiAction actions Nothing
@ -379,12 +390,6 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr) addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
redirect currentRoute redirect currentRoute
gradingSummary <- runDB $ do
let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
-- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
fmap toTypedContent . defaultLayout $ do fmap toTypedContent . defaultLayout $ do
setTitleI MsgCourseCorrectionsTitle setTitleI MsgCourseCorrectionsTitle
$(widgetFile "corrections") $(widgetFile "corrections")