feat(corrections): better highlight corrected files

Fixes #602
2020-06-27 15:39:16 +02:00 · 2020-06-27 15:39:16 +02:00 · 46ce477235
commit 46ce477235
parent b0a81b2798
7 changed files with 63 additions and 17 deletions
--- a/messages/uniworx/de-de-formal.msg
+++ b/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"}
--- a/messages/uniworx/en-eu.msg
+++ b/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
--- a/src/Foundation.hs
+++ b/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
--- a/src/Handler/Submission/Correction.hs
+++ b/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 _))] ->
-      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
+    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _), E.Value filesCorrected)] ->
+      let ratingComment = assertM (not . null) $ Text.strip <$> submissionRatingComment
       in defaultLayout $(widgetFile "correction-user")
    _ -> notFound
--- a/src/Handler/Submission/Helper.hs
+++ b/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
-        [ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
+      colonnadeFiles cid = mconcat $ catMaybes
+        [ 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)
-                                                 [whamlet|_{MsgFileCorrected}|]
+              | isJust fileContent ->
+                  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")
        

--- a/templates/correction-user.hamlet
+++ b/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}
--- a/templates/submission.hamlet
+++ b/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}
-          \ (
-          <a href=@{urlOriginal cID}>_{MsgSubmissionOriginal}
-          )
+          $if showCorrection
+            <a href=@{urlArchive cID}>_{MsgSubmissionArchiveCorrected}
+            \ (
+            <a href=@{urlOriginal cID}>_{MsgSubmissionOriginal}
+            )
+          $else
+            <a href=@{urlOriginal cID}>_{MsgSubmissionArchive}

        $maybe fileTable <- mFileTable
          ^{fileTable}