feat(corrections): better highlight corrected files

Fixes #602

messages/uniworx/de-de-formal.msg

@@ -361,12 +361,15 @@ SubmissionMembers: Abgebende
 SubmissionMember: Abgebende(r)
 CosubmittorTip: Einladungen per E-Mail erhalten genau jene Adressen, für die nicht gesichert werden kann, dass sie mit der dahinter stehenden Person schon einmal für diesen Kurs abgegeben haben. Wenn eine angegebene Adresse einer Person zugeordnet werden kann, mit der Sie in diesem Kurs schon einmal zusammen abgegeben haben, wird der Name der Person angezeigt und die Abgabe erfolgt sofort auch im Namen jener Person.
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
+SubmissionArchiveCorrected: Zip-Archiv der Abgabedatei(en) inkl. Korrekturen
 SubmissionFile: Datei zur Abgabe
 SubmissionFiles: Abgegebene Dateien
 SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionUsersEmpty: Es kann keine Abgabe ohne Abgebende erstellt werden
 SubmissionUserAlreadyAdded: Dieser Nutzer ist bereits als Mitabgebende(r) eingetragen
 NoOpenSubmissions: Keine unkorrigierten Abgaben vorhanden
+SubmissionFilesCorrected: Abgegebene & Korrigierte Dateien
+RatingUpdatedFiles: Bei der Korrektur wurden Dateien angepasst oder hinzugefügt
 
 SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen?
 SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"}

messages/uniworx/en-eu.msg

@@ -360,12 +360,15 @@ SubmissionMembers: Submittors
 SubmissionMember: Submittor
 CosubmittorTip: Invitations are sent via email to exactly those addresses for which it cannot be determined, that you have already submitted for this course with the associated person, at least once. If one of the specified addresses can be matched to a person with whom you have submitted at least once for this course already, the name of that person will be shown and the submission will immediately be made in their name as well.
 SubmissionArchive: Zip-archive of submission files
+SubmissionArchiveCorrected: Zip-archive of submission files including corrections
 SubmissionFile: Submission file
 SubmissionFiles: Submitted files
 SubmissionAlreadyExistsFor email: #{email} already has a submission for this sheet.
 SubmissionUsersEmpty: Submissions may not be created without submittors.
 SubmissionUserAlreadyAdded: This user is already configured as a submittor
 NoOpenSubmissions: No open submissions exist
+SubmissionFilesCorrected: Submitted & Corrected files
+RatingUpdatedFiles: During correction files were added or changed
 
 SubmissionsDeleteQuestion n: Do you really want to delete the #{pluralEN n "submission" "submissions"} mentioned below?
 SubmissionsDeleted n: #{pluralEN n "Submission" "Submissions"} deleted

src/Foundation.hs

@@ -4048,7 +4048,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) = return
     { navLink = NavLink
       { navLabel       = MsgMenuCorrection
       , navRoute       = CSubmissionR tid ssh csh shn cid CorrectionR
-      , navAccess'     = return True
+      , navAccess'     = hasWriteAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
       , navType        = NavTypeLink { navModal = False }
       , navQuick'      = mempty
       , navForceActive = False

src/Handler/Submission/Correction.hs

@@ -15,6 +15,7 @@ import qualified Data.Text as Text
 import qualified Control.Monad.State.Class as State
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 import qualified Data.Conduit.List as C
 
@@ -29,7 +30,16 @@ correctionData tid ssh csh shn sub = E.select . E.from $ \((course `E.InnerJoin`
        E.&&. course E.^. CourseShorthand  E.==. E.val csh
        E.&&. sheet  E.^. SheetName        E.==. E.val shn
        E.&&. submission E.^. SubmissionId E.==. E.val sub
-  return (course, sheet, submission, corrector)
+  let filesCorrected = E.exists . E.from $ \((f1 `E.InnerJoin` sFile1) `E.LeftOuterJoin` (f2 `E.InnerJoin` sFile2)) -> do
+        E.on $ f2 E.?. FileId E.==. sFile2 E.?. SubmissionFileFile
+        E.on $ E.just (f1 E.^. FileTitle) E.==. f2 E.?. FileTitle
+         E.&&. E.just (sFile1 E.^. SubmissionFileSubmission) E.==. sFile2 E.?. SubmissionFileSubmission
+         -- E.&&. f1 E.^. FileContent E.!=. E.joinV (f2 E.?. FileContent)
+         E.&&. sFile1 E.^. SubmissionFileIsUpdate E.&&. E.maybe E.false E.not_ (sFile2 E.?. SubmissionFileIsUpdate)
+        E.on $ f1 E.^. FileId E.==. sFile1 E.^. SubmissionFileFile
+        E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. submission E.^. SubmissionId
+             E.&&. sFile2 E.?. SubmissionFileSubmission E.==. E.just (submission E.^. SubmissionId)
+  return (course, sheet, submission, corrector, filesCorrected)
 
 getCorrectionR, getCorrectionUserR, postCorrectionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
 getCorrectionR tid ssh csh shn cid = do
@@ -44,7 +54,7 @@ postCorrectionR tid ssh csh shn cid = do
 
   MsgRenderer mr <- getMsgRenderer
   case results of
-    [(Entity cId Course{..}, Entity shId Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
+    [(Entity cId Course{..}, Entity shId Sheet{..}, Entity _ subm@Submission{..}, corrector, E.Value filesCorrected)] -> do
       let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
           pointsForm = case sheetType of
             NotGraded
@@ -144,12 +154,14 @@ postCorrectionR tid ssh csh shn cid = do
 
 
 getCorrectionUserR tid ssh csh shn cid = do
+
+  
   sub <- decrypt cid
 
   results <- runDB $ correctionData tid ssh csh shn sub
 
   case results of
-    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] ->
+    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _), E.Value filesCorrected)] ->
-      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
+      let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
        in defaultLayout $(widgetFile "correction-user")
     _ -> notFound

src/Handler/Submission/Helper.hs

@@ -15,6 +15,7 @@ import Handler.Utils.Invitations
 import Data.Maybe (fromJust)
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlFunction)
 
 import qualified Data.Conduit.Combinators as Conduit
@@ -476,10 +477,12 @@ submissionHelper tid ssh csh shn mcid = do
         | otherwise -> redirect $ CSheetR tid ssh csh shn SShowR
     Nothing  -> return ()
 
+  showCorrection <- fmap (fromMaybe False) . for mcid $ \cid -> hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
+
   -- Maybe construct a table to display uploaded archive files
   let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerFor UniWorX) ())
