refactor(tutorial): fix and complete exam occurrence form function

This commit is contained in:
Steffen Jost 2025-01-27 17:40:13 +01:00
parent 7503a55039
commit c059473cf4
3 changed files with 29 additions and 8 deletions

View File

@ -221,6 +221,10 @@ ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
ExamRegisteredCount: Anmeldungen
ExamRegisteredCountOf num@Int64 count@Int64 !ident-ok: #{num}/#{count}
ExamOccurrences: Termine
ExamOccurrencesCopied num@Int: #{pluralDEeN num "Prüfungstermin"} kopiert
ExamOccurrencesEdited num@Int del@Int: #{pluralENsN num "Prüfungstermin"} geändert #{guardMonoid (del > 0) ("und " <> pluralENsN num "Prüfungstermin" <> " gelöscht")}
ExamOccurrenceCopyNoStartDate: Dieser Kurs hat noch keine eigene Termine um Prüfungstermine zeitlich damit zu assozieren
ExamOccurrenceCopyFail: Keine passenden Prüfungstermine zum Kopieren gefunden
GradingFrom: Ab
ExamNoShow: Nicht erschienen
ExamVoided: Entwertet

View File

@ -221,6 +221,10 @@ ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
ExamRegisteredCount: Registrations
ExamRegisteredCountOf num count: #{num}/#{count}
ExamOccurrences: Exams
ExamOccurrencesCopied num: #{pluralENsN num "exam occurrence"} copied
ExamOccurrencesEdited num del: #{pluralENsN num "exam occurrence"} edited #{guardMonoid (del > 0) ("and " <> pluralENsN num "exam occurrence" <> " deleted")}
ExamOccurrenceCopyNoStartDate: This course needs its own occurrence to copy associated exam occurrences.
ExamOccurrenceCopyFail: No suitable exam occurrences found to copy from.
GradingFrom: From
#templates widgets/bonus-rule

View File

@ -20,7 +20,7 @@ import Handler.Utils
import Handler.Utils.Course
import Handler.Utils.Course.Cache
import Handler.Utils.Tutorial
import Handler.Exam.Form (ExamOccurrenceForm(..), examOccurrenceMultiForm, upsertExamOccurrences)
import Handler.Exam.Form (ExamOccurrenceForm(..), examOccurrenceMultiForm, upsertExamOccurrences, copyExamOccurrences)
import Database.Persist.Sql (deleteWhereCount)
import qualified Data.CaseInsensitive as CI
@ -240,7 +240,9 @@ postTUsersR tid ssh csh tutn = do
Just act -> act -- execute action and return produced content (i.e. pdf)
Nothing -> do -- no table action content to return, continue normally
let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR
(fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
(dbegin, dend) = munzip timespan
tbegin = toMidnight . succ <$> dbegin
tend = toMidnight <$> dend
exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend]
$logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|]
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr
@ -258,8 +260,16 @@ postTUsersR tid ssh csh tutn = do
GenTutActOccEditData { gtaExamMb=eId } -> do
Exam{examName=ename} <- runDBRead $ get404 eId
redirect $ CTutorialR tid ssh csh tutn $ TExamR ename
GenTutActOccCopyData { gtaExam=eId } -> do
error "TODO"
GenTutActOccCopyData { gtaExam=eId } ->
case dbegin of
Nothing -> addMessageI Error MsgExamOccurrenceCopyNoStartDate
(Just dto) ->
let cfailure = addMessageI Error MsgExamOccurrenceCopyFail
csuccess n = addMessageI Success (MsgExamOccurrencesCopied n) >> reloadKeepGetParams croute
copyFrom dfrom = copyExamOccurrences eId dfrom dto <&> (toMaybe =<< (> 0))
in maybeM cfailure csuccess $
runDB $ firstJustM $ map copyFrom $ take 21 $ drop 1 [dto, pred dto..]
tutors <- runDBRead $ E.select do
(tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
`E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
@ -301,10 +311,13 @@ postTExamR tid ssh csh tutn exmName = do
$logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length edCEOIds} old occurrences, #{length ceoidsDelete} to delete, #{length $ Set.filter (isNothing . eofId) edOccs} to insert, #{length $ Set.filter (isJust . eofId) edOccs} to edit|]
reId <- decrypt edCEId
eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete
when (reId == eId) $ runDB do
nrDel <- deleteWhereCount [ExamOccurrenceExam ==. reId, ExamOccurrenceId <-. eoIdsDelete]
nrUps <- upsertExamOccurrences eId $ Set.toList edOccs
--TODO status message
when (reId == eId) $ do
(fromIntegral -> nrDel, nrUps) <- runDB $ (,)
<$> deleteWhereCount [ExamOccurrenceExam ==. reId, ExamOccurrenceId <-. eoIdsDelete]
<*> upsertExamOccurrences eId (Set.toList edOccs)
let nr = nrUps + nrDel
mstat = if nr > 0 then Success else Warning
addMessageI mstat $ MsgExamOccurrencesEdited nrUps nrDel
reload $ baseroute $ TExamR exmName
let heading = prependCourseTitle tid ssh csh $ CI.original $ tutorialName $ entityVal tutEnt