feat(exams): refine exam form

messages/uniworx/de.msg

@@ -1329,17 +1329,20 @@ ExamClosedTip: Prüfungsämter, die im System Noten einsehen, werden zu diesem Z
 ExamShowGrades: Klausur ist benotet
 ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsämter nur informiert werden, ob die Klausur bestanden wurde?
 ExamPublicStatistics: Statistik veröffentlichen
-ExamPublicStatisticsTip: Soll die statistische Auswertung auch den Teilnehmern angezeigt werden, sobald diese ihre Noten einsehen können?
+ExamPublicStatisticsTip: Soll die automatisch berechnete statistische Auswertung auch den Teilnehmern angezeigt werden, sobald diese ihre Noten einsehen können?
+ExamAutomaticGrading: Automatische Notenberechnung
+ExamAutomaticGradingTip: Sollen die Gesamtleistungen der Teilnehmer automatisch aus den in den einzelnen Teilprüfungen erreichten Leistungen berechnet werden? Etwaige Bonuspunkte werden dabei berücksichtigt. Manuelles Überschreiben der Gesamtleistung ist dennoch möglich.
 ExamGradingRule: Notenberechnung
 ExamGradingManual': Keine automatische Berechnung
 ExamGradingKey': Nach Schlüssel
 ExamGradingKey: Notenschlüssel
-ExamGradingKeyTip: Die Grenzen beziehen sich auf die effektive Maximalpunktzahl, nachdem etwaige Bonuspunkte aus dem Übungsbetrieb angerechnet und die Ergebnise der Teilaufgaben mit ihrem Gewicht multipliziert wurden
+ExamGradingKeyTip: Die Grenzen beziehen sich auf die effektive Maximalpunktzahl, nachdem etwaige Bonuspunkte aus dem Übungsbetrieb angerechnet und die Ergebnise der Teilprüfungen mit ihrem Gewicht multipliziert wurden
 Points: Punkte
 PointsMustBeNonNegative: Punktegrenzen dürfen nicht negativ sein
 PointsMustBeMonotonic: Punktegrenzen müssen aufsteigend sein
 GradingFrom: Ab
 ExamNew: Neue Prüfung
+ExamBonus: Bonuspunkte-System
 ExamBonusRule: Prüfungsbonus aus Übungsbetrieb
 ExamNoBonus': Kein automatischer Bonus
 ExamBonusPoints': Umrechnung von Übungspunkten
@@ -1350,7 +1353,9 @@ ExamBonusMaxPoints: Maximal erreichbare Prüfungs-Bonuspunkte
 ExamBonusMaxPointsNonPositive: Maximaler Prüfungsbonus muss positiv und größer null sein
 ExamBonusOnlyPassed: Bonus nur nach Bestehen anrechnen
 
-ExamOccurrenceRule: Automatische Termin- bzw. Raumzuteilung
+ExamAutomaticOccurrenceAssignment: Automatische Termin- bzw. Raumzuteilung
+ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer zum Zeitpunkt der Bekanntgabe der Raum- bzw. Terminzuteilung automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
+ExamOccurrenceRule: Verfahren
 ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
 ExamRoomManual': Keine automatische Zuteilung
 ExamRoomSurname': Nach Nachname
@@ -1384,9 +1389,9 @@ ExamFormParts: Teile
 ExamCorrectors: Korrektoren
 ExamCorrectorAlreadyAdded: Ein Korrektor mit dieser E-Mail ist bereits für diese Prüfung eingetragen
 
-ExamParts: Teilaufgaben
+ExamParts: Teilprüfungen/Aufgaben
-ExamPartWeightNegative: Gewicht aller Teilaufgaben muss größer oder gleich Null sein
+ExamPartWeightNegative: Gewicht aller Teilprüfungen muss größer oder gleich Null sein
-ExamPartAlreadyExists: Teilaufgabe mit diesem Namen existiert bereits
+ExamPartAlreadyExists: Teilprüfunge mit diesem Namen existiert bereits
 ExamPartNumber: Nummer
 ExamPartNumberTip: Wird als interne Bezeichnung z.B. bei CSV-Export verwendet
 ExamPartName: Name
