fix(submission-multi-archive): fix cleanup & improve

messages/uniworx/de-de-formal.msg

@@ -601,6 +601,10 @@ SelfCorrectors num@Int64: #{num} Abgaben wurden Abgebenden als eigenem Korrektor
 SubmissionOriginal: Original
 SubmissionCorrected: Korrigiert
 SubmissionArchiveName: abgaben
+SubmissionTermArchiveName tid@TermId: #{foldCase (termToText (unTermKey tid))}-abgaben
+SubmissionTermSchoolArchiveName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-abgaben
+SubmissionTermSchoolCourseArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-#{foldCase csh}-abgaben
+SubmissionTermSchoolCourseSheetArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-#{foldCase csh}-#{foldCase shn}-abgaben
 SubmissionTypeArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName subId@CryptoFileNameSubmission renderedSfType@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-#{foldCase (toPathPiece subId)}-#{foldCase renderedSfType}
 
 CorrectionSheets: Übersicht Korrekturen nach Blättern

messages/uniworx/en-eu.msg

@@ -599,6 +599,10 @@ SelfCorrectors num: #{num} #{pluralEN num "correction was" "corrections were"} a
 SubmissionOriginal: Original
 SubmissionCorrected: Marked
 SubmissionArchiveName: submissions
+SubmissionTermArchiveName tid: #{foldCase (termToText (unTermKey tid))}-submissions
+SubmissionTermSchoolArchiveName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-submissions
+SubmissionTermSchoolCourseArchiveName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-#{foldCase csh}-submissions
+SubmissionTermSchoolCourseSheetArchiveName tid ssh csh shn: #{foldCase (termToText (unTermKey tid))}-#{foldCase (unSchoolKey ssh)}-#{foldCase csh}-#{foldCase shn}-submissions
 SubmissionTypeArchiveName tid ssh csh shn subId renderedSfType: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-#{foldCase (toPathPiece subId)}-#{foldCase renderedSfType}
 
 CorrectionSheets: Corrections by sheet

src/Handler/Utils/Submission.hs

@@ -291,20 +291,35 @@ submissionMultiArchive anonymous (Set.toList -> ids) = do
       E.on $ sheet E.^. SheetId     E.==. submission E.^. SubmissionSheet
       E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
       E.where_ $ submission E.^. SubmissionId `E.in_` E.valList ids
-      return (submission, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm, sheet E.^. SheetAnonymousCorrection))
+      let subTime = E.subSelectMaybe . E.from $ \submissionEdit -> do
+            E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
+            return . E.max_ $ submissionEdit E.^. SubmissionEditTime
+      return (submission, subTime, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm, sheet E.^. SheetAnonymousCorrection))
 
-    forM submissions $ \(s@(Entity submissionId _), courseSheetInfo) ->
+    forM submissions $ \(s@(Entity submissionId _), E.Value sTime, courseSheetInfo) ->
-       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 5) courseSheetInfo)) =<< getRating submissionId
+       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, sTime, $(E.unValueN 5) courseSheetInfo)) =<< getRating submissionId
   let (setSheet,setCourse,setSchool,setTerm) =
-        execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid,_anon)) ->
+        execWriter . forM ratedSubmissions $ \(_rating,_submission,_subTime,(shn,csh,ssh,tid,_anon)) ->
           tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
 
-  archiveName <- ap getMessageRender $ pure MsgSubmissionArchiveName
+  let
-  setContentDisposition' $ Just ((addExtension `on` unpack) archiveName extensionZip)
+    archiveName = case (Set.toList setTerm, Set.toList setSchool, Set.toList setCourse, Set.toList setSheet) of
-  (<* cleanup) . respondSource typeZip . transPipe (runDBRunner dbrunner) $ do
+      ([tid], [ssh], [csh], [shn])
+        ->  MsgSubmissionTermSchoolCourseSheetArchiveName tid ssh csh shn
+      ([tid], [ssh], [csh], _)
+        -> MsgSubmissionTermSchoolCourseArchiveName tid ssh csh
+      ([tid], [ssh], _, _)
+        ->  MsgSubmissionTermSchoolArchiveName tid ssh
+      ([tid], _, _, _)
+        -> MsgSubmissionTermArchiveName tid
+      _other
+        -> MsgSubmissionArchiveName
+  MsgRenderer mr <- getMsgRenderer
+  setContentDisposition' $ Just ((addExtension `on` unpack) (mr archiveName) extensionZip)
+  respondSource typeZip . (<* lift cleanup) . transPipe (runDBRunner dbrunner) $ do
     let
-      fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId,Bool)) -> ConduitT () File (YesodDB UniWorX) ()
+      fileEntitySource' :: (Rating, Entity Submission, Maybe UTCTime, (SheetName,CourseShorthand,SchoolId,TermId,Bool)) -> ConduitT () File (YesodDB UniWorX) ()
-      fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid,sheetAnonymous)) = do
+      fileEntitySource' (rating, Entity submissionID Submission{..}, subTime, (shn,csh,ssh,tid,sheetAnonymous)) = do
         cID <- encrypt submissionID
 
         let
@@ -356,12 +371,9 @@ submissionMultiArchive anonymous (Set.toList -> ids) = do
 
           withinDirectory f@File{..} = f { fileTitle = directoryName </> fileTitle }
 
-        lastEditMb <- lift $ selectList [SubmissionEditSubmission ==. submissionID] [Desc SubmissionEditTime, LimitTo 1]
+        fileModified <- maybe (liftIO getCurrentTime) return subTime
-        lastEditTime <- case lastEditMb of
-          [(submissionEditTime.entityVal -> time)] -> return time
-          _other -> liftIO getCurrentTime
         yield $ File
-          { fileModified = lastEditTime
+          { fileModified
           , fileTitle = directoryName
           , fileContent = Nothing
           }