Löschen von festen Abgabegruppen implementiert.

This commit is contained in:
SJost 2018-10-17 10:53:53 +02:00
parent 832c007027
commit 2634774eef
2 changed files with 18 additions and 3 deletions

View File

@ -163,7 +163,7 @@ postProfileDataR = do
case btnResult of case btnResult of
(FormSuccess BtnDelete) -> do (FormSuccess BtnDelete) -> do
(uid, User{..}) <- requireAuthPair (uid, User{..}) <- requireAuthPair
(deletedSubmissions,groupSubmissions) <- runDB $ deleteUser uid ((deletedSubmissions,groupSubmissions),deletedSubmissionGroups) <- runDB $ deleteUser uid
-- addMessageI Success $ MsgDeleteUser deletedSubmissions -- addMessageI Success $ MsgDeleteUser deletedSubmissions
-- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions -- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
--TODO: LogOut user --TODO: LogOut user
@ -177,7 +177,7 @@ postProfileDataR = do
deleteUser :: UserId -> DB (Int,Int) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration deleteUser :: UserId -> DB ((Int,Int),Int64) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration
deleteUser duid = do deleteUser duid = do
-- E.deleteCount for submissions is not cascading, hence we first select and then delete manually -- E.deleteCount for submissions is not cascading, hence we first select and then delete manually
-- Submissions / SubmissionUser -- Submissions / SubmissionUser
@ -187,7 +187,8 @@ deleteUser duid = do
singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64)) singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64))
deleteCascade duid deleteCascade duid
forM_ singleSubmissions $ \(E.Value submissionId) -> deleteCascade submissionId forM_ singleSubmissions $ \(E.Value submissionId) -> deleteCascade submissionId
return (length singleSubmissions, length groupSubmissions) deletedSubmissionGroups <- deleteSingleSubmissionGroups
return ((length singleSubmissions, length groupSubmissions),deletedSubmissionGroups)
where where
selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool)) selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool))
-> ReaderT SqlBackend (HandlerT UniWorX IO) [E.Value (Key Submission)] -> ReaderT SqlBackend (HandlerT UniWorX IO) [E.Value (Key Submission)]
@ -202,6 +203,17 @@ deleteUser duid = do
E.&&. (whereBuddies numBuddies) E.&&. (whereBuddies numBuddies)
return $ submission E.^. SubmissionId return $ submission E.^. SubmissionId
deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
E.where_ $ E.exists $ E.from $ \subGroupUser -> do
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
E.where_ $ E.notExists $ E.from $ \subGroupUser -> do
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
getProfileDataR :: Handler Html getProfileDataR :: Handler Html

View File

@ -8,4 +8,7 @@
aber die Zuordnung zum Benutzer wurden gelöscht. aber die Zuordnung zum Benutzer wurden gelöscht.
Gruppenabgaben können dadurch zu Einzelabgaben werden, Gruppenabgaben können dadurch zu Einzelabgaben werden,
welche dann vom letzten Benutzer gelöscht werden können. welche dann vom letzten Benutzer gelöscht werden können.
$if deletedSubmissionGroups > 0
<div .container>
#{display deletedSubmissionGroups} benannte Abgabengruppen wurden gelöscht, da diese dadurch leer wurden.