@@ -1524,7 +1529,7 @@ ExamUserCsvDeregister: Teilnehmer von der Prüfung abmelden
 ExamUserCsvSetCourseField: Kurs-assoziiertes Studienfach ändern
 ExamUserCsvOverrideResult: Ergebnis entgegen automatischer Notenberechnung überschreiben
 ExamUserCsvSetResult: Ergebnis eintragen
-ExamUserCsvSetPartResult: Ergebnis einer Teilaufgabe eintragen
+ExamUserCsvSetPartResult: Ergebnis einer Teilprüfung eintragen
 ExamUserCsvSetCourseNote: Teilnehmer-Notizen anpassen
 
 ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht

models/exams

@@ -1,9 +1,9 @@
 Exam
   course CourseId
   name ExamName
-  gradingRule ExamGradingRule
+  gradingRule ExamGradingRule Maybe
-  bonusRule ExamBonusRule
+  bonusRule ExamBonusRule Maybe
-  occurrenceRule ExamOccurrenceRule
+  occurrenceRule ExamOccurrenceRule Maybe
   visibleFrom UTCTime Maybe
   registerFrom UTCTime Maybe
   registerTo UTCTime Maybe

src/Handler/Exam/Form.hs

@@ -26,6 +26,7 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 data ExamForm = ExamForm
   { efName :: ExamName
   , efDescription :: Maybe Html
+  , efShowGrades :: Bool
   , efStart :: Maybe UTCTime
   , efEnd :: Maybe UTCTime
   , efVisibleFrom :: Maybe UTCTime
@@ -35,11 +36,10 @@ data ExamForm = ExamForm
   , efPublishOccurrenceAssignments :: Maybe UTCTime
   , efFinished :: Maybe UTCTime
   , efOccurrences :: Set ExamOccurrenceForm
-  , efShowGrades :: Bool
   , efPublicStatistics :: Bool
-  , efGradingRule :: ExamGradingRule
+  , efGradingRule :: Maybe ExamGradingRule
-  , efBonusRule :: ExamBonusRule
+  , efBonusRule :: Maybe ExamBonusRule
-  , efOccurrenceRule :: ExamOccurrenceRule
+  , efOccurrenceRule :: Maybe ExamOccurrenceRule
   , efCorrectors :: Set (Either UserEmail UserId)
   , efExamParts :: Set ExamPartForm
   }
@@ -80,6 +80,7 @@ examForm template html = do
   flip (renderAForm FormStandard) html $ ExamForm
     <$> areq ciField (fslpI MsgExamName (mr MsgExamName) & setTooltip MsgExamNameTip) (efName <$> template)
     <*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslpI MsgExamDescription "Html") (efDescription <$> template))
+    <*> apopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (efShowGrades <$> template <|> Just True)
     <*  aformSection MsgExamFormTimes
     <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template)
     <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip MsgExamTimeTip) (efEnd <$> template)
@@ -92,11 +93,10 @@ examForm template html = do
     <*  aformSection MsgExamFormOccurrences
     <*> examOccurrenceForm (efOccurrences <$> template)
     <*  aformSection MsgExamFormAutomaticFunctions
-    <*> apopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (efShowGrades <$> template <|> Just True)
     <*> apopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (efPublicStatistics <$> template <|> Just True)
-    <*> examGradingRuleForm (efGradingRule <$> template)
+    <*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template)
-    <*> examBonusRuleForm (efBonusRule <$> template)
+    <*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template)
-    <*> examOccurrenceRuleForm (efOccurrenceRule <$> template)
+    <*> optionalActionA (examOccurrenceRuleForm $ efOccurrenceRule =<< template) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) (is _Just . efOccurrenceRule <$> template)
     <*  aformSection MsgExamFormCorrection
     <*> examCorrectorsForm (efCorrectors <$> template)
     <*  aformSection MsgExamFormParts

src/Handler/Utils/Exam.hs

@@ -103,7 +103,7 @@ examGrade (Entity _ Exam{..}) bonusPossible bonusAchieved (otoList -> results)
 
     withBonus :: Points -> Points
     withBonus ps
