feat(exams): allow mixed ExamGradingMode
This commit is contained in:
Gregor Kleen
parent
0e49bc14e5
commit
acffe04350
@ -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) {
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
NoFilter: Keine Einschränkung
|
||||
|
||||
ExamGradingPass: Bestanden/Nicht Bestanden
|
||||
ExamGradingGrades: Numerische Noten
|
||||
ExamGradingMixed: Gemischt
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -46,7 +46,7 @@ postEEditR tid ssh csh examn = do
|
||||
, examFinished = efFinished
|
||||
, examClosed = examClosed oldExam
|
||||
, examPublicStatistics = efPublicStatistics
|
||||
, examShowGrades = efShowGrades
|
||||
, examGradingMode = efGradingMode
|
||||
, examDescription = efDescription
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -42,7 +42,7 @@ postCExamNewR tid ssh csh = do
|
||||
, examEnd = efEnd
|
||||
, examFinished = efFinished
|
||||
, examClosed = Nothing
|
||||
, examShowGrades = efShowGrades
|
||||
, examGradingMode = efGradingMode
|
||||
, examPublicStatistics = efPublicStatistics
|
||||
, examDescription = efDescription
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -28,7 +28,7 @@ postEExamNewR = do
|
||||
, externalExamCourseName = eefCourseName
|
||||
, externalExamExamName = eefExamName
|
||||
, externalExamDefaultTime = eefDefaultTime
|
||||
, externalExamShowGrades = eefShowGrades
|
||||
, externalExamGradingMode = eefGradingMode
|
||||
}
|
||||
whenIsJust insertRes $ \eeId -> do
|
||||
audit $ TransactionExternalExamEdit eeId
|
||||
|
||||
@ -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
|
||||
<div>
|
||||
@ -1252,13 +1261,107 @@ examResultField optMsg innerField = Field
|
||||
$maybe optMsg' <- guardOnM (not isReq) optMsg
|
||||
<option value="" :is _Left val:selected>
|
||||
_{optMsg'}
|
||||
<option value="attended" :is (_Right . _ExamAttended) val:selected>_{MsgExamResultAttended}
|
||||
<option value="no-show" :is (_Right . _ExamNoShow) val:selected>_{MsgExamResultNoShow}
|
||||
<option value="voided" :is (_Right . _ExamVoided) val:selected>_{MsgExamResultVoided}
|
||||
<fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{theId} data-conditional-value="attended" style="display: inline-block">
|
||||
^{fieldView innerField innerId name attrs innerVal True}
|
||||
$forall opt@Option{optionDisplay, optionExternalValue} <- olOptions
|
||||
<option value=#{optionExternalValue} :matchesPred opt:selected>
|
||||
#{optionDisplay}
|
||||
<option value=#{toPathPiece noShowVal} :is (_Right . _ExamNoShow) val:selected>
|
||||
_{MsgExamResultNoShow}
|
||||
<option value=#{toPathPiece voidedVal} :is (_Right . _ExamVoided) val:selected>
|
||||
_{MsgExamResultVoided}
|
||||
$forall Option{..} <- olOptions
|
||||
<fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{theId} data-conditional-value=#{optionExternalValue} style="display: inline-block">
|
||||
<legend>
|
||||
#{optionDisplay}
|
||||
^{fieldView (snd optionInternalValue) innerId name attrs innerVal True}
|
||||
|]
|
||||
}
|
||||
where
|
||||
outerOptions OptionList{..} =
|
||||
[ ""
|
||||
, toPathPiece noShowVal
|
||||
, toPathPiece voidedVal
|
||||
] ++ [ optionExternalValue | Option{..} <- olOptions ]
|
||||
|
||||
noShowVal, voidedVal :: ExamResult' res
|
||||
noShowVal = ExamNoShow
|
||||
voidedVal = ExamVoided
|
||||
|
||||
examResultGradeField :: forall m.
|
||||
( MonadHandler m
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> Maybe (SomeMessage UniWorX) -> Field m ExamResultGrade
|
||||
examResultGradeField = flip examResultField $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return $ mkOptionList
|
||||
[ Option
|
||||
{ optionDisplay = mr MsgExamResultGrade
|
||||
, optionExternalValue = "grade"
|
||||
, optionInternalValue =
|
||||
( const True
|
||||
, examGradeField
|
||||
)
|
||||
}
|
||||
]
|
||||
|
||||
examResultPassedField :: forall m.
|
||||
( MonadHandler m
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> Maybe (SomeMessage UniWorX) -> Field m ExamResultPassed
|
||||
examResultPassedField = flip examResultField $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return $ mkOptionList
|
||||
[ Option
|
||||
{ optionDisplay = mr MsgExamResultPass
|
||||
, optionExternalValue = "pass"
|
||||
, optionInternalValue =
|
||||
( const True
|
||||
, examPassedField
|
||||
)
|
||||
}
|
||||
]
|
||||
|
||||
examResultPassedGradeField :: forall m.
|
||||
( MonadHandler m
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> Maybe (SomeMessage UniWorX) -> Field m ExamResultPassedGrade
|
||||
examResultPassedGradeField = flip examResultField $ do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return $ mkOptionList
|
||||
[ Option
|
||||
{ optionDisplay = mr MsgExamResultGrade
|
||||
, optionExternalValue = "grade"
|
||||
, optionInternalValue =
|
||||
( either (`elem` map toPathPiece grades) (is _Right)
|
||||
, hoistField liftHandler . selectField $ fmap Right <$> optionsFinite
|
||||
)
|
||||
}
|
||||
, Option
|
||||
{ optionDisplay = mr MsgExamResultPass
|
||||
, optionExternalValue = "pass"
|
||||
, optionInternalValue =
|
||||
( either (`elem` map toPathPiece passResults) (is _Left)
|
||||
, hoistField liftHandler . selectField $ fmap Left <$> optionsFinite
|
||||
)
|
||||
}
|
||||
]
|
||||
where
|
||||
grades :: [ExamGrade]
|
||||
grades = universeF
|
||||
passResults :: [ExamPassed]
|
||||
passResults = universeF
|
||||
|
||||
examResultModeField :: forall m.
|
||||
( MonadHandler m
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> Maybe (SomeMessage UniWorX) -> ExamGradingMode -> Field m ExamResultPassedGrade
|
||||
examResultModeField optMsg ExamGradingGrades = convertField (fmap Right) (fmap $ either (review passingGrade) id) $ examResultGradeField optMsg
|
||||
examResultModeField optMsg ExamGradingPass = convertField (fmap Left) (fmap $ either id (view passingGrade)) $ examResultPassedField optMsg
|
||||
examResultModeField optMsg ExamGradingMixed = examResultPassedGradeField optMsg
|
||||
|
||||
|
||||
examGradeField :: forall m.
|
||||
( MonadHandler m
|
||||
@ -1279,7 +1382,7 @@ examPassedGradeField :: forall m.
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> Field m (Either ExamPassed ExamGrade)
|
||||
examPassedGradeField = hoistField liftHandler . selectField $ (<>) <$> (fmap Left <$> optionsFinite) <*> (fmap Right <$> optionsFinite)
|
||||
examPassedGradeField = hoistField liftHandler . selectField $ (<>) <$> (fmap Right <$> optionsFinite) <*> (fmap Left <$> optionsFinite)
|
||||
|
||||
|
||||
data CsvFormatOptions' = CsvFormatOptionsPreset' CsvPreset
|
||||
|
||||
@ -286,7 +286,7 @@ fltrExamResultPoints queryExamResult = singletonMap "exam-result" . FilterColumn
|
||||
|
||||
|
||||
fltrExamResultPointsUI :: DBFilterUI
|
||||
fltrExamResultPointsUI mPrev = prismAForm (singletonFilter "exam-result" . maybePrism _PathPiece) mPrev $ aopt (examResultField (Just $ SomeMessage MsgNoFilter) examPassedGradeField) (fslI MsgExamResult)
|
||||
fltrExamResultPointsUI mPrev = prismAForm (singletonFilter "exam-result" . maybePrism _PathPiece) mPrev $ aopt (examResultPassedGradeField . Just $ SomeMessage MsgNoFilter) (fslI MsgExamResult)
|
||||
|
||||
-------------
|
||||
-- Courses --
|
||||
|
||||
@ -614,6 +614,26 @@ customMigrations = Map.fromListWith (>>)
|
||||
res' = Left . view passingGrade <$> res
|
||||
in [executeQQ|UPDATE exam_result SET result = #{res'} WHERE id = #{resId};|]
|
||||
)
|
||||
, ( AppliedMigrationKey [migrationVersion|31.0.0|] [version|32.0.0|]
|
||||
, whenM (tableExists "exam") $
|
||||
[executeQQ|
|
||||
ALTER TABLE "exam" ADD COLUMN "grading_mode" character varying;
|
||||
UPDATE "exam" SET "grading_mode" = 'grades' WHERE "show_grades";
|
||||
UPDATE "exam" SET "grading_mode" = 'pass' WHERE NOT "show_grades";
|
||||
ALTER TABLE "exam" DROP COLUMN "show_grades";
|
||||
ALTER TABLE "exam" ALTER COLUMN "grading_mode" SET NOT NULL;
|
||||
|]
|
||||
)
|
||||
, ( AppliedMigrationKey [migrationVersion|32.0.0|] [version|33.0.0|]
|
||||
, whenM (tableExists "external_exam") $
|
||||
[executeQQ|
|
||||
ALTER TABLE "external_exam" ADD COLUMN "grading_mode" character varying;
|
||||
UPDATE "external_exam" SET "grading_mode" = 'grades' WHERE "show_grades";
|
||||
UPDATE "external_exam" SET "grading_mode" = 'pass' WHERE NOT "show_grades";
|
||||
ALTER TABLE "external_exam" DROP COLUMN "show_grades";
|
||||
ALTER TABLE "external_exam" ALTER COLUMN "grading_mode" SET NOT NULL;
|
||||
|]
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -27,12 +27,15 @@ module Model.Types.Exam
|
||||
, passingGrade
|
||||
, ExamResultPoints, ExamResultGrade, ExamResultPassed
|
||||
, ExamResultPassedGrade
|
||||
, ExamGradingMode(..)
|
||||
, _ExamGradingPass, _ExamGradingGrades, _ExamGradingMixed
|
||||
, ExamPartNumber
|
||||
, _ExamPartNumber, _ExamPartNumber'
|
||||
) where
|
||||
|
||||
import Import.NoModel
|
||||
import Model.Types.Common
|
||||
import Model.Types.TH.PathPiece
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Map as Map
|
||||
@ -345,6 +348,21 @@ instance {-# OVERLAPPING #-} FromJSON (Either ExamPassed ExamGrade) where
|
||||
parseJSON x = (Left <$> parseJSON x) <|> (Right <$> parseJSON x)
|
||||
|
||||
|
||||
data ExamGradingMode
|
||||
= ExamGradingPass
|
||||
| ExamGradingGrades
|
||||
| ExamGradingMixed
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
instance Universe ExamGradingMode
|
||||
instance Finite ExamGradingMode
|
||||
|
||||
nullaryPathPiece ''ExamGradingMode $ camelToPathPiece' 2
|
||||
pathPieceJSON ''ExamGradingMode
|
||||
pathPieceJSONKey ''ExamGradingMode
|
||||
derivePersistFieldPathPiece ''ExamGradingMode
|
||||
makePrisms ''ExamGradingMode
|
||||
|
||||
|
||||
newtype ExamPartNumber = ExamPartNumber { examPartNumberFragments :: [Either (CI Text) Natural] }
|
||||
deriving (Eq, Ord, Generic, Typeable)
|
||||
|
||||
|
||||
@ -36,25 +36,27 @@ $newline never
|
||||
<select>
|
||||
<option value="none">
|
||||
_{MsgExamCorrectExamResultNone}
|
||||
$if examShowGrades
|
||||
<option value="attended">
|
||||
_{MsgExamResult}
|
||||
$else
|
||||
<option value="passed">
|
||||
_{MsgExamPassed}
|
||||
<option value="failed">
|
||||
_{MsgExamNotPassed}
|
||||
$if is _ExamGradingGrades examGradingMode || is _ExamGradingMixed examGradingMode
|
||||
<option value="grade">
|
||||
_{MsgExamResultGrade}
|
||||
$if is _ExamGradingPass examGradingMode || is _ExamGradingMixed examGradingMode
|
||||
<option value="pass">
|
||||
_{MsgExamResultPass}
|
||||
<option value="voided">
|
||||
_{MsgExamResultVoided}
|
||||
<option value="no-show">
|
||||
_{MsgExamResultNoShow}
|
||||
<option value="delete">
|
||||
_{MsgExamCorrectExamResultDelete}
|
||||
<td .table__td #uw-exam-correct__result__grade>
|
||||
<select>
|
||||
$forall grade <- (toPathPiece <$> examGrades)
|
||||
<option>
|
||||
#{grade}
|
||||
<td .table__td #uw-exam-correct__result__pass-grade>
|
||||
<select .uw-exam-correct__grade>
|
||||
$forall grade <- examGrades
|
||||
<option value=#{toPathPiece grade}>
|
||||
_{grade}
|
||||
<select .uw-exam-correct__pass>
|
||||
$forall pass <- [ExamPassed True, ExamPassed False]
|
||||
<option value=#{toPathPiece pass}>
|
||||
_{pass}
|
||||
<td #exam-correct__status .table__td>
|
||||
<button #exam-correct__send-btn .btn .btn-primary>
|
||||
_{MsgExamCorrectButtonSend}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user