diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs index e0cd7f593..08f3c1503 100644 --- a/src/Handler/Course/Register.hs +++ b/src/Handler/Course/Register.hs @@ -9,6 +9,7 @@ module Handler.Course.Register import Import import Handler.Utils +import Handler.Utils.Exam import Utils.Course @@ -297,9 +298,8 @@ deregisterParticipant uid cid = do E.where_ $ exam E.^. ExamCourse E.==. E.val cid E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid return examRegistration - forM_ examRegistrations $ \(Entity erId ExamRegistration{..}) -> do - delete erId - audit $ TransactionExamDeregister examRegistrationExam uid + forM_ examRegistrations $ \(Entity _ ExamRegistration{..}) -> do + deregisterExamUsers examRegistrationExam $ pure examRegistrationUser E.delete . E.from $ \tutorialParticipant -> do let tutorialCourse = E.subSelectForeign tutorialParticipant TutorialParticipantTutorial (E.^. TutorialCourse) diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs index e8b306d85..e206bc17b 100644 --- a/src/Handler/Exam/Show.hs +++ b/src/Handler/Exam/Show.hs @@ -124,6 +124,7 @@ getEShowR tid ssh csh examn = do , mayRegister' (entityKey <$> mOcc) = Just $ do (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered [whamlet| + $newline never

$if isRegistered _{MsgExamRegistered} @@ -147,11 +148,12 @@ getEShowR tid ssh csh examn = do } | is _Nothing mOcc , is _Nothing registered - = Just [whamlet|_{MsgExamLoginToRegister}|] + = Just $ i18n MsgExamLoginToRegister | is _Nothing mOcc , isRegistered <- is _Just $ join registered = Just [whamlet| + $newline never

$if isRegistered _{MsgExamRegistered} diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 9fcf76c04..23b296d64 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -36,7 +36,7 @@ import qualified Data.CaseInsensitive as CI import Numeric.Lens (integral) -import Database.Persist.Sql (deleteWhereCount, updateWhereCount) +import Database.Persist.Sql (updateWhereCount) import Control.Lens.Indexed ((<.), (.>)) @@ -840,13 +840,8 @@ postEUsersR tid ssh csh examn = do ] audit $ TransactionExamResultEdit eid examUserCsvActUser ExamUserCsvDeregisterData{..} -> do - ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration - audit $ TransactionExamDeregister eid examRegistrationUser - delete examUserCsvActRegistration - result <- getBy $ UniqueExamResult eid examRegistrationUser - forM_ result $ \(Entity erId _) -> do - delete erId - audit $ TransactionExamResultDeleted eid examRegistrationUser + ExamRegistration{..} <- getJust examUserCsvActRegistration + deregisterExamUsers examRegistrationExam $ pure examRegistrationUser ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse whenIsJust noteId $ \nid -> do @@ -1051,10 +1046,9 @@ postEUsersR tid ssh csh examn = do (, exam, bonus) . over (_1 . _2) postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable formResult registrationResult $ \case - (ExamUserDeregisterData, Map.keysSet -> selectedRegistrations) -> do - nrDel <- runDB $ deleteWhereCount - [ ExamRegistrationId <-. Set.toList selectedRegistrations - ] + (ExamUserDeregisterData, Map.elems -> selectedRegistrations) -> do + nrDel <- runDB . setSerializable . deregisterExamUsersCount eId $ map (view $ resultUser . _entityKey) selectedRegistrations + addMessageI Success $ MsgExamUsersDeregistered nrDel redirect $ CExamR tid ssh csh examn EUsersR (ExamUserAssignOccurrenceData occId, Map.keysSet -> selectedRegistrations) -> do diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index e192dc688..54632cde6 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -10,6 +10,7 @@ module Handler.Utils.Exam , eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize , _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize , examAutoOccurrence + , deregisterExamUsersCount, deregisterExamUsers ) where import Import @@ -609,3 +610,34 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences in Set.map (appEndo $ foldMap Endo [ over l padSuff | l <- [_eaomrStart, _eaomrEnd, _eaomrSpecial]]) <$> res | otherwise = res + + +deregisterExamUsersCount :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m Int64 +deregisterExamUsersCount eId uids = do + partResults <- E.select . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do + E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart + E.where_ $ examPart E.^. ExamPartExam E.==. E.val eId + E.&&. examPartResult E.^. ExamPartResultUser `E.in_` E.valList uids + return examPartResult + forM_ partResults $ \(Entity resId ExamPartResult{..}) -> do + delete resId + audit $ TransactionExamPartResultDeleted examPartResultExamPart examPartResultUser + + results <- selectList [ ExamResultExam ==. eId, ExamResultUser <-. uids ] [] + forM_ results $ \(Entity resId ExamResult{..}) -> do + delete resId + audit $ TransactionExamResultDeleted examResultExam examResultUser + + boni <- selectList [ ExamBonusExam ==. eId, ExamBonusUser <-. uids ] [] + forM_ boni $ \(Entity bonusId ExamBonus{..}) -> do + delete bonusId + audit $ TransactionExamBonusDeleted examBonusExam examBonusUser + + regs <- selectList [ ExamRegistrationExam ==. eId, ExamRegistrationUser <-. uids ] [] + fmap (ala Sum foldMap) . forM regs $ \(Entity regId ExamRegistration{..}) -> do + delete regId + audit $ TransactionExamDeregister examRegistrationExam examRegistrationUser + return 1 + +deregisterExamUsers :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m () +deregisterExamUsers eId uids = void $ deregisterExamUsersCount eId uids diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index efb7f534d..176cf01fd 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -87,8 +87,8 @@ $maybe desc <- examDescription $maybe registerWdgt <- registerWidget Nothing

_{MsgExamRegistration} - \ ^{isVisible False} -
^{registerWdgt} +
+ ^{registerWdgt} $if showCloseWidget && is _Nothing examClosed