-      | ExamBonusPoints{..} <- examBonusRule
+      | Just ExamBonusPoints{..} <- examBonusRule
       = if
           |    not bonusOnlyPassed
             || fmap (view passingGrade) (pointsToGrade ps) == Just (_Wrapped # True)
@@ -126,7 +126,7 @@ examGrade (Entity _ Exam{..}) bonusPossible bonusAchieved (otoList -> results)
     
     pointsToGrade :: Points -> Maybe ExamGrade
     pointsToGrade ps
-      | ExamGradingKey{..} <- examGradingRule
+      | Just ExamGradingKey{..} <- examGradingRule
       = Just $ gradeFromKey examGradingKey
       | otherwise
       = Nothing

src/Handler/Utils/Form.hs

@@ -518,8 +518,7 @@ submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ c
         )
       ]
 
-data ExamBonusRule' = ExamNoBonus'
+data ExamBonusRule' = ExamBonusPoints'
-                    | ExamBonusPoints'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Universe ExamBonusRule'
 instance Finite ExamBonusRule'
@@ -529,7 +528,6 @@ embedRenderMessage ''UniWorX ''ExamBonusRule' id
 
 classifyBonusRule :: ExamBonusRule -> ExamBonusRule'
 classifyBonusRule = \case
-  ExamNoBonus       -> ExamNoBonus'
   ExamBonusPoints{} -> ExamBonusPoints'
 
 examBonusRuleForm :: Maybe ExamBonusRule -> AForm Handler ExamBonusRule
@@ -537,18 +535,14 @@ examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classify
   where
     actions :: Map ExamBonusRule' (AForm Handler ExamBonusRule)
     actions = Map.fromList
-      [ ( ExamNoBonus'
+      [ ( ExamBonusPoints'
-        , pure ExamNoBonus
-        )
-      , ( ExamBonusPoints'
         , ExamBonusPoints
             <$> apreq (checkBool (> 0) MsgExamBonusMaxPointsNonPositive pointsField) (fslI MsgExamBonusMaxPoints) (preview _bonusMaxPoints =<< prev)
             <*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamBonusOnlyPassed) (Just <$> preview _bonusOnlyPassed =<< prev))
         )
       ]
 
-data ExamOccurrenceRule' = ExamRoomManual'
+data ExamOccurrenceRule' = ExamRoomSurname'
-                         | ExamRoomSurname'
                          | ExamRoomMatriculation'
                          | ExamRoomRandom'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
@@ -560,7 +554,6 @@ embedRenderMessage ''UniWorX ''ExamOccurrenceRule' id
 
 classifyExamOccurrenceRule :: ExamOccurrenceRule -> ExamOccurrenceRule'
 classifyExamOccurrenceRule = \case
-  ExamRoomManual        -> ExamRoomManual'
   ExamRoomSurname       -> ExamRoomSurname'
   ExamRoomMatriculation -> ExamRoomMatriculation'
   ExamRoomRandom        -> ExamRoomRandom'
@@ -569,13 +562,11 @@ examOccurrenceRuleForm :: Maybe ExamOccurrenceRule -> AForm Handler ExamOccurren
 examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamOccurrenceRule) . fmap classifyExamOccurrenceRule
   where
     reverseClassify = \case
-      ExamRoomManual'        -> ExamRoomManual
       ExamRoomSurname'       -> ExamRoomSurname
       ExamRoomMatriculation' -> ExamRoomMatriculation
       ExamRoomRandom'        -> ExamRoomRandom
 
-data ExamGradingRule' = ExamGradingManual'
+data ExamGradingRule' = ExamGradingKey'
-                      | ExamGradingKey'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Universe ExamGradingRule'
 instance Finite ExamGradingRule'
@@ -585,7 +576,6 @@ embedRenderMessage ''UniWorX ''ExamGradingRule' id
 
 classifyExamGradingRule :: ExamGradingRule -> ExamGradingRule'
 classifyExamGradingRule = \case
-  ExamGradingManual -> ExamGradingManual'
   ExamGradingKey{}  -> ExamGradingKey'
 
 examGradingRuleForm :: Maybe ExamGradingRule -> AForm Handler ExamGradingRule
