diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 455b57773..cd7300b09 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -474,6 +474,7 @@ RatingNegative: Bewertungspunkte dürfen nicht negativ sein RatingExceedsMax: Bewertung übersteigt die erlaubte Maximalpunktzahl RatingNotExpected: Keine Bewertungen erlaubt RatingBinaryExpected: Bewertung muss 0 (=durchgefallen) oder 1 (=bestanden) sein +RatingPointsRequired: Bewertung erfordert für dieses Blatt eine Punktzahl SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file} kommt mehrfach im Zip-Archiv vor SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden. diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index bc46eb157..81335f4ac 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -710,12 +710,12 @@ postCorrectionR tid ssh csh shn cid = do results <- runDB $ correctionData tid ssh csh shn sub case results of - [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector)] -> do + [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) pointsForm = case sheetType of NotGraded -> pure Nothing _otherwise -> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) - (fslpI MsgRatingPoints "Punktezahl") + (fslpI MsgRatingPoints "Punktezahl" & setTooltip sheetType) (Just submissionRatingPoints) ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,) @@ -734,22 +734,20 @@ postCorrectionR tid ssh csh shn cid = do , formEncoding = uploadEncoding } - case corrResult of - FormMissing -> return () - FormFailure errs -> mapM_ (addMessage Error . toHtml) errs - FormSuccess (rated, ratingPoints', ratingComment') -> do - uid <- liftHandlerT requireAuthId - now <- liftIO getCurrentTime + formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do + uid <- liftHandlerT requireAuthId + now <- liftIO getCurrentTime - if - | errs <- validateRating sheetType Rating' - { ratingPoints = ratingPoints' - , ratingComment = ratingComment' - , ratingTime = (now <$ guard rated) - } - , not $ null errs - -> mapM_ (addMessageI Error) errs - | otherwise -> runDBJobs $ do + if + | errs <- validateRating sheetType Rating' + { ratingPoints = ratingPoints' + , ratingComment = ratingComment' + , ratingTime = (now <$ guard rated) + } + , not $ null errs + -> mapM_ (addMessageI Error) errs + | otherwise -> do + runDBJobs $ do update sub [ SubmissionRatingBy =. Just uid , SubmissionRatingTime =. (now <$ guard rated) , SubmissionRatingPoints =. ratingPoints' @@ -761,25 +759,29 @@ postCorrectionR tid ssh csh shn cid = do when (rated && isNothing submissionRatingTime) $ do $logDebugS "CorrectionR" [st|Rated #{tshow sub}|] queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub - - redirect $ CSubmissionR tid ssh csh shn cid CorrectionR - - case uploadResult of - FormMissing -> return () - FormFailure errs -> mapM_ (addMessage Error . toHtml) errs - FormSuccess fileUploads -> do - uid <- requireAuthId - - res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True - case res of - Nothing -> return () -- ErrorMessages are already added by msgSubmissionErrors - (Just _) -> do - addMessageI Success MsgRatingFilesUpdated redirect $ CSubmissionR tid ssh csh shn cid CorrectionR + formResult uploadResult $ \fileUploads -> do + uid <- requireAuthId + + res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True + case res of + Nothing -> return () -- ErrorMessages are already added by msgSubmissionErrors + (Just _) -> do + addMessageI Success MsgRatingFilesUpdated + redirect $ CSubmissionR tid ssh csh shn cid CorrectionR + mr <- getMessageRender let sheetTypeDesc = mr sheetType - defaultLayout $ do + heading = MsgCorrectionHead tid ssh csh shn cid + headingWgt = [whamlet| + $newline never + _{heading} + $if not (submissionRatingDone subm) + \ ^{isVisibleWidget False} + |] + siteLayout headingWgt $ do + setTitleI heading let userCorrection = $(widgetFile "correction-user") $(widgetFile "correction") _ -> notFound diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 2e980312f..472e49950 100644 --- a/src/Handler/Utils/Rating.hs +++ b/src/Handler/Utils/Rating.hs @@ -56,7 +56,7 @@ instance Pretty SheetGrading where validateRating :: SheetType -> Rating' -> [RatingException] -validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..} +validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. } | rp < 0 = [RatingNegative] | NotGraded <- ratingSheetType @@ -67,6 +67,11 @@ validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..} | (Just PassBinary) <- ratingSheetType ^? _grading , not (rp == 0 || rp == 1) = [RatingBinaryExpected] +validateRating ratingSheetType Rating'{ .. } + | has _grading ratingSheetType + , is _Nothing ratingPoints + , isn't _Nothing ratingTime + = [RatingPointsRequired] validateRating _ _ = [] getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating) diff --git a/src/Model/Rating.hs b/src/Model/Rating.hs index c7b4e910f..295d275eb 100644 --- a/src/Model/Rating.hs +++ b/src/Model/Rating.hs @@ -31,6 +31,7 @@ data RatingException = RatingNotUnicode UnicodeException -- ^ Rating failed to p | RatingExceedsMax -- ^ Rating point must not exceed maximum points | RatingNotExpected -- ^ Rating not expected | RatingBinaryExpected -- ^ Rating must be 0 or 1 + | RatingPointsRequired -- ^ Rating without points for sheet that requires there to be points deriving (Show, Eq, Generic, Typeable) instance Exception RatingException diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 9db97efb6..2fdc1b3de 100644 --- a/templates/default-layout.lucius +++ b/templates/default-layout.lucius @@ -502,7 +502,7 @@ ul.list--inline { @media (min-width: 768px) { .deflist { - grid-template-columns: max-content minmax(auto, max-content); + grid-template-columns: max-content minmax(0, max-content); .deflist { margin-top: -10px; @@ -580,7 +580,7 @@ section { justify-content: center; } } - + .form-group__input > .notification { margin: 0; }