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

NO COMPILE. Templates for summaries done, but nestes does not (still) work. Duh.

Browse Source
This commit is contained in:
SJost 2018-11-30 14:44:23 +01:00
parent 2308771350
commit 81d8d8c017
2 changed files with 38 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/Corrections.hs
View File

@ -365,7 +365,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints 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 [] -- 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 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 fmap toTypedContent . defaultLayout $ do
setTitleI MsgCourseCorrectionsTitle setTitleI MsgCourseCorrectionsTitle
$(widgetFile "corrections") $(widgetFile "corrections")
@ -384,8 +384,18 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
(== Authorized) <$> evalAccessDB route True (== Authorized) <$> evalAccessDB route True
gradeSummaryWidget :: SheetTypeSummary -> Widget UniWorX IO () 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) type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData)

58
templates/widgets/gradingSummary.hamlet
View File

@ -1,35 +1,27 @@
$# Displays gradings Summary for various purposes $# Displays gradings Summary for various purposes
$# -- $# --
$with SheetTypeSummary{..} <- addBonusToPoints gradingSummary <div>
$with sumSummaries <- mappend normalSummary (mappend bonusSummary informationalSummary) <table>
$with hasPassings <- positiveSum $ numGradePasses sumSummaries <tr>
$with hasPoints <- positiveSum $ sumGradePoints sumSummaries <th>
<div> $# empty cell for row headers
<table> $maybe _ <- hasPassings
<tr> <th colspan=2>_{MsgSheetGradingPassing'}
<th> $maybe _ <- hasPoints
$# empty cell for row headers <th colspan=2>_{MsgSheetGradingPoints'}
$maybe _ <- hasPassings <th>_{MsgSheetGradingCount'}
<th colspan=2>_{MsgSheetGradingPassing'} $# Number of Sheet/Submissions used for calculating maximum passes/points
$maybe _ <- hasPoints $forall row <- rowWdgts
<th colspan=2>_{MsgSheetGradingPoints'} ^{row}
<th>_{MsgSheetGradingCount'} $maybe nrNoGrade <- positiveSum $ numNotGraded
$# Number of Sheet/Submissions used for calculating maximum passes/points <tr>
$with sumHeader <- MsgSheetTypeNormal' <th>_{MsgSheetTypeNotGraded}
$with summary <- normalSummary $maybe _ <- hasPassings
^{gradingSummaryRow} <td colspan=2>
$# $for (sumHeader, summary) <- [(MsgSheetTypeNormal',normalSummary),(MsgSheetTypeBonus',bonusSummary),(MsgSheetTypeInformational',informationalSummary)] $maybe _ <- hasPoints
$# ^{gradingSummaryRow} <td colspan=2>
DEBUG <td>#{display nrNoGrade}
$maybe nrNoGrade <- positiveSum $ numNotGraded $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
<tr> <p>_{MsgSheetTypeInfo}
<th>_{MsgSheetTypeNotGraded} $nothing
$maybe _ <- hasPassings <p>_{MsgSheetTypeInfo}
<td colspan=2>
$maybe _ <- hasPoints
<td colspan=2>
<td>#{display nrNoGrade}
$maybe _ <- positiveSum $ bonusSummary ^. _numSheets
<p>_{MsgSheetTypeInfo}
$nothing
<p>_{MsgSheetTypeInfo}