From 72342f13936f9e4056e3825ba872a3c5a3726e11 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 18 Sep 2019 18:29:35 +0200 Subject: [PATCH] feat(exams): accept/reset computed results --- messages/uniworx/de.msg | 5 + src/Handler/Exam/Users.hs | 110 +++++++++++++++--- templates/default-layout.lucius | 10 +- templates/exam-users.hamlet | 2 + .../exam-users/computed-values-tip/de.hamlet | 24 ++++ 5 files changed, 130 insertions(+), 21 deletions(-) create mode 100644 templates/i18n/exam-users/computed-values-tip/de.hamlet diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 3651476cc..2cdc8cee8 100644 --- a/messages/uniworx/de.msg +++ b/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 diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index ba71c331c..3c9d0944f 100644 --- a/src/Handler/Exam/Users.hs +++ b/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 - [ ( ExamUserDeregister - , pure ExamUserDeregisterData - ) - , ( ExamUserAssignOccurrence - , ExamUserAssignOccurrenceData + actionMap = mconcat + [ singletonMap ExamUserDeregister $ + pure ExamUserDeregisterData + , singletonMap ExamUserAssignOccurrence $ + 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 - return (act, regSet) - (, exam) . over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable + let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap + return (act, regMap') + (, 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") diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 395b4cd01..caee80c08 100644 --- a/templates/default-layout.lucius +++ b/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; } } diff --git a/templates/exam-users.hamlet b/templates/exam-users.hamlet index efa46523c..06e3e489f 100644 --- a/templates/exam-users.hamlet +++ b/templates/exam-users.hamlet @@ -2,4 +2,6 @@ $newline never
^{closeWgt}
+ $if computedValues + ^{computedValuesTip} ^{examUsersTable} diff --git a/templates/i18n/exam-users/computed-values-tip/de.hamlet b/templates/i18n/exam-users/computed-values-tip/de.hamlet new file mode 100644 index 000000000..22f185706 --- /dev/null +++ b/templates/i18n/exam-users/computed-values-tip/de.hamlet @@ -0,0 +1,24 @@ +$newline never +
+
+

+ Die Tabelle enthält Werte, die automatisch berechnet wurden. +

+ Automatisch berechnete Werte (Bonus und Prüfungsergebnis) werden weder dem # + entsprechenden Teilnehmer angezeigt, noch an das Prüfungsamt gemeldet # + bevor sie manuell übernommen wurden.
+ Hierzu können Sie die Aktion „Berechnetes Prüfungsergebnis übernehmen“ # + verwenden. +

+ Sie können die automatisch berechneten Werte auch manuell (via CSV-Import) # + überschreiben.
+ Wenn die so gesetzten Werte nicht den automatisch Berechneten entsprechen # + sind sie inkonsistent. +

+ Automatisch berechnete Werte sind gekennzeichnet wie folgt: + + + +
Automatisch berechnet + Normaler Wert + Inkonsistent