Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

messages/de.msg

@@ -163,9 +163,13 @@ RatingTime: Korrigiert
 RatingComment: Kommentar
 
 RatingPoints: Punkte
+RatingFiles: Korrigierte Dateien
 PointsNotPositive: Punktzahl darf nicht negativ sein
 
 FileTitle: Dateiname
 FileModified: Letzte Änderung
 
 FileCorrected: Korrigiert
+RatingUpdated: Korrektur gespeichert
+RatingDeleted: Korrektur zurückgesetzt
+RatingFilesUpdated: Korrigierte Dateien überschrieben

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 $ (,)
-      ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ Rating'
         <$> aopt pointsField (fslI MsgRatingPoints) (Just $ submissionRatingPoints)
         <*> (((\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")

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)
 
 

templates/correction.hamlet

@@ -4,3 +4,8 @@
   
 <form method=post enctype=#{corrEncoding}>
   ^{corrForm}
+
+<hr>
+  
+<form method=post enctype=#{uploadEncoding}>
+  ^{uploadForm}