Deletion within Submissions

models

@@ -103,8 +103,8 @@ SubmissionFile
     submissionId    SubmissionId
     fileId          FileId 
     isUpdate        Bool
+    isDeletion      Bool
     UniqueSubmissionFile fileId submissionId isUpdate
-    UniqueFile fileId
     deriving Show
 SubmissionUser
     userId          UserId

src/Handler/Submission.hs

@@ -55,11 +55,13 @@ getSubmissionDownloadSingleR cID path = do
         file <- (ratingFile cID' =<<) <$> getRating submissionID
         maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
       False -> do
-        results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOn [E.don $ f E.^. FileTitle] $ do
+        results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
           E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
           E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID)
           E.where_ (f E.^. FileTitle E.==. E.val path)
           E.where_ . E.not_ . E.isNothing $ f E.^. FileContent
+          E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
+          E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
           return f
 
         let fileName = Text.pack $ takeFileName path
@@ -83,6 +85,8 @@ getSubmissionDownloadArchiveR path = do
       Just rating' -> do
         let fileEntitySource = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
               E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
+              E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
+              E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
               return f
             fileEntitySource' :: Source (YesodDB UniWorX) File
             fileEntitySource' = fileEntitySource =$= Conduit.map entityVal >> maybe (return ()) yield (ratingFile cID rating')
@@ -111,8 +115,9 @@ postSubmissionR cID = do
           submissionId' <- runConduit $ fileSource fInfo =$= void consumeZip =$= extractRatings =$= sinkSubmission submissionSheetId userId (Just (submissionId, isUpdate))
           get404 submissionId'
   
-    files <- E.select . E.distinct . E.from $ \(sf `E.InnerJoin` f) -> do
+    files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
       E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
+      E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
       return (f, sf)
     return (submission, files)
 

src/Handler/Utils/Zip/Rating.hs

@@ -33,7 +33,7 @@ import Import hiding ((</>))
 import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
 import Control.Monad.Trans.Maybe
-import Control.Monad.State
+import Control.Monad.State hiding (forM_)
 
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -261,7 +261,7 @@ sinkSubmission sheetId userId mExists = do
     sinkSubmission' :: SubmissionId
                    -> Bool -- ^ Is this a correction
                    -> Sink SubmissionContent (YesodDB UniWorX) ()
-    sinkSubmission' submissionId isUpdate = evalStateLC mempty . Conduit.mapM_ $ \case
+    sinkSubmission' submissionId isUpdate = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
       Left file@(File{..}) -> do
         alreadySeen <- gets (Set.member fileTitle . sinkFilenames)
         when alreadySeen . throwM $ DuplicateFileTitle fileTitle
@@ -272,11 +272,12 @@ sinkSubmission sheetId userId mExists = do
           E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId
           E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
           E.where_ $ f E.^. FileTitle E.==. E.val fileTitle -- 'Zip.hs' normalises filenames already, so this should work
-          return f
+          return (f, sf)
 
         let anyChanges
-              | not (null collidingFiles) = any ((/= file) . entityVal) collidingFiles
+              | not (null collidingFiles) = any (/= file) [ f | (Entity _ f, _) <- collidingFiles ]
               | otherwise                 = True
+            undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ]
         -- The Eq Instance for File compares modification time exactly even
         -- though zip archives have very limited accuracy and range regarding
         -- timestamps.
@@ -297,13 +298,18 @@ sinkSubmission sheetId userId mExists = do
         when anyChanges $ do
           touchSubmission
           when (not $ null collidingFiles) $
-            lift $ deleteCascadeWhere [ FileId <-. map entityKey collidingFiles ]
+            lift $ deleteCascadeWhere [ FileId <-. [ fId | (Entity fId _, _) <- collidingFiles ] ]
           fileId <- lift $ insert file
           lift . insert_ $ SubmissionFile
             { submissionFileSubmissionId = submissionId
             , submissionFileFileId = fileId
             , submissionFileIsUpdate = isUpdate
+            , submissionFileIsDeletion = False
             }
