From 27731ac077ae6eee31eeb5cd39d24b0a0ea8f490 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 8 May 2020 10:57:43 +0200 Subject: [PATCH] fix(submission-multi-archive): fix cleanup & improve --- messages/uniworx/de-de-formal.msg | 4 ++++ messages/uniworx/en-eu.msg | 4 ++++ src/Handler/Utils/Submission.hs | 40 ++++++++++++++++++++----------- 3 files changed, 34 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 069fe1ee2..a6bd3cfb1 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index bf7f2964c..d25315ede 100644 --- a/messages/uniworx/en-eu.msg +++ b/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 diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 32ba42074..7e1e79356 100644 --- a/src/Handler/Utils/Submission.hs +++ b/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) -> - maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 5) courseSheetInfo)) =<< getRating submissionId + forM submissions $ \(s@(Entity submissionId _), E.Value sTime, courseSheetInfo) -> + 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 - setContentDisposition' $ Just ((addExtension `on` unpack) archiveName extensionZip) - (<* cleanup) . respondSource typeZip . transPipe (runDBRunner dbrunner) $ do + let + archiveName = case (Set.toList setTerm, Set.toList setSchool, Set.toList setCourse, Set.toList setSheet) of + ([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 submissionID Submission{..},(shn,csh,ssh,tid,sheetAnonymous)) = do + fileEntitySource' :: (Rating, Entity Submission, Maybe UTCTime, (SheetName,CourseShorthand,SchoolId,TermId,Bool)) -> ConduitT () File (YesodDB UniWorX) () + 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] - lastEditTime <- case lastEditMb of - [(submissionEditTime.entityVal -> time)] -> return time - _other -> liftIO getCurrentTime + fileModified <- maybe (liftIO getCurrentTime) return subTime yield $ File - { fileModified = lastEditTime + { fileModified , fileTitle = directoryName , fileContent = Nothing }