From fb54c8445aa8b9762b6a8e2b4dd18ae379b80d2e Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 5 May 2020 16:23:37 +0200
Subject: [PATCH] fix(exams): don't show manual bonus as inconsistent

---
 src/Handler/Exam/Users.hs | 2 +-
 src/Handler/Utils/Exam.hs | 8 ++++----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs
index af8d807e1..56c2e0e33 100644
--- a/src/Handler/Exam/Users.hs
+++ b/src/Handler/Exam/Users.hs
@@ -165,7 +165,7 @@ resultCourseNote = _dbrOutput . _10 . _Just
 
 
 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@Exam{..} examBonus' = folding . runReader $ do
diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs
index 3ed2a9d6a..8ba5f5584 100644
--- a/src/Handler/Utils/Exam.hs
+++ b/src/Handler/Utils/Exam.hs
@@ -144,12 +144,12 @@ getRelevantSheetsUpTo cid uid mCutoff
 examResultBonus :: ExamBonusRule
                 -> SheetGradeSummary -- ^ `examBonusPossible`
                 -> SheetGradeSummary -- ^ `examBonusAchieved`
-                -> Points
+                -> Maybe Points
 examResultBonus bonusRule bonusPossible bonusAchieved = case bonusRule of
   ExamBonusManual{}
-    -> 0
+    -> Nothing
   ExamBonusPoints{..}
-    -> roundToPoints bonusRound $ toRational bonusMaxPoints * bonusProp
+    -> Just . roundToPoints bonusRound $ toRational bonusMaxPoints * bonusProp
   where
     bonusProp :: Rational
     bonusProp
@@ -228,7 +228,7 @@ examBonusGrade :: ( MonoFoldable sheets
 examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus
   where mBonus = asum
           [ bonusInp ^? _Left
-          , examResultBonus <$> examBonusRule <*> bonusPossible <*> bonusAchieved
+          , join $ examResultBonus <$> examBonusRule <*> bonusPossible <*> bonusAchieved
           ]
         sheetSummary = flip (previews _Right) bonusInp . ofoldMap $ uncurry sheetTypeSum
         bonusPossible = normalSummary <$> sheetSummary