+        when undoneDeletion $ do
+          touchSubmission
+          lift $ deleteWhere [ SubmissionFileId <-. [ sfId | (_, Entity sfId sf) <- collidingFiles, submissionFileIsDeletion sf ] ]
+  
       Right (submissionId', Rating'{..}) -> do
         unless (submissionId' == submissionId) $ throwM ForeignRating
         
@@ -313,7 +319,7 @@ sinkSubmission sheetId userId mExists = do
 
         unless isUpdate $ throwM RatingWithoutUpdate
 
-        s@(Submission{..}) <- lift $ getJust submissionId
+        Submission{..} <- lift $ getJust submissionId
 
         let anyChanges = or $ 
               [ submissionRatingPoints /= ratingPoints
@@ -341,3 +347,45 @@ sinkSubmission sheetId userId mExists = do
               True  -> [ SubmissionRatingBy =. Just userId, SubmissionRatingTime =. Just now ]
             tell $ mempty{ sinkSubmissionTouched = Any True }
 
+        finalize :: SubmissionSinkState -> YesodDB UniWorX ()
+        finalize SubmissionSinkState{..} = do
+          missingFiles <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
+            E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId
+            E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId
+            when (not isUpdate) $
+              E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
+            E.where_ $ f E.^. FileTitle `E.notIn` E.valList (Set.toList sinkFilenames)
+            E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
+
+            return (f, sf)
+
+          case isUpdate of
+            False -> deleteCascadeWhere [ FileId <-. [ fileId | (Entity fileId _, _) <- missingFiles ] ]
+            True  -> forM_ missingFiles $ \(Entity fileId File{..}, Entity sfId SubmissionFile{..}) -> do
+              shadowing <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
+                E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId
+                E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId
+                E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val (not isUpdate)
+                E.where_ $ f E.^. FileTitle E.==. E.val fileTitle
+                return $ f E.^. FileId
+
+              case (shadowing, submissionFileIsUpdate) of
+                ([], _) -> deleteCascade fileId
+                (E.Value f:_, False) -> do
+                  insert_ $ SubmissionFile
+                    { submissionFileSubmissionId = submissionId
+                    , submissionFileFileId = f
+                    , submissionFileIsUpdate = True
+                    , submissionFileIsDeletion = True
+                    }
+                (E.Value f:_, True) -> do
+                  update sfId [ SubmissionFileFileId =. f, SubmissionFileIsDeletion =. True ]
+                  deleteCascade fileId
+
+          when (isUpdate && not (getAny sinkSeenRating)) $
+            update submissionId
+              [ SubmissionRatingTime =. Nothing
+              , SubmissionRatingPoints =. Nothing
+              , SubmissionRatingBy =. Nothing
+              , SubmissionRatingComment =. Nothing
+              ]

templates/submission.hamlet

@@ -36,10 +36,19 @@
         <form role=form method=post action=@{SubmissionR cID} enctype=#{uploadEnctype} .panel-body>
           ^{uploadWidget}
 
-<div .list-group>
+<div .panel .panel-default>
-  $forall (Entity _ file, Entity _ sFile) <- files
+  <div .panel-heading>
-    <a href=@{SubmissionDownloadSingleR cID $ fileTitle file} download .list-group-item>
+    Files & Directories
-      #{fileTitle file}
+  <div .list-group .panel-body>
-      $if submissionFileIsUpdate sFile
+    $forall (Entity _ file, Entity _ sFile) <- files
-        <span .badge>Korrigiert
+      $if submissionFileIsDeletion sFile
+        <span .list-group-item>
+          #{fileTitle file}&nbsp;
+          <span .label .label-warning>Gelöscht
+      $else
+        <a href=@{SubmissionDownloadSingleR cID $ fileTitle file} download .list-group-item>
+          #{fileTitle file}
+          $if submissionFileIsUpdate sFile
+            &nbsp;
+            <span .label .label-primary>Korrigiert