@@ -593,10 +583,7 @@ examGradingRuleForm prev = multiActionA actions (fslI MsgExamGradingRule) $ clas
   where
     actions :: Map ExamGradingRule' (AForm Handler ExamGradingRule)
     actions = Map.fromList
-      [ ( ExamGradingManual'
+      [ ( ExamGradingKey'
-        , pure ExamGradingManual
-        )
-      , ( ExamGradingKey'
         , ExamGradingKey <$> gradingKeyForm (fslI MsgExamGradingKey & setTooltip MsgExamGradingKeyTip) (preview _examGradingKey =<< prev)
         )
       ]

src/Model/Migration.hs

@@ -523,6 +523,20 @@ customMigrations = Map.fromListWith (>>)
             renameExamParts _ = return ()
         runConduit $ getExamEntries .| C.mapM_ renameExamParts
     )
+  , ( AppliedMigrationKey [migrationVersion|21.0.0|] [version|22.0.0|]
+    , whenM (tableExists "exam") $
+        [executeQQ|
+          ALTER TABLE "exam" ALTER COLUMN "grading_rule" DROP NOT NULL;
+          ALTER TABLE "exam" ALTER COLUMN "bonus_rule" DROP NOT NULL;
+          ALTER TABLE "exam" ALTER COLUMN "occurrence_rule" DROP NOT NULL;
+
+          UPDATE "exam" SET "grading_rule" = NULL WHERE "grading_rule" = '{ "rule": "manual" }';
+          UPDATE "exam" SET "bonus_rule" = NULL WHERE "bonus_rule" = '{ "rule": "no-bonus"}';
+          UPDATE "exam" SET "occurrence_rule" = NULL WHERE "occurrence_rule" = '"manual"';
+
+          UPDATE "exam" SET "occurrence_rule" = json_build_object('rule', "occurrence_rule");
+        |]
+    )
   ]
 
 

src/Model/Types/Exam.hs

