From 115eaa70f2f61110650214e26ded31ed5ddd951c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 3 Jul 2018 16:47:55 +0200
Subject: [PATCH] Work on single correction upload

---
 messages/de.msg             |  6 +++++-
 src/Handler/Corrections.hs  | 39 ++++++++++++++++++++++++++++++++++---
 src/Handler/Utils/Form.hs   |  2 +-
 templates/correction.hamlet |  5 +++++
 4 files changed, 47 insertions(+), 5 deletions(-)

diff --git a/messages/de.msg b/messages/de.msg
index b9eb9af92..8e7c23ec8 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -159,9 +159,13 @@ RatingTime: Korrigiert
 RatingComment: Kommentar
 
 RatingPoints: Punkte
+RatingFiles: Korrigierte Dateien
 PointsNotPositive: Punktzahl darf nicht negativ sein
 
 FileTitle: Dateiname
 FileModified: Letzte Änderung
 
-FileCorrected: Korrigiert
\ No newline at end of file
+FileCorrected: Korrigiert
+RatingUpdated: Korrektur gespeichert
+RatingDeleted: Korrektur zurückgesetzt
+RatingFilesUpdated: Korrigierte Dateien überschrieben
\ No newline at end of file
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index ad2ee77c1..013b85066 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -368,12 +368,45 @@ postCorrectionR tid csh shn cid = do
     [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector)] -> do
       let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
 
-      now <- liftIO getCurrentTime
-      ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ Rating'
+      ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,)
         <$> aopt pointsField (fslI MsgRatingPoints) (Just $ submissionRatingPoints)
-        <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment)) 
+        <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
         <* submitButton
 
+      ((uploadResult, uploadForm), uploadEncoding) <- runFormPost . identForm FIDcorrectionUpload . renderAForm FormStandard $
+            areq (zipFileField True) (fslI MsgRatingFiles) Nothing
+        <*  submitButton
+
+      case corrResult of
+        FormMissing -> return ()
+        FormFailure errs -> mapM_ (addMessage "error" . toHtml) errs
+        FormSuccess (ratingPoints, ratingComment) -> do
+          runDB $ do
+            uid <- liftHandlerT requireAuthId
+            now <- liftIO getCurrentTime
+
+            let rated = isJust $ void ratingPoints <|> void ratingComment
+          
+            update sub [ SubmissionRatingBy =. (uid <$ guard rated)
+                       , SubmissionRatingTime =. (now <$ guard rated)
+                       , SubmissionRatingPoints =. ratingPoints
+                       , SubmissionRatingComment =. ratingComment
+                       ]
+
+            addMessageI "success" $ bool MsgRatingDeleted MsgRatingUpdated rated
+          redirect $ CSubmissionR tid csh shn cid CorrectionR
+
+      case uploadResult of
+        FormMissing -> return ()
+        FormFailure errs -> mapM_ (addMessage "error" . toHtml) errs
+        FormSuccess fileSource -> do
+          uid <- requireAuthId
+          
+          runDB . runConduit $ transPipe lift fileSource .| extractRatings .| sinkSubmission uid (Right sub) True
+
+          addMessageI "success" MsgRatingFilesUpdated
+          redirect $ CSubmissionR tid csh shn cid CorrectionR
+
       defaultLayout $ do
         let userCorrection = $(widgetFile "correction-user")
         $(widgetFile "correction")
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 3b0d963a4..01c56040c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -56,7 +56,7 @@ import Text.Read (readMaybe)
 -- Unique Form Identifiers to avoid accidents --
 ------------------------------------------------
 
-data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors | FIDcorrectorTable | FIDcorrection | FIDcorrectionsUpload
+data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors | FIDcorrectorTable | FIDcorrection | FIDcorrectionsUpload | FIDcorrectionUpload
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
 
 
diff --git a/templates/correction.hamlet b/templates/correction.hamlet
index f079d7d13..e26dbe7c4 100644
--- a/templates/correction.hamlet
+++ b/templates/correction.hamlet
@@ -4,3 +4,8 @@
   
 <form method=post enctype=#{corrEncoding}>
   ^{corrForm}
+
+<hr>
+  
+<form method=post enctype=#{uploadEncoding}>
+  ^{uploadForm}