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

fix(exams): don't show manual bonus as inconsistent

Browse Source
This commit is contained in:
Gregor Kleen 2020-05-05 16:23:37 +02:00
parent 8749d1d6c0
commit fb54c8445a
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Exam/Users.hs
View File

@ -165,7 +165,7 @@ resultCourseNote = _dbrOutput . _10 . _Just
resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points
resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus')) resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> join $ examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus'))
resultAutomaticExamResult :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData ExamResultPassedGrade resultAutomaticExamResult :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData ExamResultPassedGrade
resultAutomaticExamResult exam@Exam{..} examBonus' = folding . runReader $ do resultAutomaticExamResult exam@Exam{..} examBonus' = folding . runReader $ do

8
src/Handler/Utils/Exam.hs
View File

@ -144,12 +144,12 @@ getRelevantSheetsUpTo cid uid mCutoff
examResultBonus :: ExamBonusRule examResultBonus :: ExamBonusRule
-> SheetGradeSummary -- ^ `examBonusPossible` -> SheetGradeSummary -- ^ `examBonusPossible`
-> SheetGradeSummary -- ^ `examBonusAchieved` -> SheetGradeSummary -- ^ `examBonusAchieved`
-> Points -> Maybe Points
examResultBonus bonusRule bonusPossible bonusAchieved = case bonusRule of examResultBonus bonusRule bonusPossible bonusAchieved = case bonusRule of
ExamBonusManual{} ExamBonusManual{}
-> 0 -> Nothing
ExamBonusPoints{..} ExamBonusPoints{..}
-> roundToPoints bonusRound $ toRational bonusMaxPoints * bonusProp -> Just . roundToPoints bonusRound $ toRational bonusMaxPoints * bonusProp
where where
bonusProp :: Rational bonusProp :: Rational
bonusProp bonusProp
@ -228,7 +228,7 @@ examBonusGrade :: ( MonoFoldable sheets
examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus
where mBonus = asum where mBonus = asum
[ bonusInp ^? _Left [ bonusInp ^? _Left
, examResultBonus <$> examBonusRule <*> bonusPossible <*> bonusAchieved , join $ examResultBonus <$> examBonusRule <*> bonusPossible <*> bonusAchieved
] ]
sheetSummary = flip (previews _Right) bonusInp . ofoldMap $ uncurry sheetTypeSum sheetSummary = flip (previews _Right) bonusInp . ofoldMap $ uncurry sheetTypeSum
bonusPossible = normalSummary <$> sheetSummary bonusPossible = normalSummary <$> sheetSummary