Deletion within Submissions

2017-10-12 04:37:29 +02:00 · 2017-10-12 04:37:29 +02:00 · 76c9e61167
commit 76c9e61167
parent 264ea52b58
4 changed files with 78 additions and 16 deletions
--- a/2
+++ b/2
@ -103,8 +103,8 @@ SubmissionFile
    submissionId    SubmissionId
    fileId          FileId 
    isUpdate        Bool
+    isDeletion      Bool
    UniqueSubmissionFile fileId submissionId isUpdate
-    UniqueFile fileId
    deriving Show
 SubmissionUser
    userId          UserId
--- a/src/Handler/Submission.hs
+++ b/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)

--- a/src/Handler/Utils/Zip/Rating.hs
+++ b/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
+              ]
--- a/templates/submission.hamlet
+++ b/templates/submission.hamlet
@ -35,11 +35,20 @@
          Replace
        <form role=form method=post action=@{SubmissionR cID} enctype=#{uploadEnctype} .panel-body>
          ^{uploadWidget}
-  
-<div .list-group>
-  $forall (Entity _ file, Entity _ sFile) <- files
-    <a href=@{SubmissionDownloadSingleR cID $ fileTitle file} download .list-group-item>
-      #{fileTitle file}
-      $if submissionFileIsUpdate sFile
-        <span .badge>Korrigiert
+
+<div .panel .panel-default>
+  <div .panel-heading>
+    Files & Directories
+  <div .list-group .panel-body>
+    $forall (Entity _ file, Entity _ sFile) <- files
+      $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