From 553d14e8093e18381b3e4525e4a86af888d2ade8 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 12 Dec 2018 15:20:13 +0100 Subject: [PATCH] single runDB for correction statistics ensures match --- src/Handler/Corrections.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index ba494b409..e2987b6cd 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -301,7 +301,18 @@ data ActionCorrectionsData = CorrDownloadData correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent 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 (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf (actionRes, action) <- multiAction actions Nothing @@ -379,12 +390,6 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr) 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 setTitleI MsgCourseCorrectionsTitle $(widgetFile "corrections")