feat(exams): better display exam-result-information

src/Handler/Exam/Show.hs

@@ -22,7 +22,7 @@ getEShowR tid ssh csh examn = do
   cTime <- liftIO getCurrentTime
   mUid <- maybeAuthId
 
-  (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), lecturerInfoShown) <- runDB $ do
+  (Entity _ Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), lecturerInfoShown) <- runDB $ do
     exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
 
     let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
@@ -43,6 +43,7 @@ getEShowR tid ssh csh examn = do
     let results = maybe Map.empty (\rs -> Map.fromList [ (examPartResultExamPart, res) | res@(Entity _ ExamPartResult{..}) <- rs ]) resultsRaw
 
     result <- fmap join . for mUid $ getBy . UniqueExamResult eId
+    bonus <- fmap join . for mUid $ getBy . UniqueExamBonus eId
 
     occurrencesRaw <- E.select . E.from $ \examOccurrence -> do
       E.where_ $ examOccurrence E.^. ExamOccurrenceExam E.==. E.val eId
@@ -64,12 +65,20 @@ getEShowR tid ssh csh examn = do
 
     lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
-    return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, occurrences, (registered, mayRegister), lecturerInfoShown)
+    return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), lecturerInfoShown)
 
   let occurrenceNamesShown = lecturerInfoShown
       partNumbersShown = lecturerInfoShown
       examClosedShown = lecturerInfoShown
 
+      sumMaxPoints = sum [ fromRational examPartWeight * mPoints | Entity _ ExamPart{..} <- examParts, let Just mPoints = examPartMaxPoints ]
+      sumPoints = getSum <$> foldMap (fmap Sum . examPartResultResult . entityVal) results
+
+      noBonus = fromMaybe False $ do
+        guardM $ bonusOnlyPassed <$> examBonusRule
+        return . fromMaybe True $ result ^? _Just . _entityVal . _examResultResult . _examResult . passingGrade . _Wrapped . to not
+      
+
   let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
       registerWidget
         | Just isRegistered <- registered

templates/default-layout.lucius

@@ -319,18 +319,24 @@ input[type="button"].btn-info:hover,
 
 .table--striped {
 
-  .table__row:not(.no-stripe):nth-child(even) {
+  .table__row:not(.no-stripe):not(.table__row--sum):nth-child(even) {
     background-color: rgba(0, 0, 0, 0.03);
   }
 }
 
 .table--hover {
 
-  .table__row:not(.no-hover):not(.table__row--head):hover {
+  .table__row:not(.no-hover):not(.table__row--sum):not(.table__row--head):hover {
     background-color: rgba(0, 0, 0, 0.07);
   }
 }
 
+.table__row--sum td.table__td::before {
+  content: 'Σ';
+  font-weight: bold;
+  margin-right: .25em;
+}
+
 /* SCROLLTABLE */
 .scrolltable {
   overflow: auto;

templates/exam-show.cassius

@@ -1,6 +1,6 @@
-.occurrence--not-registered
+.occurrence--not-registered, .no-bonus
-  text-decoration: strike-through;
+  text-decoration: line-through
 
 .result
-  padding-left: 2em;
+  font-size: 3rem
-  font-size: 20px;
+  margin: 30px 30px 0 !important

templates/exam-show.hamlet

@@ -170,5 +170,53 @@ $if gradingShown && not (null examParts)
                     _{MsgExamNoShow}
                   $of Just ExamVoided
                     _{MsgExamVoided}
+      <tfoot>
+        $maybe mPoints <- fmap (examBonusBonus . entityVal) bonus
+          $if showMaxPoints
+            <tr .table__row .table__row--sum>
+              $if partNumbersShown
+                <td>
+              <td>
+              <td .table__td>
+                #{showFixed True sumMaxPoints}
+              <td>
+          <tr .table__row>
+            $if partNumbersShown
+              <td .table__td>
+            <td .table__td>
+              _{MsgExamBonusAchieved}
+            $if showMaxPoints
+              <td .table__td>
+            $if showAchievedPoints
+              <td .table__td :noBonus:.no-bonus>
+                #{showFixed True mPoints}
+          <tr .table__row .table__row--sum>
+            $if partNumbersShown
+              <td>
+            <td>
+            $if showMaxPoints
+              <td>
+            $if showAchievedPoints
+              <td .table__td>
+                $case sumPoints
+                  $of ExamAttended ps
+                    #{showFixed True ps}
+                  $of _
+        $nothing
+            <tr .table__row .table__row--sum>
+              $if partNumbersShown
+                <td>
+              <td>
+              $if showMaxPoints
+                <td .table__td>
+                  #{showFixed True sumMaxPoints}
+              $if showAchievedPoints
+                <td .table__td>
+                  $case sumPoints
+                    $of ExamAttended ps
+                      #{showFixed True ps}
+                    $of _
+            
+          
 
 $# TODO: Statistics