feat(exams): accept/reset computed results

messages/uniworx/de.msg

@@ -1449,8 +1449,13 @@ ExamSynchronised: Synchronisiert
 ExamUsersHeading: Prüfungsteilnehmer
 ExamUserDeregister: Teilnehmer von Prüfung abmelden
 ExamUserAssignOccurrence: Termin/Raum zuweisen
+ExamUserAcceptComputedResult: Berechnetes Prüfungsergebnis übernehmen
+ExamUserResetToComputedResult: Prüfungsergebnis zurücksetzen
+ExamUserResetBonus: Auch Bonuspunkte zurücksetzen
 ExamUsersDeregistered count@Int64: #{show count} Teilnehmer von der Prüfung abgemeldet
 ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
+ExamUsersResultsAccepted count@Int64: Prüfungsergebnis für #{show count} Teilnehmer übernommen
+ExamUsersResultsReset count@Int64: Prüfungsergebnis für #{show count} Teilnehmer zurückgesetzt
 
 ExamUserSynchronised: Synchronisiert
 ExamUserSyncOfficeName: Name

src/Handler/Exam/Users.hs

@@ -295,6 +295,8 @@ examUserTableCsvHeader allBoni doBonus pNames = Csv.header $
 
 data ExamUserAction = ExamUserDeregister
                     | ExamUserAssignOccurrence
+                    | ExamUserAcceptComputedResult
+                    | ExamUserResetToComputedResult
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe ExamUserAction
@@ -304,6 +306,10 @@ embedRenderMessage ''UniWorX ''ExamUserAction id
 
 data ExamUserActionData = ExamUserDeregisterData
                         | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
+                        | ExamUserAcceptComputedResultData
+                        | ExamUserResetToComputedResultData
+                          { examUserResetBonus :: Bool
+                          }
 
 data ExamUserCsvActionClass
   = ExamUserCsvCourseRegister
@@ -380,7 +386,7 @@ embedRenderMessage ''UniWorX ''ExamUserCsvException id
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
-  ((registrationResult, examUsersTable), Entity eId _) <- runDB $ do
+  (((Any computedValues, registrationResult), examUsersTable), Entity eId examVal, bonus) <- runDB $ do
     exam@(Entity eid examVal@Exam{..}) <- fetchExam tid ssh csh examn
     examParts <- selectList [ExamPartExam ==. eid] [Asc ExamPartName]
     bonus <- examBonus exam
@@ -403,10 +409,12 @@ postEUsersR tid ssh csh examn = do
       resultAutomaticExamResult' :: Fold ExamUserTableData ExamResultGrade
       resultAutomaticExamResult' = resultAutomaticExamResult examVal bonus
 
-      automaticCell :: forall msg m a r.
+      automaticCell :: forall msg m a b r.
                        ( RenderMessage UniWorX msg
                        , IsDBTable m a
                        , Eq msg
+                       , Monoid b
+                       , a ~ (Any, b)
                        )
                     => Getting (Endo [Either msg msg]) r (Either msg msg)
                     -> r
@@ -414,12 +422,12 @@ postEUsersR tid ssh csh examn = do
       automaticCell l r = case toListOf l r of
         [] -> mempty
         (Left auto : _)
-          -> i18nCell auto & cellAttrs <>~ [("class", "table__td--automatic")]
+          -> i18nCell auto & cellAttrs <>~ [("class", "table__td--automatic")] & tellCell (Any True, mempty)
         (Right man : others)
           | all ((== man) . either id id) others
             -> i18nCell man
           | otherwise
-            -> i18nCell man & cellAttrs <>~ [("class", "table__td--overriden")]
+            -> i18nCell man & cellAttrs <>~ [("class", "table__td--overriden")] & tellCell (Any True, mempty)
 
     csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn)
 
@@ -478,7 +486,7 @@ postEUsersR tid ssh csh examn = do
                   ]
             
           dbtColonnade = mconcat $ catMaybes
