Revert "fix(ratings): disallow ratings for graded sheets without point value"

This reverts commit 463b2b7878.

messages/uniworx/de.msg

@@ -478,7 +478,6 @@ 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.

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 _ subm@Submission{..}, corrector)] -> do
+    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ 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" & setTooltip sheetType)
+                                (fslpI MsgRatingPoints "Punktezahl")
                                 (Just submissionRatingPoints)
 
       ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
@@ -734,20 +734,22 @@ postCorrectionR tid ssh csh shn cid = do
             , formEncoding = uploadEncoding
             }
 
-      formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do
-        uid <- liftHandlerT requireAuthId
-        now <- liftIO getCurrentTime
+      case corrResult of
+        FormMissing -> return ()
+        FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
+        FormSuccess (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 -> do
-              runDBJobs $ do
+          if
+            | errs <- validateRating sheetType Rating'
+                        { ratingPoints  = ratingPoints'
+                        , ratingComment = ratingComment'
+                        , ratingTime    = (now <$ guard rated)
+                        }
+            , not $ null errs
+              -> mapM_ (addMessageI Error) errs
+            | otherwise -> runDBJobs $ do
                 update sub  [ SubmissionRatingBy      =. Just uid
                             , SubmissionRatingTime    =. (now <$ guard rated)
                             , SubmissionRatingPoints  =. ratingPoints'
@@ -759,29 +761,25 @@ 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
-          heading = MsgCorrectionHead tid ssh csh shn cid
-          headingWgt = [whamlet|
-              $newline never
-              _{heading}
-              $if not (submissionRatingDone subm)
-                \ ^{isVisibleWidget False}
-            |]
-      siteLayout headingWgt $ do
-        setTitleI heading
+      defaultLayout $ do
         let userCorrection = $(widgetFile "correction-user")
         $(widgetFile "correction")
     _ -> notFound

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,11 +67,6 @@ 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)

src/Model/Rating.hs

@@ -31,7 +31,6 @@ 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