Bugfix: deletion deletes files now.

db.hs

@@ -118,7 +118,7 @@ fillDb = do
     , userMailLanguages = MailLanguages ["de"]
     , userNotificationSettings = def
     }
-  void . insert $ User
+  maxMuster <- insert User
     { userIdent  = "max@campus.lmu.de"
     , userAuthentication = AuthLDAP
     , userMatrikelnummer = Nothing
@@ -319,6 +319,12 @@ fillDb = do
   void . insert $ SheetFile sh1 h102 SheetHint
   void . insert $ SheetFile sh1 h103 SheetSolution
   void . insert $ SheetFile sh1 pdf10 SheetExercise
+  --
+  sub1 <- insert $ Submission sh1 Nothing Nothing Nothing Nothing Nothing
+  void . insert $ SubmissionEdit maxMuster (nominalDay `addUTCTime` now) sub1
+  void . insert $ SubmissionUser maxMuster sub1
+  sub1fid1 <- insertFile "AbgabeH10-1.hs"
+  void . insert $ SubmissionFile sub1 sub1fid1 False False
   -- datenbanksysteme
   dbs <- insert' Course
     { courseName = "Datenbanksysteme"

src/Handler/Profile.hs

@@ -182,19 +182,24 @@ postProfileDataR = do
 deleteUser :: UserId -> DB ((Int,Int),Int64) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration
 deleteUser duid = do
     -- E.deleteCount for submissions is not cascading, hence we first select and then delete manually
-    -- Submissions / SubmissionUser
+    -- We delete all files tied to submissions where the user is the lone submissionUser
-    -- TODO: SheetPseudonym ???
+
+    -- Do not deleteCascade submissions where duid is the corrector:
+    updateWhere [SubmissionRatingBy ==. Just duid] [SubmissionRatingBy =. Nothing]
+
     groupSubmissions  <- selectSubmissionsWhere (\numBuddies -> numBuddies E.>.  E.val (0::Int64))
     singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64))
     deleteCascade duid
-    forM_ singleSubmissions $ \(E.Value submissionId) -> deleteCascade submissionId
+    forM_ singleSubmissions $ \(E.Value submissionId) -> do
+      deleteFileIds  <- map E.unValue <$> getSubmissionFiles submissionId
+      deleteCascade submissionId
+      deleteWhere [FileId <-. deleteFileIds] -- TODO: throws exception for de-duplicated files
+
     deletedSubmissionGroups <- deleteSingleSubmissionGroups
     return ((length singleSubmissions, length groupSubmissions),deletedSubmissionGroups)
   where
-    selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool))
+    selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool)) -> DB [E.Value (Key Submission)]
-                              -> ReaderT SqlBackend (HandlerT UniWorX IO) [E.Value (Key Submission)]
+    selectSubmissionsWhere whereBuddies = E.select $ E.from $ \(submission `E.InnerJoin` suser) -> do
-    selectSubmissionsWhere whereBuddies =
-      E.select $ E.from $ \(submission `E.InnerJoin` suser) -> do
         E.on $ submission E.^. SubmissionId E.==. suser E.^. SubmissionUserSubmission
         let numBuddies = E.sub_select $ E.from $ \subUsers -> do
                 E.where_ $ subUsers E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
@@ -204,6 +209,12 @@ deleteUser duid = do
           E.&&.  (whereBuddies numBuddies)
         return $ submission E.^. SubmissionId
 
+    getSubmissionFiles :: SubmissionId ->  DB [E.Value (Key File)]
+    getSubmissionFiles subId = E.select $ E.from $ \file -> do
+      E.where_ $ E.exists $ E.from $ \submissionFile -> do
+          E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
+      return $ file E.^. FileId
+
     deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
       E.where_ $ E.exists $ E.from $ \subGroupUser -> do
           E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId

testdata/AbgabeH10-1.hs

@@ -0,0 +1,3 @@
+Abgabe zu H10-1:
+
+ Ich habe keine Ahnung wie ich die H10-1 lösen soll, sorry!