diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs index 2e7b2fd45..5da5f6735 100644 --- a/src/Handler/Course/Register.hs +++ b/src/Handler/Course/Register.hs @@ -3,6 +3,7 @@ module Handler.Course.Register , CourseRegisterForm(..) , courseRegisterForm , getCRegisterR, postCRegisterR + , deregisterParticipant ) where import Import @@ -202,16 +203,6 @@ postCRegisterR tid ssh csh = do audit $ TransactionCourseParticipantEdit cid uid insertUnique $ CourseParticipant cid uid cTime crfStudyFeatures Nothing - deleteApplications = do - appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] [] - forM_ appIds $ \appId -> do - deleteApplicationFiles appId - delete appId - audit $ TransactionCourseApplicationDeleted cid uid appId - - deleteApplicationFiles appId = do - fs <- selectList [ CourseApplicationFileApplication ==. appId ] [] - deleteCascadeWhere [ FileId <-. map (courseApplicationFileFile . entityVal) fs ] case courseRegisterButton of BtnCourseRegister -> runDB $ do regOk <- (\app reg -> (,) <$> app <*> reg) <$> mkApplication <*> mkRegistration @@ -219,34 +210,14 @@ postCRegisterR tid ssh csh = do Nothing -> transactionUndo Just _ -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk BtnCourseDeregister -> runDB $ do - deleteApplications part <- getBy $ UniqueParticipant uid cid - forM_ part $ \(Entity partId CourseParticipant{..}) -> do - delete $ partId - audit $ TransactionCourseParticipantDeleted cid uid - + forM_ part $ \(Entity _partId CourseParticipant{..}) -> do when (is _Just courseParticipantAllocated) $ do now <- liftIO getCurrentTime insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing - examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do - E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId - 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 + deregisterParticipant uid cid - examResults <- E.select . E.from $ \(examResult `E.InnerJoin` exam) -> do - E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId - E.where_ $ exam E.^. ExamCourse E.==. E.val cid - E.&&. examResult E.^. ExamResultUser E.==. E.val uid - return examResult - forM_ examResults $ \(Entity erId ExamResult{..}) -> do - delete erId - audit $ TransactionExamResultDeleted examResultExam uid - addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk BtnCourseApply -> runDB $ do regOk <- mkApplication @@ -254,6 +225,53 @@ postCRegisterR tid ssh csh = do Nothing -> transactionUndo Just _ -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk BtnCourseRetractApplication -> runDB $ do - deleteApplications + deleteApplications uid cid addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk redirect $ CourseR tid ssh csh CShowR + +deleteApplications :: UserId -> CourseId -> DB () +deleteApplications uid cid = do + appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] [] + forM_ appIds $ \appId -> do + deleteApplicationFiles appId + delete appId + audit $ TransactionCourseApplicationDeleted cid uid appId + +deleteApplicationFiles :: CourseApplicationId -> DB () +deleteApplicationFiles appId = do + fs <- selectList [ CourseApplicationFileApplication ==. appId ] [] + deleteCascadeWhere [ FileId <-. map (courseApplicationFileFile . entityVal) fs ] + +deregisterParticipant :: UserId -> CourseId -> DB () +deregisterParticipant uid cid = do + deleteApplications uid cid + part <- getBy $ UniqueParticipant uid cid + forM_ part $ \(Entity partId CourseParticipant{..}) -> do + delete $ partId + audit $ TransactionCourseParticipantDeleted cid uid + + examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do + E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId + 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 + + examResults <- E.select . E.from $ \(examResult `E.InnerJoin` exam) -> do + E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId + E.where_ $ exam E.^. ExamCourse E.==. E.val cid + E.&&. examResult E.^. ExamResultUser E.==. E.val uid + return examResult + forM_ examResults $ \(Entity erId ExamResult{..}) -> do + delete erId + audit $ TransactionExamResultDeleted examResultExam uid + + E.delete . E.from $ \tutorialParticipant -> do + let tutorialCourse = E.sub_select . E.from $ \tutorial -> do + E.where_ $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial + return $ tutorial E.^. TutorialCourse + + E.where_ $ tutorialCourse E.==. E.val cid + E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 95f50f3a9..9a35b8e62 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -143,11 +143,10 @@ postCUserR tid ssh csh uCId = do | not mayRegister -> permissionDenied "User may not be registered" (BtnCourseDeregister, mbReason) - | Just (Entity pId CourseParticipant{..}) <- mRegistration + | Just (Entity _pId CourseParticipant{..}) <- mRegistration -> do runDB $ do - delete pId - audit $ TransactionCourseParticipantDeleted cid courseParticipantUser + deregisterParticipant courseParticipantUser courseParticipantCourse whenIsJust mbReason $ \reason -> do now <- liftIO getCurrentTime diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 4cf536f2e..6f3c7e6cc 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -14,6 +14,8 @@ import Handler.Utils import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH +import Handler.Course.Register (deregisterParticipant) + import Data.Function ((&)) import qualified Data.Set as Set @@ -481,9 +483,8 @@ postCUsersR tid ssh csh = do (CourseUserDeregisterData{..}, selectedUsers) -> do Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> fmap (maybe mempty Sum) . runMaybeT $ do now <- liftIO getCurrentTime - Entity reg CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid - lift $ delete reg - lift . audit $ TransactionCourseParticipantDeleted cid uid + Entity _ CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid + lift $ deregisterParticipant courseParticipantUser courseParticipantCourse case deregisterReason of Just reason | is _Just courseParticipantAllocated ->