diff --git a/messages/de.msg b/messages/de.msg index 6ae62ced3..691a139d1 100644 --- a/messages/de.msg +++ b/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 \ 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 06bab241f..9b1ae65dc 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 @@
^{corrForm} + +
+ + + ^{uploadForm}