diff --git a/frontend/src/utils/exam-correct/exam-correct.js b/frontend/src/utils/exam-correct/exam-correct.js index 3daab9761..80b0592d7 100644 --- a/frontend/src/utils/exam-correct/exam-correct.js +++ b/frontend/src/utils/exam-correct/exam-correct.js @@ -49,6 +49,7 @@ export class ExamCorrect { _partInputs; _resultSelect; _resultGradeSelect; + _resultPassSelect; _partDeleteBoxes; _dateFormat; @@ -80,8 +81,9 @@ export class ExamCorrect { this._partInputs = [...this._element.querySelectorAll(`input[${EXAM_CORRECT_PART_INPUT_ATTR}]`)]; const resultCell = document.getElementById('uw-exam-correct__result'); this._resultSelect = resultCell && resultCell.querySelector('select'); - const resultGradeCell = document.getElementById('uw-exam-correct__result__grade'); - this._resultGradeSelect = resultGradeCell && resultGradeCell.querySelector('select'); + const resultDetailCell = document.getElementById('uw-exam-correct__result__pass-grade'); + this._resultGradeSelect = resultDetailCell && resultDetailCell.querySelector('select.uw-exam-correct__grade'); + this._resultPassSelect = resultDetailCell && resultDetailCell.querySelector('select.uw-exam-correct__pass'); this._partDeleteBoxes = [...this._element.querySelectorAll('input.uw-exam-correct--delete-exam-part')]; if (this._sendBtn) @@ -118,15 +120,26 @@ export class ExamCorrect { if (this._resultSelect && this._resultGradeSelect) { this._resultSelect.addEventListener('change', () => { - if (this._resultSelect.value !== 'attended') + if (this._resultSelect.value !== 'grade') this._resultGradeSelect.classList.add('grade-hidden'); else this._resultGradeSelect.classList.remove('grade-hidden'); }); - if (this._resultSelect.value !== 'attended') + if (this._resultSelect.value !== 'grade') this._resultGradeSelect.classList.add('grade-hidden'); } + if (this._resultSelect && this._resultPassSelect) { + this._resultSelect.addEventListener('change', () => { + if (this._resultSelect.value !== 'pass') + this._resultPassSelect.classList.add('pass-hidden'); + else + this._resultPassSelect.classList.remove('pass-hidden'); + }); + + if (this._resultSelect.value !== 'pass') + this._resultPassSelect.classList.add('pass-hidden'); + } this._lastColumnIndex = this._element.querySelector('thead > tr').querySelectorAll('th').length - 1; @@ -247,12 +260,11 @@ export class ExamCorrect { case 'delete': result = null; break; - case 'passed': - case 'failed': - result = { status: 'attended', result: { Left: this._resultSelect.value } }; + case 'pass': + result = { status: 'attended', result: this._resultPassSelect.value }; break; - case 'attended': - result = { status: 'attended', result: { Right: this._resultGradeSelect.value } }; + case 'grade': + result = { status: 'attended', result: this._resultGradeSelect.value }; break; default: result = { status: this._resultSelect.value }; @@ -457,7 +469,7 @@ export class ExamCorrect { if (examResult) { if (examResult.status === 'attended') - html = examResult.result.Left || examResult.result.Right; + html = examResult.result; else html = examResult.status; } else if (examResult === null) { diff --git a/frontend/src/utils/exam-correct/exam-correct.sass b/frontend/src/utils/exam-correct/exam-correct.sass index 2c036782a..fece765a1 100644 --- a/frontend/src/utils/exam-correct/exam-correct.sass +++ b/frontend/src/utils/exam-correct/exam-correct.sass @@ -40,7 +40,7 @@ table[uw-exam-correct] option width: max-content min-width: max-content - td#uw-exam-correct__result__grade + td#uw-exam-correct__result__pass-grade width: min-content select width: max-content @@ -49,8 +49,9 @@ table[uw-exam-correct] width: max-content min-width: max-content - td#uw-exam-correct__result__grade select.grade-hidden - visibility: hidden + td#uw-exam-correct__result__pass-grade + select.grade-hidden, select.pass-hidden + visibility: hidden td.exam-correct--status-cell font-size: .9rem font-weight: 600 diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 40c5fafd4..7217199b2 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1564,8 +1564,8 @@ ExamFinishedParticipant: Bewertung voraussichtlich abgeschlossen ExamFinishedTip: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern gemeldet werden ExamClosed: Noten gemeldet ExamClosedTip: Prüfungsbeauftraget, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert -ExamShowGrades: Klausur ist benotet -ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsbeauftragte nur informiert werden, ob die Klausur bestanden wurde? +ExamGradingMode: Bewertungsmodus +ExamGradingModeTip: In welcher Form werden Prüfungsleistungen für diese Prüfung eingetragen? ExamPublicStatistics: Statistik veröffentlichen ExamPublicStatisticsTip: Soll die automatisch berechnete statistische Auswertung auch den Teilnehmern angezeigt werden, sobald diese ihre Noten einsehen können? ExamAutomaticGrading: Automatische Notenberechnung @@ -1834,6 +1834,7 @@ ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden +ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode@ExamGradingMode actualGradingMode@ExamGradingMode: Es wurde versucht eine Prüfungsleistung einzutragen, die zwar vom System interpretiert werden konnte, aber nicht dem für diese Prüfung erwarteten Format entspricht. Das erwartete Format kann unter "Prüfung bearbeiten" angepasst werden ("Bestanden/Nicht Bestanden", "Numerische Noten" oder "Gemischt"). ExternalExamUserCsvRegister: Prüfungsleistung hinterlegen ExternalExamUserCsvSetTime: Zeitpunkt anpassen @@ -1854,6 +1855,8 @@ TableHeadingCsvImport: CSV-Import TableHeadingCsvExport: CSV-Export ExamResultAttended: Teilgenommen +ExamResultGrade: Note +ExamResultPass: Bestanden/Nicht Bestanden ExamResultNoShow: Nicht erschienen ExamResultVoided: Entwertet ExamResultNone: Kein Prüfungsergebnis @@ -2295,8 +2298,6 @@ ExternalExamExamNamePlaceholder: Klausur, Nachklausur, Projektabnahme, ... ExternalExamDefaultTime: Voreingestellter Zeitpunkt ExternalExamDefaultTimePlaceholder: Zeitpunkt ExternalExamDefaultTimeTip: Der Zeitpunkt zu dem die Prüfung abgelegt wurde, muss pro Teilnehmer festgelegt werden. Der hier angegebene Zeitpunkt wird als Standardwert für Teilnehmer verwendet, bei denen später nicht ein abweichender Zeitpunkt angegeben wird. -ExternalExamShowGrades: Klausur ist benotet -ExternalExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsbeauftragte nur informiert werden, ob die Klausur bestanden wurde? ExternalExamExamOfficeSchools: Zusätzliche Institute ExternalExamExamOfficeSchoolsTip: Prüfungsbeauftragte von Instituten, die Sie hier angeben, erhalten im System (zusätzlich zum angegebenen primären Institut) volle Einsicht in sämtliche für diese Prüfung hinterlegten Leistungen, unabhängig von den Studiendaten der Teilnehmer. ExternalExamStaff: Assoziierte Personen @@ -2322,4 +2323,8 @@ ExamRoomMappingSurname: Nachnamen beginnend mit ExamRoomMappingMatriculation: Matrikelnummern endend in ExamRoomLoad: Auslastung -NoFilter: Keine Einschränkung \ No newline at end of file +NoFilter: Keine Einschränkung + +ExamGradingPass: Bestanden/Nicht Bestanden +ExamGradingGrades: Numerische Noten +ExamGradingMixed: Gemischt \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 9005224b0..6a0dbccfb 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1563,8 +1563,6 @@ ExamFinishedParticipant: Marking expected to be finished ExamFinishedTip: At this participants are informed of their exam achievements ExamClosed: Exam achievements registered ExamClosedTip: At this time exam offices, which pull exam achievements from Uni2work, are informed. Changes to exam achievements trigger further notifications -ExamShowGrades: Exam is graded -ExamShowGradesTip: Should participants and relevant exam offices be show exact grades or only whether the exam was passed or failed? ExamPublicStatistics: Publish statistics ExamPublicStatisticsTip: Should automatically computed statistics also be shown to participants as soon as they are informed of their achievements? ExamAutomaticGrading: Automatically compute grades @@ -2288,8 +2286,6 @@ ExternalExamExamNamePlaceholder: Exam, Exam resit, Project discussion, ... ExternalExamDefaultTime: Default time ExternalExamDefaultTimePlaceholder: Time ExternalExamDefaultTimeTip: The time of the exam needs to be specified for each participant. The time entered here is used as a default value for participants for whom no different time is later specified. -ExternalExamShowGrades: Exam is graded -ExternalExamShowGradesTip: Should participants and relevant exam offices be show exact grades or only whether the exam was passed or failed? ExternalExamExamOfficeSchools: Additional departments ExternalExamExamOfficeSchoolsTip: Exam offices of departments you specify here will also have full access to all results for this exam disregarding the individual participants' features of study. ExternalExamStaff: Associated persons diff --git a/models/exams.model b/models/exams.model index 632f49a84..d89914768 100644 --- a/models/exams.model +++ b/models/exams.model @@ -15,7 +15,7 @@ Exam finished UTCTime Maybe -- Grades shown to students, `ExamCorrector`s locked out closed UTCTime Maybe -- Prüfungsamt hat Einsicht (notification) publicStatistics Bool - showGrades Bool + gradingMode ExamGradingMode description Html Maybe UniqueExam course name ExamPart diff --git a/models/external-exams.model b/models/external-exams.model index 18b584d5b..945284399 100644 --- a/models/external-exams.model +++ b/models/external-exams.model @@ -4,7 +4,7 @@ ExternalExam courseName (CI Text) examName (CI Text) defaultTime UTCTime Maybe - showGrades Bool + gradingMode ExamGradingMode UniqueExternalExam term school courseName examName ExternalExamResult user UserId diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 028be1e3a..df110ddbb 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -195,6 +195,7 @@ embedRenderMessage ''UniWorX ''CsvPreset id embedRenderMessage ''UniWorX ''Quoting ("Csv" <>) embedRenderMessage ''UniWorX ''FavouriteReason id embedRenderMessage ''UniWorX ''Sex id +embedRenderMessage ''UniWorX ''ExamGradingMode id embedRenderMessage ''UniWorX ''AuthenticationMode id diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index ae40a86c3..e284edc76 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -46,7 +46,7 @@ postEEditR tid ssh csh examn = do , examFinished = efFinished , examClosed = examClosed oldExam , examPublicStatistics = efPublicStatistics - , examShowGrades = efShowGrades + , examGradingMode = efGradingMode , examDescription = efDescription } diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1560e128e..57eae65f1 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -26,7 +26,7 @@ import Text.Blaze.Html.Renderer.String (renderHtml) data ExamForm = ExamForm { efName :: ExamName , efDescription :: Maybe Html - , efShowGrades :: Bool + , efGradingMode :: ExamGradingMode , efStart :: Maybe UTCTime , efEnd :: Maybe UTCTime , efVisibleFrom :: Maybe UTCTime @@ -80,7 +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) + <*> apopt (selectField optionsFinite) (fslI MsgExamGradingMode & setTooltip MsgExamGradingModeTip) (efGradingMode <$> template <|> Just ExamGradingMixed) <* aformSection MsgExamFormTimes <*> aopt utcTimeField (fslpI MsgExamStart (mr MsgDate) & setTooltip MsgExamTimeTip) (efStart <$> template) <*> aopt utcTimeField (fslpI MsgExamEnd (mr MsgDate) & setTooltip MsgExamTimeTip) (efEnd <$> template) @@ -253,7 +253,7 @@ examFormTemplate (Entity eId Exam{..}) = do , efStart = examStart , efEnd = examEnd , efFinished = examFinished - , efShowGrades = examShowGrades + , efGradingMode = examGradingMode , efPublicStatistics = examPublicStatistics , efDescription = examDescription , efOccurrences = Set.fromList $ do @@ -321,7 +321,7 @@ examTemplate cid = runMaybeT $ do , efStart = dateOffset <$> examStart oldExam , efEnd = dateOffset <$> examEnd oldExam , efFinished = dateOffset <$> examFinished oldExam - , efShowGrades = examShowGrades oldExam + , efGradingMode = examGradingMode oldExam , efPublicStatistics = examPublicStatistics oldExam , efDescription = examDescription oldExam , efOccurrences = Set.empty diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs index 7cbfdb32d..3614dd0e0 100644 --- a/src/Handler/Exam/New.hs +++ b/src/Handler/Exam/New.hs @@ -42,7 +42,7 @@ postCExamNewR tid ssh csh = do , examEnd = efEnd , examFinished = efFinished , examClosed = Nothing - , examShowGrades = efShowGrades + , examGradingMode = efGradingMode , examPublicStatistics = efPublicStatistics , examDescription = efDescription } diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 54d1a1e1e..c99867bc7 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -172,7 +172,7 @@ resultAutomaticExamResult exam@Exam{..} examBonus' = folding . runReader $ do parts' <- asks $ sequence . toListOf (resultExamPartResults . to (^? _Just . _entityVal . _examPartResultResult)) bonus <- preview $ resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus exam examBonus' let gradeRes = examGrade exam bonus =<< parts' - return $ fmap (bool (Left . view passingGrade) Right examShowGrades) <$> gradeRes + return $ fmap (bool Right (Left . view passingGrade) $ is _ExamGradingPass examGradingMode) <$> gradeRes csvExamPartHeader :: Prism' Csv.Name ExamPartNumber @@ -391,6 +391,7 @@ data ExamUserCsvException = ExamUserCsvExceptionNoMatchingUser | ExamUserCsvExceptionNoMatchingStudyFeatures | ExamUserCsvExceptionNoMatchingOccurrence + | ExamUserCsvExceptionMismatchedGradingMode ExamGradingMode ExamGradingMode deriving (Show, Generic, Typeable) instance Exception ExamUserCsvException @@ -587,7 +588,7 @@ postEUsersR tid ssh csh examn = do <$> aopt pointsField (fslI MsgPoints) Nothing , singletonMap ExamUserSetResult $ ExamUserSetResultData - <$> aopt (examResultField (Just $ SomeMessage MsgExamResultNone) examPassedGradeField) (fslI MsgExamResult) Nothing + <$> aopt (examResultModeField (Just $ SomeMessage MsgExamResultNone) examGradingMode) (fslI MsgExamResult) Nothing ] actionOpts :: Handler (OptionList ExamUserAction) @@ -663,8 +664,9 @@ postEUsersR tid ssh csh examn = do when (doBonus && is _Just (join $ csvEUserBonus dbCsvNew)) $ yield . ExamUserCsvSetBonusData False uid . join $ csvEUserBonus dbCsvNew - when (is _Just $ csvEUserExamResult dbCsvNew) $ + whenIsJust (csvEUserExamResult dbCsvNew) $ \res -> do yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew + guardResultKind res note <- lift . getBy $ UniqueCourseUserNote uid examCourse when (csvEUserCourseNote dbCsvNew /= note ^? _Just . _entityVal . _courseUserNoteNote) $ @@ -696,7 +698,7 @@ postEUsersR tid ssh csh examn = do oldBonus = dbCsvOld ^? (resultExamBonus . _entityVal . _examBonusBonus <> resultAutomaticExamBonus') newResult, oldResult :: Maybe ExamResultPassedGrade - newResult = fmap (fmap $ bool (Left . view passingGrade) Right examShowGrades) . examGrade examVal (newBonus <|> oldBonus) =<< newResults + newResult = fmap (fmap $ bool Right (Left . view passingGrade) $ is _ExamGradingGrades examGradingMode) . examGrade examVal (newBonus <|> oldBonus) =<< newResults oldResult = dbCsvOld ^? (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult') when doBonus $ @@ -717,13 +719,16 @@ postEUsersR tid ssh csh examn = do -> return () _ | is _Nothing $ csvEUserExamResult dbCsvNew -> return () - Nothing - -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew + Nothing -> do + yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew + whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind Just _ - | csvEUserExamResult dbCsvNew /= newResult - -> yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew - | oldResult /= newResult - -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew + | csvEUserExamResult dbCsvNew /= newResult -> do + yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew + whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind + | oldResult /= newResult -> do + yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew + whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind | otherwise -> return () @@ -938,6 +943,19 @@ postEUsersR tid ssh csh examn = do , dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text } where + guardResultKind :: MonadThrow m => ExamResultPassedGrade -> m () + guardResultKind res + | ( is _ExamGradingPass examGradingMode + && is (_ExamAttended . _Right) res + ) || + ( is _ExamGradingGrades examGradingMode + && is (_ExamAttended . _Left) res + ) + = throwM . ExamUserCsvExceptionMismatchedGradingMode examGradingMode $ if + | is (_ExamAttended . _Left) res -> ExamGradingPass + | otherwise -> ExamGradingGrades + | otherwise = return () + registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname where diff --git a/src/Handler/ExternalExam/Edit.hs b/src/Handler/ExternalExam/Edit.hs index 76a58dc90..6240fd6b5 100644 --- a/src/Handler/ExternalExam/Edit.hs +++ b/src/Handler/ExternalExam/Edit.hs @@ -35,7 +35,7 @@ postEEEditR tid ssh coursen examn = do , eefCourseName = coursen , eefExamName = examn , eefDefaultTime = externalExamDefaultTime - , eefShowGrades = externalExamShowGrades + , eefGradingMode = externalExamGradingMode , eefOfficeSchools = schools , eefStaff = staff } @@ -50,7 +50,7 @@ postEEEditR tid ssh coursen examn = do , externalExamCourseName = eefCourseName , externalExamExamName = eefExamName , externalExamDefaultTime = eefDefaultTime - , externalExamShowGrades = eefShowGrades + , externalExamGradingMode = eefGradingMode } when (is _Nothing replaceRes) $ do audit $ TransactionExternalExamEdit eeId diff --git a/src/Handler/ExternalExam/Form.hs b/src/Handler/ExternalExam/Form.hs index a8c5d5c18..787eb32dd 100644 --- a/src/Handler/ExternalExam/Form.hs +++ b/src/Handler/ExternalExam/Form.hs @@ -20,7 +20,7 @@ data ExternalExamForm = ExternalExamForm , eefCourseName :: CI Text , eefExamName :: CI Text , eefDefaultTime :: Maybe UTCTime - , eefShowGrades :: Bool + , eefGradingMode :: ExamGradingMode , eefOfficeSchools :: Set SchoolId , eefStaff :: Set (Either UserEmail UserId) } @@ -51,7 +51,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do <*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamCourseName & setTooltip MsgExternalExamCourseNameTip & addPlaceholder (mr MsgExternalExamCourseNamePlaceholder)) (eefCourseName <$> template) <*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamExamName & setTooltip MsgExternalExamExamNameTip & addPlaceholder (mr MsgExternalExamExamNamePlaceholder)) (eefExamName <$> template) <*> aopt utcTimeField (fslI MsgExternalExamDefaultTime & setTooltip MsgExternalExamDefaultTimeTip & addPlaceholder (mr MsgExternalExamDefaultTimePlaceholder)) (eefDefaultTime <$> template) - <*> apopt checkBoxField (fslI MsgExternalExamShowGrades & setTooltip MsgExternalExamShowGradesTip) (eefShowGrades <$> template) + <*> apopt (selectField optionsFinite) (fslI MsgExamGradingMode & setTooltip MsgExamGradingModeTip) (eefGradingMode <$> template <|> Just ExamGradingMixed) <*> (Set.fromList <$> officeSchoolForm cRoute (Set.toList . eefOfficeSchools <$> template)) <*> (Set.fromList <$> staffForm cRoute ((Set.toList . eefStaff <$> template) <|> pure (pure $ Right uid))) where diff --git a/src/Handler/ExternalExam/New.hs b/src/Handler/ExternalExam/New.hs index 36a8cf6ed..fb89f6418 100644 --- a/src/Handler/ExternalExam/New.hs +++ b/src/Handler/ExternalExam/New.hs @@ -28,7 +28,7 @@ postEExamNewR = do , externalExamCourseName = eefCourseName , externalExamExamName = eefExamName , externalExamDefaultTime = eefDefaultTime - , externalExamShowGrades = eefShowGrades + , externalExamGradingMode = eefGradingMode } whenIsJust insertRes $ \eeId -> do audit $ TransactionExternalExamEdit eeId diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 63a8245aa..55565fc65 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1230,21 +1230,30 @@ examResultField :: forall m res. , HandlerSite m ~ UniWorX , PathPiece res ) - => Maybe (SomeMessage UniWorX) -> Field m res -> Field m (ExamResult' res) -examResultField optMsg innerField = Field - { fieldEnctype = UrlEncoded <> fieldEnctype innerField - , fieldParse = \ts fs -> if - | res : _ <- mapMaybe (assertM ((||) <$> is _ExamNoShow <*> is _ExamVoided) . fromPathPiece) ts - -> return . Right $ Just res - | null ts || any null ts - -> return $ Right Nothing - | otherwise - -> fmap (fmap ExamAttended) <$> fieldParse innerField (filter (not . (`elem` ["", "attended", "no-show", "voided"])) ts) fs + => Maybe (SomeMessage UniWorX) -> Handler (OptionList (Either Text res -> Bool, Field m res)) -> Field m (ExamResult' res) +examResultField optMsg mkOl = Field + { fieldEnctype = UrlEncoded -- breaks if mkOl contains options with other enctype + , fieldParse = \ts fs -> do + ol@OptionList{..} <- liftHandler mkOl + if + | res : _ <- mapMaybe (assertM ((||) <$> is _ExamNoShow <*> is _ExamVoided) . fromPathPiece) ts + -> return . Right $ Just res + | any null ts + -> return $ Right Nothing + | (optPred, innerField) : _ <- mapMaybe olReadExternal ts + -> fmap (fmap ExamAttended) <$> fieldParse innerField (filter (`notElem` outerOptions ol) $ filter (optPred . Left) ts) fs + | [] <- ts + -> return $ Right Nothing + | t : _ <- ts + -> return . Left . SomeMessage $ MsgInvalidEntry t , fieldView = \theId name attrs val isReq -> do innerId <- newIdent + OptionList{..} <- liftHandler mkOl let innerVal :: Either Text res innerVal = val >>= maybe (Left "") return . preview _ExamAttended + + matchesPred Option{ optionInternalValue = (optPred, _) } = has (_Right . _ExamAttended . filtered (optPred . Right)) val [whamlet| $newline never
@@ -1252,13 +1261,107 @@ examResultField optMsg innerField = Field $maybe optMsg' <- guardOnM (not isReq) optMsg