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

refactor sheetGradeSummary part 2

Browse Source
This commit is contained in:
SJost 2018-12-19 15:48:38 +01:00
parent 9ba09c9998
commit 82aef8a254
5 changed files with 35 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Handler/Utils/SheetType.hs
View File

@ -9,25 +9,22 @@ import Utils.Lens
addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
addBonusToPoints sts =
sts & _normalSummary . _achievedPoints %~ maxBonusPts . addBonusPts
& _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass
update _achievedPoints _sumSheetsPoints $
update _achievedPasses _numSheetsPasses sts
where
bonusPoints = sts ^. _bonusSummary . _achievedPoints
maxPoints = sts ^. _normalSummary . _sumGradePoints
maxBonusPts = fmap $ min maxPoints
addBonusPts = maybeAdd bonusPoints
bonusPasses = sts ^. _bonusSummary . _achievedPasses
maxPasses = sts ^. _normalSummary . _numGradePasses
maxBonusPass = fmap $ min maxPasses
addBonusPass = maybeAdd bonusPasses
update lachieved lmax s =
let bonus = s ^. _bonusSummary . lachieved
valmax = s ^. _normalSummary . lmax
in s & _normalSummary . lachieved %~ min valmax . (bonus +)
gradeSummaryWidget :: RenderMessage UniWorX msg => (Int -> msg) -> SheetTypeSummary -> Widget
gradeSummaryWidget title sts =
let SheetTypeSummary{..} = addBonusToPoints sts
sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)
hasPassings = positiveSum $ numGradePasses sumSummaries
hasPoints = positiveSum $ sumGradePoints sumSummaries
sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)
hasPassings = positiveSum $ numSheetsPasses sumSummaries
hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries
hasPoints = positiveSum $ numSheetsPoints sumSummaries
hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries
rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow")
| (sumHeader,summary) <-
[ (MsgSheetTypeNormal' ,normalSummary)

20
src/Model/Types.hs
View File

@ -154,18 +154,18 @@ gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
data SheetGradeSummary = SheetGradeSummary
{ numSheets :: Count -- Total number of sheets, includes all
, numSheetsPasses :: Count -- Number of sheets required to pass
, numSheetsPoints :: Count -- Number of sheets having points
, sumSheetsPoints :: Sum Points -- Total of all points in all sheets
{ numSheets :: Count -- Total number of sheets, includes all
, numSheetsPasses :: Count -- Number of sheets required to pass FKA: numGradePasses
, numSheetsPoints :: Count -- Number of sheets having points FKA: sumGradePointsd
, sumSheetsPoints :: Sum Points -- Total of all points in all sheets
-- Marking dependend
, numMarked :: Count -- Number of already marked sheets
, numMarkedPasses :: Count -- Number of already marked sheets with passes
, numMarkedPoints :: Count -- Number of already marked sheets with points
, sumMarkedPoints :: Sum Point -- Achieveable points within marked sheets
, numMarked :: Count -- Number of already marked sheets
, numMarkedPasses :: Count -- Number of already marked sheets with passes
, numMarkedPoints :: Count -- Number of already marked sheets with points
, sumMarkedPoints :: Sum Point -- Achieveable points within marked sheets
--
, achievedPasses :: Count -- Achieved passes (within marked sheets)
, achievedPoints :: Sum Points -- Achieved points (within marked sheets)
, achievedPasses :: Count -- Achieved passes (within marked sheets)
, achievedPoints :: Sum Points -- Achieved points (within marked sheets)
} deriving (Generic, Read, Show, Eq)
instance Monoid SheetGradeSummary where

2
src/Utils.hs
View File

@ -337,7 +337,7 @@ ifMaybeM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argu
ifMaybeM Nothing dft _ = return dft
ifMaybeM (Just x) _ act = act x
maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespear: one $maybe instead of $with & $if
maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespeare: one $maybe instead of $with & $if
maybePositive a | a > 0 = Just a
| otherwise = Nothing

10
templates/widgets/gradingSummary.hamlet
View File

@ -1,8 +1,10 @@
$# Displays gradings Summary for various purposes
$# Expects several variables:
$# hasPassing :: Maybe Int -- Should Passing be displayed?
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# summary :: SheetGradeSummary -- summary to display
$# sumSummaries :: SheetGradeSummary -- summary over all grading types
$# hasPassing :: 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
$# --
<div>
<h3>_{title $ getSum $ numSheets $ sumSummaries}
@ -27,7 +29,7 @@ $# --
<td .table__td colspan=2>
<td .table__td>#{display nrNoGrade}
$maybe _ <- positiveSum $ bonusSummary ^. _numSheets
<p>_{MsgSheetTypeInfoBonus}
<p>_{MsgSheetTypeInfoBonus} #
$maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints)
_{MsgSheetGradingBonusIncluded}
$maybe _ <- positiveSum $ informationalSummary ^. _numSheets

9
templates/widgets/gradingSummaryRow.hamlet
View File

@ -1,9 +1,14 @@
$# Displays one row of the grading summary
$# Expects several variables:
$# hasPassing :: Maybe Int -- Should Passing be displayed?
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# summary :: SheetGradeSummary -- summary to display
$# sumHeader :: UniWorXMessage -- row header
$# hasPassing :: 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
$#
$# TODO: Durschnittliche Punktzahl anzeigen
$# TODO: Extra-Spalte für Punkte Bewertet = numMarkedPoints / Punkte Gesamt = sumSheetPoints
$#
$maybe nrSheets <- positiveSum $ summary ^. _numSheets
<tr .table__row >