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

20
src/Model/Types.hs
View File

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

10
templates/widgets/gradingSummary.hamlet
View File

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

9
templates/widgets/gradingSummaryRow.hamlet
View File

@ -1,9 +1,14 @@
$# Displays one row of the grading summary $# Displays one row of the grading summary
$# Expects several variables: $# Expects several variables:
$# hasPassing :: Maybe Int -- Should Passing be displayed?
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# summary :: SheetGradeSummary -- summary to display $# summary :: SheetGradeSummary -- summary to display
$# sumHeader :: UniWorXMessage -- row header $# 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 $maybe nrSheets <- positiveSum $ summary ^. _numSheets
<tr .table__row > <tr .table__row >