feat(exams): accept/reset computed results
This commit is contained in:
Gregor Kleen
parent
ea5a398bab
commit
72342f1393
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -2,4 +2,6 @@ $newline never
|
||||
<section>
|
||||
^{closeWgt}
|
||||
<section>
|
||||
$if computedValues
|
||||
^{computedValuesTip}
|
||||
^{examUsersTable}
|
||||
|
||||
24
templates/i18n/exam-users/computed-values-tip/de.hamlet
Normal file
24
templates/i18n/exam-users/computed-values-tip/de.hamlet
Normal file
@ -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
|
||||
Reference in New Issue
Block a user