-      colonnadeFiles cid = mconcat
+      colonnadeFiles cid = mconcat $ catMaybes
-        [ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
+        [ Just . sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
               Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
               origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
               corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
@@ -488,13 +491,14 @@ submissionHelper tid ssh csh shn mcid = do
               | Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
                                                       [whamlet|#{fileTitle'}|]
               | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
-        , sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
+        , guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
             Nothing -> cell mempty
             Just (_, Entity _ File{..})
-              | isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
+              | isJust fileContent ->
-                                                 [whamlet|_{MsgFileCorrected}|]
+                  anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
+                             [whamlet|_{MsgFileCorrected}|]
               | otherwise -> i18nCell MsgCorrected
-        , sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
+        , Just . sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
               origTime = fileModified . entityVal . snd <$> mOrig
               corrTime = fileModified . entityVal . snd <$> mCorr
               Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
@@ -541,10 +545,21 @@ submissionHelper tid ssh csh shn mcid = do
   mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
 
 
-  showCorrection <- fmap (fromMaybe False) . for mcid $ \cid -> hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
+  filesCorrected <- fmap (fromMaybe False) . for msmid $ \subId -> runDB . E.selectExists . E.from $ \((f1 `E.InnerJoin` sFile1) `E.LeftOuterJoin` (f2 `E.InnerJoin` sFile2)) -> do
+    E.on $ f2 E.?. FileId E.==. sFile2 E.?. SubmissionFileFile
+    E.on $ E.just (f1 E.^. FileTitle) E.==. f2 E.?. FileTitle
+     E.&&. E.just (sFile1 E.^. SubmissionFileSubmission) E.==. sFile2 E.?. SubmissionFileSubmission
+     -- E.&&. f1 E.^. FileContent E.!=. E.joinV (f2 E.?. FileContent)
+     E.&&. sFile1 E.^. SubmissionFileIsUpdate E.&&. E.maybe E.false E.not_ (sFile2 E.?. SubmissionFileIsUpdate)
+    E.on $ f1 E.^. FileId E.==. sFile1 E.^. SubmissionFileFile
+    E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. E.val subId
+    E.where_ $ sFile2 E.?. SubmissionFileSubmission E.==. E.just (E.val subId)
 
   let correctionWdgt = guardOnM (showCorrection && maybe False submissionRatingDone msubmission) ((,) <$> msubmission <*> mcid) <&> \(Submission{..}, cid) ->
         let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
+            courseTerm = tid
+            courseSchool = ssh
+            courseShorthand = csh
          in $(widgetFile "correction-user")
         
 

templates/correction-user.hamlet

@@ -40,6 +40,13 @@
                   _{MsgNotPassed}
           $of PassAlways
 
+    $if filesCorrected
+      <tr .table__row>
+        <th .table__th>_{MsgRatingFiles}
+        <td .table__td>
+          <a href=@{CSubmissionR courseTerm courseSchool courseShorthand sheetName cid $ SubArchiveR SubmissionCorrected}>
+            _{MsgRatingUpdatedFiles}
+
     $maybe comment <- ratingComment
       <tr .table__row>
         <th .table__th>_{MsgRatingComment}

templates/submission.hamlet

@@ -12,12 +12,18 @@ $maybe cID <- mcid
           _{MsgSubmissionNoUploadExpected}
       $of _
         <h2>
-          _{MsgSubmissionFiles}
+          $if filesCorrected
+            _{MsgSubmissionFilesCorrected}
+          $else
+            _{MsgSubmissionFiles}
         <p>
-          <a href=@{urlArchive cID}>_{MsgSubmissionArchive}
+          $if showCorrection
-          \ (
+            <a href=@{urlArchive cID}>_{MsgSubmissionArchiveCorrected}
-          <a href=@{urlOriginal cID}>_{MsgSubmissionOriginal}
+            \ (
-          )
+            <a href=@{urlOriginal cID}>_{MsgSubmissionOriginal}
+            )
+          $else
+            <a href=@{urlOriginal cID}>_{MsgSubmissionArchive}
 
         $maybe fileTable <- mFileTable
           ^{fileTable}