diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 9e433582a..7a9622a87 100644 --- a/messages/uniworx/de.msg +++ b/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 -ExamPartWeightNegative: Gewicht aller Teilaufgaben muss größer oder gleich Null sein -ExamPartAlreadyExists: Teilaufgabe mit diesem Namen existiert bereits +ExamParts: Teilprüfungen/Aufgaben +ExamPartWeightNegative: Gewicht aller Teilprüfungen muss größer oder gleich Null sein +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 diff --git a/models/exams b/models/exams index bcd6703c8..22c34cc5b 100644 --- a/models/exams +++ b/models/exams @@ -1,9 +1,9 @@ Exam course CourseId name ExamName - gradingRule ExamGradingRule - bonusRule ExamBonusRule - occurrenceRule ExamOccurrenceRule + gradingRule ExamGradingRule Maybe + bonusRule ExamBonusRule Maybe + occurrenceRule ExamOccurrenceRule Maybe visibleFrom UTCTime Maybe registerFrom UTCTime Maybe registerTo UTCTime Maybe diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 38213c7ed..ba1e2af6a 100644 --- a/src/Handler/Exam/Form.hs +++ b/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 - , efBonusRule :: ExamBonusRule - , efOccurrenceRule :: ExamOccurrenceRule + , efGradingRule :: Maybe ExamGradingRule + , efBonusRule :: Maybe ExamBonusRule + , 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) - <*> examBonusRuleForm (efBonusRule <$> template) - <*> examOccurrenceRuleForm (efOccurrenceRule <$> template) + <*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template) + <*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template) + <*> optionalActionA (examOccurrenceRuleForm $ efOccurrenceRule =<< template) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) (is _Just . efOccurrenceRule <$> template) <* aformSection MsgExamFormCorrection <*> examCorrectorsForm (efCorrectors <$> template) <* aformSection MsgExamFormParts diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 11d1fb446..dae79f3eb 100644 --- a/src/Handler/Utils/Exam.hs +++ b/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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 20d04f535..ab8ede956 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -518,8 +518,7 @@ submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ c ) ] -data ExamBonusRule' = ExamNoBonus' - | ExamBonusPoints' +data ExamBonusRule' = 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' - , pure ExamNoBonus - ) - , ( ExamBonusPoints' + [ ( 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' - | ExamRoomSurname' +data ExamOccurrenceRule' = 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' - | ExamGradingKey' +data ExamGradingRule' = 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' - , pure ExamGradingManual - ) - , ( ExamGradingKey' + [ ( ExamGradingKey' , ExamGradingKey <$> gradingKeyForm (fslI MsgExamGradingKey & setTooltip MsgExamGradingKeyTip) (preview _examGradingKey =<< prev) ) ] diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index eab6af88a..f0f190a79 100644 --- a/src/Model/Migration.hs +++ b/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"); + |] + ) ] diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs index fc92e3f58..be8e0bf95 100644 --- a/src/Model/Types/Exam.hs +++ b/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 - | ExamBonusPoints +data ExamBonusRule = 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 - | ExamRoomSurname +data ExamOccurrenceRule = 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 diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index 07d6b0c40..f10bdd908 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -59,31 +59,30 @@ $maybe desc <- examDescription
_{MsgExamClosed}
^{formatTimeW SelFormatDateTime closed} $if gradingShown - $if examGradingRule /= ExamGradingManual + $maybe gradingRule <- examGradingRule
_{MsgExamGradingRule} $if not gradingVisible \ ^{isVisible False}
- $case examGradingRule - $of ExamGradingManual - _{MsgExamGradingManual'} + $case gradingRule $of ExamGradingKey{..} ^{gradingKeyW examGradingKey} - $if examBonusRule /= ExamNoBonus + $maybe bonusRule <- examBonusRule
_{MsgExamBonusRule} $if not gradingVisible \ ^{isVisible False}
- ^{examBonusW examBonusRule} - $if occurrenceAssignmentsShown -
- _{MsgExamOccurrenceRuleParticipant} - $if not occurrenceAssignmentsVisible - \ ^{isVisible False} -
- _{classifyExamOccurrenceRule examOccurrenceRule} + ^{examBonusW bonusRule} + $maybe occurrenceRule <- examOccurrenceRule + $if occurrenceAssignmentsShown +
+ _{MsgExamOccurrenceRuleParticipant} + $if not occurrenceAssignmentsVisible + \ ^{isVisible False} +
+ _{classifyExamOccurrenceRule occurrenceRule} $maybe registerWdgt <- registerWidget
_{MsgExamRegistration}
^{registerWdgt} diff --git a/templates/widgets/bonusRule.hamlet b/templates/widgets/bonusRule.hamlet index bf72b1684..9c010d735 100644 --- a/templates/widgets/bonusRule.hamlet +++ b/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 diff --git a/test/Database.hs b/test/Database.hs index 280bcead3..312dcbbe0 100755 --- a/test/Database.hs +++ b/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"