@@ -116,28 +116,32 @@ instance Universe res => Universe (ExamResult' res) where
 instance Finite res => Finite (ExamResult' res)
 
 
-data ExamBonusRule = ExamNoBonus
+data ExamBonusRule = ExamBonusPoints
-                   | ExamBonusPoints
                      { bonusMaxPoints :: Points
                      , bonusOnlyPassed :: Bool
                      }
   deriving (Show, Read, Eq, Ord, Generic, Typeable)
 deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1
+  { fieldLabelModifier = camelToPathPiece' 1
-  , fieldLabelModifier = camelToPathPiece' 1
+  , constructorTagModifier = camelToPathPiece' 1
+  , allNullaryToStringTag = False
   , sumEncoding = TaggedObject "rule" "settings"
+  , unwrapUnaryRecords = False
+  , tagSingleConstructors = True
   } ''ExamBonusRule
 derivePersistFieldJSON ''ExamBonusRule
 
-data ExamOccurrenceRule = ExamRoomManual
+data ExamOccurrenceRule = ExamRoomSurname
-                        | ExamRoomSurname
                         | ExamRoomMatriculation
                         | ExamRoomRandom
   deriving (Show, Read, Eq, Ord, Generic, Typeable)
 deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 2
+  { fieldLabelModifier = camelToPathPiece' 1
-  , fieldLabelModifier = camelToPathPiece' 1
+  , constructorTagModifier = camelToPathPiece' 2
+  , allNullaryToStringTag = False
   , sumEncoding = TaggedObject "rule" "settings"
+  , unwrapUnaryRecords = False
+  , tagSingleConstructors = True
   } ''ExamOccurrenceRule
 derivePersistFieldJSON ''ExamOccurrenceRule
 
@@ -211,15 +215,17 @@ instance PersistFieldSql ExamGrade where
 
 
 data ExamGradingRule
-  = ExamGradingManual
+  = ExamGradingKey
-  | ExamGradingKey
     { examGradingKey :: [Points] -- ^ @[n1, n2, n3, ..., n11]@ means @0 <= p < n1 -> p ~= 5@, @n1 <= p < n2 -> p ~ 4@, @n2 <= p < n3 -> p ~ 3.7@, ..., @n10 <= p -> p ~ 1.0@
     }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 deriveJSON defaultOptions
-  { constructorTagModifier = camelToPathPiece' 2
+  { fieldLabelModifier = camelToPathPiece' 2
-  , fieldLabelModifier = camelToPathPiece' 2
+  , constructorTagModifier = camelToPathPiece' 2
+  , allNullaryToStringTag = False
   , sumEncoding = TaggedObject "rule" "settings"
+  , unwrapUnaryRecords = False
+  , tagSingleConstructors = True
   } ''ExamGradingRule
 derivePersistFieldJSON ''ExamGradingRule
 

templates/exam-show.hamlet

@@ -59,31 +59,30 @@ $maybe desc <- examDescription
       <dt .deflist__dt>_{MsgExamClosed}
       <dd .deflist__dd>^{formatTimeW SelFormatDateTime closed}
     $if gradingShown
-      $if examGradingRule /= ExamGradingManual
+      $maybe gradingRule <- examGradingRule
         <dt .deflist__dt>
           _{MsgExamGradingRule}
           $if not gradingVisible
             \ ^{isVisible False}
         <dd .deflist__dd>
-          $case examGradingRule
+          $case gradingRule
-            $of ExamGradingManual
-              _{MsgExamGradingManual'}
             $of ExamGradingKey{..}
               ^{gradingKeyW examGradingKey}
-      $if examBonusRule /= ExamNoBonus
+      $maybe bonusRule <- examBonusRule
         <dt .deflist__dt>
           _{MsgExamBonusRule}
           $if not gradingVisible
             \ ^{isVisible False}
         <dd .deflist__dd>
-          ^{examBonusW examBonusRule}
+          ^{examBonusW bonusRule}
-    $if occurrenceAssignmentsShown
+    $maybe occurrenceRule <- examOccurrenceRule
-      <dt .deflist__dt>
+      $if occurrenceAssignmentsShown
-        _{MsgExamOccurrenceRuleParticipant}
+        <dt .deflist__dt>
-        $if not occurrenceAssignmentsVisible
+          _{MsgExamOccurrenceRuleParticipant}
-          \ ^{isVisible False}
+          $if not occurrenceAssignmentsVisible
-      <dd .deflist__dd>
+            \ ^{isVisible False}
-        _{classifyExamOccurrenceRule examOccurrenceRule}
+        <dd .deflist__dd>
+          _{classifyExamOccurrenceRule occurrenceRule}
     $maybe registerWdgt <- registerWidget
       <dt .deflist__dt>_{MsgExamRegistration}
       <dd .deflist__dd>^{registerWdgt}

templates/widgets/bonusRule.hamlet

@@ -1,7 +1,5 @@
 $newline never
 $case bonusRule
-  $of ExamNoBonus
-    _{MsgExamNoBonus'}
   $of ExamBonusPoints ps False
     _{MsgExamBonusPoints ps}
   $of ExamBonusPoints ps True

test/Database.hs

@@ -467,6 +467,31 @@ fillDb = do
     ,(tinaTester, Just sfTTc)
     ]
 
+  examFFP <- insert' $ Exam
+    { examCourse = ffp
+    , examName = "Klausur"
+    , examGradingRule = Nothing
+    , examBonusRule = Nothing
+    , examOccurrenceRule = Nothing
+    , examVisibleFrom = Just now
+    , examRegisterFrom = Just now
+    , examRegisterTo = Just $ addUTCTime (14 * nominalDay) now
+    , examDeregisterUntil = Just $ addUTCTime (15 * nominalDay) now
+    , examPublishOccurrenceAssignments = Just $ addUTCTime (15 * nominalDay) now
+    , examStart = Just $ addUTCTime (16 * nominalDay) now
+    , examEnd = Just $ addUTCTime (17 * nominalDay) now
+    , examFinished = Just $ addUTCTime (21 * nominalDay) now
+    , examClosed = Nothing
+    , examPublicStatistics = True
+    , examShowGrades = True
+    , examDescription = Nothing
+    }
+  void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now)
+    [ fhamann
+    , maxMuster
+    , tinaTester
+    ]
+
   -- EIP
   eip <- insert' Course
     { courseName = "Einführung in die Programmierung"