-            [ pure $ dbSelect (applying _2) id $ return . view (resultExamRegistration . _entityKey)
+            [ pure $ dbSelect (_2 . applying _2) _1 $ return . view (resultExamRegistration . _entityKey)
             , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
             , pure   colUserMatriclenr
             , pure $ colField            resultStudyField
@@ -562,20 +570,26 @@ postEUsersR tid ssh csh examn = do
             , dbParamsFormAdditional = \csrf -> do
                 let
                   actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData)
-                  actionMap = Map.fromList
+                  actionMap = mconcat
-                    [ ( ExamUserDeregister
+                    [ singletonMap ExamUserDeregister $
-                      , pure ExamUserDeregisterData
+                        pure ExamUserDeregisterData
-                      )
+                    , singletonMap ExamUserAssignOccurrence $
-                    , ( ExamUserAssignOccurrence
+                        ExamUserAssignOccurrenceData
-                      , ExamUserAssignOccurrenceData
                         <$> aopt (examOccurrenceField eid) (fslI MsgExamOccurrence) (Just Nothing)
-                      )
+                    , bool mempty computeActionMap $ is _Just examGradingRule
+                    ]
+                  computeActionMap = mconcat
+                    [ singletonMap ExamUserAcceptComputedResult $
+                        pure ExamUserAcceptComputedResultData
+                    , singletonMap ExamUserResetToComputedResult $
+                        ExamUserResetToComputedResultData
+                        <$> bool (pure True) (apopt checkBoxField (fslI MsgExamUserResetBonus) (Just True)) (is _Just examBonusRule)
                     ]
                 (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
                 let formRes = (, mempty) . First . Just <$> res
                 return (formRes, formWgt)
             , dbParamsFormEvaluate = liftHandlerT . runFormPost
-            , dbParamsFormResult   = id
+            , dbParamsFormResult   = _2
             , dbParamsFormIdent    = def
             }
           dbtIdent :: Text
@@ -992,21 +1006,21 @@ postEUsersR tid ssh csh examn = do
       examUsersDBTableValidator = def & defaultSorting [SortAscBy "user-name"]
                                       & defaultPagesize PagesizeAll
 
-      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserActionData, Set ExamRegistrationId)
+      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId (Bool, ExamUserTableData) ExamUserTableData) -> FormResult (ExamUserActionData, Map ExamRegistrationId ExamUserTableData)
       postprocess inp = do
         (First (Just act), regMap) <- inp
-        let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
+        let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
-        return (act, regSet)
+        return (act, regMap')
-    (, exam) . over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
+    (, exam, bonus) . over (_1 . _2) postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
 
   formResult registrationResult $ \case
-    (ExamUserDeregisterData, selectedRegistrations) -> do
+    (ExamUserDeregisterData, Map.keysSet -> selectedRegistrations) -> do
       nrDel <- runDB $ deleteWhereCount
         [ ExamRegistrationId <-. Set.toList selectedRegistrations
         ]
       addMessageI Success $ MsgExamUsersDeregistered nrDel
       redirect $ CExamR tid ssh csh examn EUsersR
-    (ExamUserAssignOccurrenceData occId, selectedRegistrations) -> do
+    (ExamUserAssignOccurrenceData occId, Map.keysSet -> selectedRegistrations) -> do
       nrUpdated <- runDB $ updateWhereCount
         [ ExamRegistrationId <-. Set.toList selectedRegistrations
         ]
@@ -1014,9 +1028,67 @@ postEUsersR tid ssh csh examn = do
         ]
       addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated
       redirect $ CExamR tid ssh csh examn EUsersR
