diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index fb124c041..7a97f8b22 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -365,7 +365,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = 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 = $(widgetFile "widgets/gradingSummary") + let statistics = gradeSummaryWidget gradingSummary fmap toTypedContent . defaultLayout $ do setTitleI MsgCourseCorrectionsTitle $(widgetFile "corrections") @@ -384,8 +384,18 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = (== Authorized) <$> evalAccessDB route True gradeSummaryWidget :: SheetTypeSummary -> Widget UniWorX IO () -gradeSummaryWidget sts = undefined - +gradeSummaryWidget sts = + let SheetTypeSummary{..} = addBonusToPoints sts + sumSummaries = (normalSummary <> bonusSummary <> informationalSummary) # _numSheets %~ (<> numNotGraded) + hasPassings = positiveSum $ numGradePasses sumSummaries + hasPoints = positiveSum $ sumGradePoints sumSummaries + rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") + | (sumHeader,summary) <- + [ (MsgSheetTypeNormal' ,normalSummary) + , (MsgSheetTypeBonus' ,bonusSummary) + , (MsgSheetTypeInformational' ,informationalSummary) + ] ] + in $(widgetFile "widgets/gradingSummary") type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData) diff --git a/templates/widgets/gradingSummary.hamlet b/templates/widgets/gradingSummary.hamlet index 7f0bd786f..08f04b9e5 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -1,35 +1,27 @@ $# Displays gradings Summary for various purposes $# -- -$with SheetTypeSummary{..} <- addBonusToPoints gradingSummary - $with sumSummaries <- mappend normalSummary (mappend bonusSummary informationalSummary) - $with hasPassings <- positiveSum $ numGradePasses sumSummaries - $with hasPoints <- positiveSum $ sumGradePoints sumSummaries -
| - $# empty cell for row headers - $maybe _ <- hasPassings - | _{MsgSheetGradingPassing'} - $maybe _ <- hasPoints - | _{MsgSheetGradingPoints'} - | _{MsgSheetGradingCount'} - $# Number of Sheet/Submissions used for calculating maximum passes/points - $with sumHeader <- MsgSheetTypeNormal' - $with summary <- normalSummary - ^{gradingSummaryRow} - $# $for (sumHeader, summary) <- [(MsgSheetTypeNormal',normalSummary),(MsgSheetTypeBonus',bonusSummary),(MsgSheetTypeInformational',informationalSummary)] - $# ^{gradingSummaryRow} - DEBUG - $maybe nrNoGrade <- positiveSum $ numNotGraded - | ||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| _{MsgSheetTypeNotGraded} - $maybe _ <- hasPassings - | - $maybe _ <- hasPoints - | - | #{display nrNoGrade}
- $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
- _{MsgSheetTypeInfo} - $nothing - _{MsgSheetTypeInfo} \ No newline at end of file +
+
| ||||||||||||||