feat(exams): allow mixed ExamGradingMode

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');
+    const resultDetailCell = document.getElementById('uw-exam-correct__result__pass-grade');
-    this._resultGradeSelect = resultGradeCell && resultGradeCell.querySelector('select');
+    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 'pass':
-        case 'failed':
+          result = { status: 'attended', result: this._resultPassSelect.value };
-          result = { status: 'attended', result: { Left: this._resultSelect.value } };
           break;
-        case 'attended':
+        case 'grade':
-          result = { status: 'attended', result: { Right: this._resultGradeSelect.value } };
+          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) {

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
+  td#uw-exam-correct__result__pass-grade
-    visibility: hidden
+    select.grade-hidden, select.pass-hidden
+      visibility: hidden
   td.exam-correct--status-cell
     font-size: .9rem
     font-weight: 600

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
+ExamGradingMode: Bewertungsmodus
-ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsbeauftragte nur informiert werden, ob die Klausur bestanden wurde?
+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

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

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

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

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
 

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
         }
 

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

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
         }

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
+                    Nothing -> do
-                      -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
+                      yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
+                      whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind
                     Just _
-                      | csvEUserExamResult dbCsvNew /= newResult
+                      | csvEUserExamResult dbCsvNew /= newResult -> do
-                        -> yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew
+                        yield . ExamUserCsvSetResultData True uid $ csvEUserExamResult dbCsvNew
-                      | oldResult /= newResult
+                        whenIsJust (csvEUserExamResult dbCsvNew) guardResultKind
-                        -> yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
+                      | 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

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

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

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

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)
+                => Maybe (SomeMessage UniWorX) -> Handler (OptionList (Either Text res -> Bool, Field m res)) -> Field m (ExamResult' res)
-examResultField optMsg innerField = Field
+examResultField optMsg mkOl = Field
-  { fieldEnctype = UrlEncoded <> fieldEnctype innerField
+  { fieldEnctype = UrlEncoded -- breaks if mkOl contains options with other enctype
-  , fieldParse = \ts fs -> if
+  , fieldParse = \ts fs -> do
-      | res : _ <- mapMaybe (assertM ((||) <$> is _ExamNoShow <*> is _ExamVoided) . fromPathPiece) ts
+      ol@OptionList{..} <- liftHandler mkOl
-        -> return . Right $ Just res
+      if
-      | null ts || any null ts
+        | res : _ <- mapMaybe (assertM ((||) <$> is _ExamNoShow <*> is _ExamVoided) . fromPathPiece) ts
-        -> return $ Right Nothing
+          -> return . Right $ Just res
-      | otherwise
+        | any null ts
-        -> fmap (fmap ExamAttended) <$> fieldParse innerField (filter (not . (`elem` ["", "attended", "no-show", "voided"])) ts) fs
+          -> 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}
+            $forall opt@Option{optionDisplay, optionExternalValue} <- olOptions
-            <option value="no-show" :is (_Right . _ExamNoShow) val:selected>_{MsgExamResultNoShow}
+              <option value=#{optionExternalValue} :matchesPred opt:selected>
-            <option value="voided" :is (_Right . _ExamVoided) val:selected>_{MsgExamResultVoided}
+                #{optionDisplay}
-          <fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{theId} data-conditional-value="attended" style="display: inline-block">
+            <option value=#{toPathPiece noShowVal} :is (_Right . _ExamNoShow) val:selected>
-            ^{fieldView innerField innerId name attrs innerVal True}
+              _{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

src/Handler/Utils/Table/Columns.hs

@@ -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 --

src/Model/Migration.hs

@@ -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;
+        |]
+    )
   ]
 
 

src/Model/Types/Exam.hs

@@ -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)
 

templates/exam-correct.hamlet

@@ -36,25 +36,27 @@ $newline never
               <select>
                 <option value="none">
                   _{MsgExamCorrectExamResultNone}
-                $if examShowGrades
+                $if is _ExamGradingGrades examGradingMode || is _ExamGradingMixed examGradingMode
-                  <option value="attended">
+                  <option value="grade">
-                    _{MsgExamResult}
+                    _{MsgExamResultGrade}
-                $else
+                $if is _ExamGradingPass examGradingMode || is _ExamGradingMixed examGradingMode
-                  <option value="passed">
+                  <option value="pass">
-                    _{MsgExamPassed}
+                    _{MsgExamResultPass}
-                  <option value="failed">
-                    _{MsgExamNotPassed}
                 <option value="voided">
                   _{MsgExamResultVoided}
                 <option value="no-show">
                   _{MsgExamResultNoShow}
                 <option value="delete">
                   _{MsgExamCorrectExamResultDelete}
-            <td .table__td #uw-exam-correct__result__grade>
+            <td .table__td #uw-exam-correct__result__pass-grade>
-              <select>
+              <select .uw-exam-correct__grade>
-                $forall grade <- (toPathPiece <$> examGrades)
+                $forall grade <- examGrades
-                  <option>
+                  <option value=#{toPathPiece grade}>
-                    #{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}