+    (ExamUserAcceptComputedResultData, Map.elems -> rows) -> do
+      nrAccepted <- fmap (getSum . fold) . runDB . forM rows . runReaderT $ do
+        now <- liftIO getCurrentTime
+        uid <- view $ resultUser . _entityKey
+        hasResult <- asks $ has resultExamResult
+        hasBonus <- asks $ has resultExamBonus
+        autoResult <- preview $ resultAutomaticExamResult examVal bonus
+        autoBonus <- preview $ resultAutomaticExamBonus examVal bonus
+        lift $ if
+          | not hasResult
+          , Just examResultResult <- autoResult
+            -> do
+              if
+                | Just examBonusBonus <- autoBonus
+                , not hasBonus
+                -> do
+                  insert_ ExamBonus
+                    { examBonusExam = eId
+                    , examBonusUser = uid
+                    , examBonusLastChanged = now
+                    , ..
+                    }
+                  audit $ TransactionExamBonusEdit eId uid
+                | otherwise
+                -> return ()
+              
+              insert_ ExamResult
+                { examResultExam = eId
+                , examResultUser = uid
+                , examResultLastChanged = now
+                , ..
+                }
+              audit $ TransactionExamResultEdit eId uid
+              return $ Sum 1
+          | otherwise
+            -> return mempty
+      addMessageI Success $ MsgExamUsersResultsAccepted nrAccepted
+      redirect $ CExamR tid ssh csh examn EUsersR
+    (ExamUserResetToComputedResultData{..}, Map.elems -> rows) -> do
+      nrReset <- fmap (getSum . fold) . runDB . forM rows . runReaderT $ do
+        uid <- view $ resultUser . _entityKey
+        lift $ do
+          when examUserResetBonus $ do
+            bonusId' <- getKeyBy $ UniqueExamBonus eId uid
+            whenIsJust bonusId' $ \bonusId -> do
+                delete bonusId
+                audit $ TransactionExamBonusDeleted eId uid
+
+          result <- getKeyBy $ UniqueExamResult eId uid
+          case result of
+            Just resId -> do
+              delete resId
+              audit $ TransactionExamResultDeleted eId uid
+              return $ Sum 1
+            Nothing -> return mempty
+      addMessageI Success $ MsgExamUsersResultsReset nrReset
+      redirect $ CExamR tid ssh csh examn EUsersR
 
   closeWgt <- examCloseWidget (SomeRoute $ CExamR tid ssh csh examn EUsersR) eId
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading
+    let computedValuesTip = $(i18nWidgetFile "exam-users/computed-values-tip")
     $(widgetFile "exam-users")

templates/default-layout.lucius

@@ -596,7 +596,7 @@ section {
   position: relative;
   border-radius: 3px;
   padding: 10px 20px 20px;
-  margin: 40px 0;
+  margin: 40px auto;
   box-shadow: 0 0 4px 2px inset currentColor;
   padding-left: 100px;
   min-height: 100px;
@@ -608,7 +608,7 @@ section {
 
   &::before {
     font-family: "Font Awesome 5 Free";
-    font-weight: 900;
+    font-weight: 600;
     position: absolute;
     display: flex;
     left: 0;
@@ -623,6 +623,12 @@ section {
   .notification__content {
     grid-column: 1;
     align-self: center;
+
+    color: var(--color-font);
+  }
+
+  &.notification--broad {
+    max-width: none;
   }
 }
 

templates/exam-users.hamlet

@@ -2,4 +2,6 @@ $newline never
 <section>
   ^{closeWgt}
 <section>
+  $if computedValues
+    ^{computedValuesTip}
   ^{examUsersTable}

templates/i18n/exam-users/computed-values-tip/de.hamlet

@@ -0,0 +1,24 @@
+$newline never
+<div .notification .notification-warning .fa-exclamation-triangle .notification--broad>
+  <div .notification__content>
+    <p>
+      Die Tabelle enthält Werte, die automatisch berechnet wurden.
+    <p>
+      Automatisch berechnete Werte (Bonus und Prüfungsergebnis) werden weder dem #
+      entsprechenden Teilnehmer angezeigt, noch an das Prüfungsamt gemeldet #
+      bevor sie manuell übernommen wurden.<br />
+      Hierzu können Sie die Aktion „Berechnetes Prüfungsergebnis übernehmen“ #
+      verwenden.
+    <p>
+      Sie können die automatisch berechneten Werte auch manuell (via CSV-Import) #
+      überschreiben.<br />
+      Wenn die so gesetzten Werte nicht den automatisch Berechneten entsprechen #
+      sind sie <i>inkonsistent</i>.
+    <p>
+      Automatisch berechnete Werte sind gekennzeichnet wie folgt:
+
+    <table style="font-weight: normal">
+      <tr>
+        <td style="padding: 0 7px 0 0" .table__td .table__td--automatic>Automatisch berechnet
+        <td style="padding: 0 7px" .table__td>Normaler Wert
+        <td style="padding: 0 0 0 7px" .table__td .table__td--overriden>Inkonsistent