feat(ratings): parsing for new format

frontend/src/app.sass

@@ -826,7 +826,7 @@ section
   .allocation-course__application-label
     padding-top: 0
 
-.comment
+.comment, .literal-error
   white-space: pre-wrap
   font-family: monospace
 

messages/uniworx/de-de-formal.msg

@@ -686,20 +686,27 @@ RatingUpdated: Korrektur gespeichert
 RatingDeleted: Korrektur zurückgesetzt
 RatingFilesUpdated: Korrigierte Dateien überschrieben
 
-RatingNotUnicode uexc@UnicodeException: Bewertungsdatei nicht in UTF-8 kodiert: #{tshow uexc}
+RatingNotUnicode: Bewertungsdatei konnte nicht als UTF-8 dekodiert werden:
 RatingMissingSeparator: Präambel der Bewertungsdatei konnte nicht identifziert werden
 RatingMultiple: Bewertungen enthält mehrere Punktzahlen für die gleiche Abgabe
-RatingInvalid parseErr@Text: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
+RatingInvalid: Bewertungspunktzahl konnte nicht als Zahl verstanden werden:
 RatingFileIsDirectory: Bewertungsdatei ist unerlaubterweise ein Verzeichnis
-RatingParseLegacyException renderedLegacyException@Text: Beim Interpretieren als Bewertungsdatei im veralteten Format: #{renderedLegacyException}
+RatingParseException: Beim Interpretieren als Bewertungsdatei im YAML-basierten Format:
+RatingParseLegacyException: Beim Interpretieren als Bewertungsdatei im veralteten Format:
 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
 RatingFile: Bewertungsdatei
-RatingFileException file@FilePath ratingException@Text: Beim Verarbeiten von Bewertungsdatei „#{file}“ ist folgender Fehler aufgetreten: #{ratingException}
+RatingFileException file@FilePath: Beim Verarbeiten von Bewertungsdatei „#{file}“ ist folgender Fehler aufgetreten:
-RatingSubmissionException smid@CryptoFileNameSubmission ratingException@Text: Beim Verarbeiten der Bewertungsdatei für Abgabe „#{toPathPiece smid}“ ist folgender Fehler aufgetreten: #{ratingException}
+RatingSubmissionException smid@CryptoFileNameSubmission: Beim Verarbeiten der Bewertungsdatei für Abgabe „#{toPathPiece smid}“ ist folgender Fehler aufgetreten:
+RatingYAMLExceptionBeforeComment: Beim Interpretieren des YAML-Teils (zum Abtrennen des Kommentars) ist folgender Fehler aufgetreten:
+RatingYAMLException: Beim Interpretieren des YAML-Teils ist folgender Fehler aufgetreten:
+RatingYAMLCommentNotUnicode: Der enthaltene Kommentar konnte nicht als UTF-8 dekodiert werden:
+RatingYAMLStreamTerminatedUnexpectedly: Event-Stream unerwartet abgebrochen
+RatingYAMLDocumentEndIllDefined: Position des Endes des YAML-Teils nicht wohldefiniert
+RatingSubmissionIDIncorrect: Die in der Bewertungsdatei enthaltene Abgabenummer passt nicht zum Dateinamen
 
 SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{file} kommt mehrfach im Zip-Archiv vor
 SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden.
@@ -2625,3 +2632,4 @@ RatingYAMLChangePointsComment: TODO: Hier die Punktezahl statt null eintragen (b
 RatingYAMLChangePassedComment: TODO: Hier true oder false statt null eintragen (true entspricht Bestanden)
 RatingYAMLChangeDoneComment: TODO: Von false auf true setzen, sobald Bewertung abgeschlossen; sonst Korrektur für die Studierenden nicht sichtbar und keine Anrechnung auf Klausurbonus
 RatingYAMLChangeCommentComment: TODO: Korrektur-Kommentar für die Studierenden unterhalb der Abtrennung (...) eintragen
+RatingYAMLSubmissionIdComment: Abgabenummer; wird beim Hochladen mit dem Dateinamen abgeglichen

messages/uniworx/en-eu.msg

@@ -683,20 +683,27 @@ RatingUpdated: Successfully updated correction
 RatingDeleted: Successfully reset correction
 RatingFilesUpdated: Corrected files successfully overwritten
 
-RatingNotUnicode uexc: Marking file is not UTF-8 encoded: #{tshow uexc}
+RatingNotUnicode: Marking file could not be UTF-8 decoded:
 RatingMissingSeparator: Preamble of the marking file could not be identified
 RatingMultiple: Correction contains multiple markings
-RatingInvalid parseErr: Marking points could not be parsed as a number: #{parseErr}
+RatingInvalid: Marking points could not be parsed as a number:
 RatingFileIsDirectory: Marking file must not be a directory
-RatingParseLegacyException renderedLegacyException: While parsing as a rating file in legacy format: #{renderedLegacyException}
+RatingParseException: While parsing as a rating file in the YAML-based format:
+RatingParseLegacyException: While parsing as a rating file in legacy format:
 RatingNegative: Marking points may not be negative
 RatingExceedsMax: Marking points exceed maximum
 RatingNotExpected: No marking points expected for this sheet
 RatingBinaryExpected: Marking must be 0 (=failed) or 1(=passed)
 RatingPointsRequired: Marking points required for this sheet
 RatingFile: Marking file
-RatingFileException file ratingException: While processing the rating file “#{file}” the following error occurred: #{ratingException}
+RatingFileException file: While processing the rating file “#{file}” the following error occurred:
-RatingSubmissionException smid ratingException: While processing the rating file for the submission “#{toPathPiece smid}” the following error occurred: #{ratingException}
+RatingSubmissionException smid: While processing the rating file for the submission “#{toPathPiece smid}” the following error occurred:
+RatingYAMLExceptionBeforeComment: While parsing the YAML part (to separate out the rating comment) the following error occurred:
+RatingYAMLException: While parsing the YAML part the following error occurred:
+RatingYAMLCommentNotUnicode: The contained rating comment could not be UTF-8 decoded:
+RatingYAMLStreamTerminatedUnexpectedly: Event stream terminated unexpectedly
+RatingYAMLDocumentEndIllDefined: End of YAML part has no well defined position
+RatingSubmissionIDIncorrect: The submission id contained within the rating file does not match it's name
 
 SubmissionSinkExceptionDuplicateFileTitle file: File #{show file} occurs multiple files within zip-archive.
 SubmissionSinkExceptionDuplicateRating: Found more than one marking file
@@ -2625,3 +2632,4 @@ RatingYAMLChangePointsComment: TODO: Insert number of points instead of null (up
 RatingYAMLChangePassedComment: TODO: Set true or false instead of null (true means passed)
 RatingYAMLChangeDoneComment: TODO: Set to true instead of false, when correction is finished; otherwise correction will not be visible to students and won't be counted for exam bonus
 RatingYAMLChangeCommentComment: TODO: Enter correction comment after the separator below (...)
+RatingYAMLSubmissionIdComment: Submission id; will be compared to the filename during upload

src/Foundation/I18n.hs

@@ -204,25 +204,7 @@ embedRenderMessage ''UniWorX ''ExamGradingMode id
 
 embedRenderMessage ''UniWorX ''AuthenticationMode id
 
-instance RenderMessage UniWorX RatingFileException where
+embedRenderMessage ''UniWorX ''RatingValidityException id
-  renderMessage foundation ls = \case
-    RatingFileException{..} -> mr . MsgRatingFileException ratingExceptionFile $ mr ratingException
-    RatingSubmissionException{..} -> mr . MsgRatingSubmissionException ratingExceptionSubmission $ mr ratingException
-    where
-      mr :: RenderMessage UniWorX msg => msg -> Text
-      mr = renderMessage foundation ls
-
-embedRenderMessage ''UniWorX ''RatingParseLegacyException id
-instance RenderMessage UniWorX RatingException where
-  renderMessage foundation ls = \case
-    RatingParseLegacyException legacyException -> mr . MsgRatingParseLegacyException $ mr legacyException
-    RatingNegative       -> mr MsgRatingNegative
-    RatingExceedsMax     -> mr MsgRatingExceedsMax
-    RatingNotExpected    -> mr MsgRatingNotExpected
-    RatingBinaryExpected -> mr MsgRatingBinaryExpected
-    RatingPointsRequired -> mr MsgRatingPointsRequired
-    where mr :: RenderMessage UniWorX msg => msg -> Text
-          mr = renderMessage foundation ls
 
 newtype ShortSex = ShortSex Sex
 embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)

src/Handler/Utils/Rating.hs

@@ -27,7 +27,7 @@ import qualified Data.Set as Set
 import qualified Data.CaseInsensitive as CI
 
 
-validateRating :: SheetType -> Rating' -> [RatingException]
+validateRating :: SheetType -> Rating' -> [RatingValidityException]
 validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. }
   | rp < 0
     = [RatingNegative]
@@ -104,14 +104,17 @@ type SubmissionContent = Either File (SubmissionId, Rating')
 
 extractRatings :: ( MonadHandler m
                   , HandlerSite m ~ UniWorX
-                  , MonadCatch m
                   ) => ConduitT File SubmissionContent m ()
-extractRatings = Conduit.mapM $ \f@File{..} -> do
+extractRatings = Conduit.mapM $ \f@File{..} -> liftHandler $ do
   msId <- isRatingFile fileTitle
   case () of
     _ | Just sId <- msId
-      , isJust fileContent
+      , isJust fileContent -> do
-        -> handle (throwM . RatingFileException fileTitle) $ Right . (sId, ) <$> parseRating f
+          (rating, cID) <- handle (throwM . RatingFileException fileTitle) $ parseRating f
+          sId' <- traverse decrypt cID
+          unless (maybe (const True) (==) sId' sId) $
+            throwM $ RatingFileException fileTitle RatingSubmissionIDIncorrect
+          return $ Right (sId, rating)
       | otherwise -> return $ Left f
 
 isRatingFile :: forall m.

src/Handler/Utils/Rating/Format.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS -Wno-error=deprecations #-}
+{-# OPTIONS -fno-warn-orphans #-}
 
 module Handler.Utils.Rating.Format
   ( parseRating, formatRating
@@ -33,10 +33,13 @@ import Data.List (elemIndex)
 
 import Control.Monad.Trans.State.Lazy (evalState)
 
+import qualified System.FilePath.Cryptographic as Explicit
+
 
 data PrettifyState
   = PrettifyInitial
   | PrettifyMetadata Natural
+  | PrettifySubmissionId
   | PrettifyRatingPoints
   | PrettifyRatingPassed
   | PrettifyRating
@@ -48,9 +51,11 @@ data PrettifyState
 formatRating :: MsgRendererS UniWorX -> DateTimeFormatter -> CryptoFileNameSubmission -> Rating -> Lazy.ByteString
 formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = Rating'{..}, .. } = mconcat
   [ prettyYAML
-  , maybe Lazy.ByteString.empty (Lazy.Text.encodeUtf8 . Lazy.Text.fromStrict) ratingComment
+  , maybe Lazy.ByteString.empty (Lazy.Text.encodeUtf8 . Lazy.Text.fromStrict . ensureNewline) ratingComment
   ]
   where
+    ensureNewline t = Text.strip t <> "\n"
+    
     uglyYAML = YAML.Event.writeEvents YAML.UTF8 $ concat
       [ [ YAML.Event.StreamStart
         , YAML.Event.DocumentStart $ YAML.Event.DirEndMarkerVersion 2
@@ -73,15 +78,16 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
                        , pure YAML.Event.MappingEnd
                        ]
             _other -> nodeEvents . str $ CI.original ratingSheetName
-        , mapEvents (str' "submission") (str $ toPathPiece cID)
         , mapEvents (str' "rated_by") (maybe (YAML.Scalar () YAML.SNull) str ratingCorrectorName)
         , mapEvents (str' "rated_at") (maybe (YAML.Scalar () YAML.SNull) (str . format SelFormatDateTime) ratingTime)
+        , mapEvents (str' "submission") (str $ toPathPiece cID)
+
         , case ratingSheetType ^? _grading of
             Nothing -> mempty
             Just mode -> if
               | is _PassAlways mode
                 -> mempty
-              | has _passingBound mode
+              | has (_passingBound . _Left) mode
                 -> mapEvents (str' "passed") (maybe (YAML.Scalar () YAML.SNull) (YAML.Scalar () . YAML.SBool) $ gradingPassed mode =<< ratingPoints)
               | otherwise
                 -> mapEvents (str' "points") (maybe (YAML.Scalar () YAML.SNull) (YAML.Scalar () . YAML.SFloat . realToFrac) ratingPoints)
@@ -137,14 +143,17 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
         transduce PrettifyInitial (YAML.Event.MappingStart _ _ _) = (("# " <> mr MsgRatingYAMLMetaComment <> "\n", id), PrettifyMetadata 0)
         transduce PrettifyInitial _ = ((mempty, id), PrettifyInitial)
         transduce (PrettifyMetadata 0) (YAML.Event.Scalar _ _ _ k)
-          | k == "points" = ((startRatingComment, id), PrettifyRatingPoints)
+          | k == "submission" = (("\n# " <> mr MsgRatingYAMLSubmissionIdComment <> "\n", id), PrettifySubmissionId)
-          | k == "passed" = ((startRatingComment, id), PrettifyRatingPassed)
-          | k == "rating_done" = ((startRatingComment, id), PrettifyRatingDone)
-          where startRatingComment = "\n# " <> mr MsgRatingYAMLRatingComment <> "\n"
         transduce (PrettifyMetadata n) (YAML.Event.MappingStart _ _ _) = ((mempty, id), PrettifyMetadata $ succ n)
         transduce (PrettifyMetadata 0) _ = ((mempty, id), PrettifyMetadata 0)
         transduce (PrettifyMetadata n) YAML.Event.MappingEnd = ((mempty, id), PrettifyMetadata $ pred n)
         transduce cState@(PrettifyMetadata _) _ = ((mempty, id), cState)
+        transduce PrettifySubmissionId (YAML.Event.Scalar _ _ _ k)
+          | k == "points" = ((startRatingComment, id), PrettifyRatingPoints)
+          | k == "passed" = ((startRatingComment, id), PrettifyRatingPassed)
+          | k == "rating_done" = ((startRatingComment, id), PrettifyRatingDone)
+          where startRatingComment = "\n# " <> mr MsgRatingYAMLRatingComment <> "\n"
+        transduce PrettifySubmissionId _ = ((mempty, id), PrettifySubmissionId)
         transduce PrettifyRatingPoints _ = ((mempty, beforeBreak $ " # " <> mr MsgRatingYAMLChangePointsComment), PrettifyRating)
         transduce PrettifyRatingPassed _ = ((mempty, beforeBreak $ " # " <> mr MsgRatingYAMLChangePassedComment), PrettifyRating)
         transduce PrettifyRatingDone _ = ((mempty, beforeBreak $ " # " <> mr MsgRatingYAMLChangeDoneComment), PrettifyRating)
@@ -163,5 +172,47 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
                 before = Text.dropWhileEnd (== '\n') before'
                 break' = Text.takeWhileEnd (== '\n') before'
 
-parseRating :: MonadCatch m => File -> m Rating'
+instance ns ~ CryptoIDNamespace (CI FilePath) SubmissionId => YAML.FromYAML (Maybe UTCTime -> Maybe Text -> (Rating', Maybe (Explicit.CryptoFileName ns))) where
-parseRating = Legacy.parseRating
+  parseYAML = YAML.withMap "Rating'" $ \m -> do
+    ratingDone <- m YAML..:? "rating_done" YAML..!= False
+    ratingPoints' <- fmap (realToFixed :: Double -> Points) <$> m YAML..:? "points"
+    ratingPassed  <- fmap (bool 0 1) <$> m YAML..:? "passed"
+    let ratingPoints = ratingPoints' <|> ratingPassed
+        cIDNode = listToMaybe . Map.elems $ Map.filterWithKey isCIDNode m
+          where isCIDNode (YAML.Scalar _ (YAML.SStr k)) _ = k == "submission"
+                isCIDNode _ _ = False
+    cID <- for cIDNode $ \cIDNode' ->
+      YAML.withStr "CryptoFileNameSubmission" (maybe (YAML.failAtNode cIDNode' "Could not parse CryptoFileNameSubmission") return . fromPathPiece) cIDNode'
+    ratingComment' <- fmap (assertM' (not . Text.null) . Text.strip) <$> m YAML..:? "comment"
+    return $ \ratingTime ratingComment''
+      -> ( Rating'{ ratingComment = fromMaybe ratingComment'' ratingComment', .. }
+         , cID
+         )
+  
+  
+parseRating :: MonadCatch m => File -> m (Rating', Maybe CryptoFileNameSubmission)
+parseRating f@File{ fileContent = Just (fromStrict -> input), .. } = handle onFailure . handle (throwM . RatingParseException) $ do
+  let evStream = YAML.Event.parseEvents input
+      delimitDocument = do
+        ev <- maybe (throwM RatingYAMLStreamTerminatedUnexpectedly) return =<< await
+        case ev of
+          Right YAML.Event.EvPos{ eEvent = YAML.Event.DocumentEnd _, ePos = YAML.Event.Pos{..}}
+            | posByteOffset >= 0 -> return $ fromIntegral posByteOffset
+            | otherwise -> throwM RatingYAMLDocumentEndIllDefined
+          Left (pos, errStr) -> throwM . RatingYAMLExceptionBeforeComment $ YAML.prettyPosWithSource pos input errStr
+          Right _ -> delimitDocument
+  documentEnd <- runConduit $ yieldMany evStream .| delimitDocument
+  ratingComment <- fmap join . for (Lazy.ByteString.stripPrefix "..." $ Lazy.ByteString.drop documentEnd input) $ \cbs ->
+    case Lazy.Text.decodeUtf8' cbs of
+      Left err -> throwM $ RatingYAMLCommentNotUnicode err
+      Right ct -> return . assertM' (not . Text.null) . Text.strip $ toStrict ct
+  let yamlInput = Lazy.ByteString.take documentEnd input
+  case YAML.decode1 yamlInput of
+    Left (pos, errStr) -> throwM . RatingYAMLException $ YAML.prettyPosWithSource pos yamlInput errStr
+    Right cb -> return $ cb (Just fileModified) ratingComment
+  where
+    onFailure (e :: RatingException)
+      = ((, Nothing) <$> Legacy.parseRating f) `catch` \case
+          RatingParseLegacyException _ -> throwM e
+          other -> throwM other
+parseRating _ = throwM RatingFileIsDirectory

src/Handler/Utils/Submission.hs

@@ -415,13 +415,11 @@ filterSubmission = do
 
 extractRatings :: ( MonadHandler m
                   , HandlerSite m ~ UniWorX
-                  , MonadCatch m
                   ) => ConduitM File SubmissionContent m (Set FilePath)
 extractRatings = filterSubmission `fuseUpstream` Rating.extractRatings
 
 extractRatingsMsg :: ( MonadHandler m
                      , HandlerSite m ~ UniWorX
-                     , MonadCatch m
                      ) => ConduitT File SubmissionContent m ()
 extractRatingsMsg = do
   ignored' <- filterSubmission `fuseUpstream` Rating.extractRatings
@@ -436,13 +434,79 @@ extractRatingsMsg = do
 -- | Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
 msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
 msgSubmissionErrors = flip catches
-    [ E.Handler $ \e -> Nothing <$ addMessageI Error (e :: RatingFileException)
+    [ E.Handler $ \e -> Nothing <$ addMessageI Error (e :: SubmissionSinkException)
-    , E.Handler $ \e -> Nothing <$ addMessageI Error (e :: SubmissionSinkException)
     , E.Handler $ \(SubmissionSinkException sinkId _ sinkEx) -> do
         mr <- getMessageRender
         addMessageI Error $ MsgMultiSinkException (toPathPiece sinkId) (mr sinkEx)
         return Nothing
+    , E.Handler $ \e -> (Nothing <$) . addMessageWidget Error $ case e of
+        RatingFileException{..}
+          -> [whamlet|
+               $newline never
+               _{MsgRatingFileException ratingExceptionFile}
+               <br>
+               ^{ratingExceptionWidget ratingException}
+             |]
+        RatingSubmissionException{..}
+          -> [whamlet|
+               $newline never
+               _{MsgRatingSubmissionException ratingExceptionSubmission}
+               <br>
+               ^{ratingExceptionWidget ratingException}
+             |]
     ] . fmap Just
+  where
+    ratingExceptionWidget = \case
+      RatingFileIsDirectory -> i18n MsgRatingFileIsDirectory
+      RatingSubmissionIDIncorrect -> i18n MsgRatingSubmissionIDIncorrect
+      RatingValidityException exc -> i18n exc
+      RatingParseException pExc
+        -> [whamlet|
+             $newline never
+             _{MsgRatingParseException}
+             <br>
+             $case pExc
+               $of RatingYAMLStreamTerminatedUnexpectedly
+                 _{MsgRatingYAMLStreamTerminatedUnexpectedly}
+               $of RatingYAMLDocumentEndIllDefined
+                 _{MsgRatingYAMLDocumentEndIllDefined}
+               $of RatingYAMLExceptionBeforeComment errStr
+                 _{MsgRatingYAMLExceptionBeforeComment}
+                 <br>
+                 <code .literal-error>
+                   #{errStr}
+               $of RatingYAMLException errStr
+                 _{MsgRatingYAMLException}
+                 <br>
+                 <code .literal-error>
+                   #{errStr}
+               $of RatingYAMLCommentNotUnicode unicodeErr
+                 _{MsgRatingYAMLCommentNotUnicode}
+                 <br>
+                 <code .literal-error>
+                   #{tshow unicodeErr}
+           |]
+      RatingParseLegacyException pExc
+        -> [whamlet|
+             $newline never
+             _{MsgRatingParseLegacyException}
+             <br>
+             $case pExc
+               $of RatingMissingSeparator
+                 _{MsgRatingMissingSeparator}
+               $of RatingMultiple
+                 _{MsgRatingMultiple}
+               $of RatingInvalid errStr
+                 _{MsgRatingInvalid}
+                 <br>
+                 <code .literal-error>
+                   #{errStr}
+               $of RatingNotUnicode unicodeErr
+                 _{MsgRatingNotUnicode}
+                 <br>
+                 <code .literal-error>
+                   #{tshow unicodeErr}
+           |]
 
 
 sinkSubmission :: Maybe UserId
@@ -594,7 +658,7 @@ sinkSubmission userId mExists isUpdate = do
 
           Sheet{..} <- lift . getJust $ submissionSheet submission'
   
-          mapM_ (throwM . RatingSubmissionException cID) $ validateRating sheetType r'
+          mapM_ (throwM . RatingSubmissionException cID . RatingValidityException) $ validateRating sheetType r'
 
           when (submissionRatingDone submission' && not (submissionRatingDone submission)) $
             tellSt mempty { sinkSubmissionNotifyRating = Any True }

src/Model/Rating.hs

@@ -24,22 +24,38 @@ data Rating' = Rating'
   , ratingDone :: Bool
   } deriving (Read, Show, Eq, Generic, Typeable)
 
+data RatingValidityException
+  = RatingNegative       -- ^ Rating points must be non-negative
+  | 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)
+  deriving anyclass (Exception)
+
 data RatingParseLegacyException
   = RatingNotUnicode UnicodeException -- ^ Rating failed to parse as unicode
   | RatingMissingSeparator            -- ^ Could not split rating header from comments
   | RatingMultiple                    -- ^ Encountered multiple point values in rating
   | RatingInvalid Text                -- ^ Failed to parse rating point value
-  | RatingFileIsDirectory             -- ^ We do not expect this to, it's included for totality
+  deriving (Show, Eq, Generic, Typeable)
+  deriving anyclass (Exception)
+
+data RatingParseException
+  = RatingYAMLStreamTerminatedUnexpectedly
+  | RatingYAMLDocumentEndIllDefined
+  | RatingYAMLExceptionBeforeComment String -- ^ Could not parse YAML to determine where rating comments begin
+  | RatingYAMLException String -- ^ Could not parse YAML
+  | RatingYAMLCommentNotUnicode UnicodeException
   deriving (Show, Eq, Generic, Typeable)
   deriving anyclass (Exception)
 
 data RatingException
-  = RatingParseLegacyException RatingParseLegacyException
+  = RatingFileIsDirectory             -- ^ We do not expect this to happen, it's included for totality
-  | RatingNegative       -- ^ Rating points must be non-negative
+  | RatingSubmissionIDIncorrect
-  | RatingExceedsMax     -- ^ Rating point must not exceed maximum points
+  | RatingParseException RatingParseException
-  | RatingNotExpected    -- ^ Rating not expected
+  | RatingParseLegacyException RatingParseLegacyException
-  | RatingBinaryExpected -- ^ Rating must be 0 or 1
+  | RatingValidityException RatingValidityException
-  | RatingPointsRequired -- ^ Rating without points for sheet that requires there to be points
   deriving (Show, Eq, Generic, Typeable)
   deriving anyclass (Exception)
 

src/Utils.hs

@@ -221,7 +221,7 @@ withFragment :: Monad m => MForm m (a, WidgetFor site ()) -> Markup -> MForm m (
 withFragment form html = flip fmap form $ over _2 (toWidget html >>)
 
 rationalToFixed :: forall a. HasResolution a => Rational -> Fixed a
-rationalToFixed = MkFixed . round . (* (fromIntegral $ resolution (Proxy @a)))
+rationalToFixed = MkFixed . round . (* (fromInteger $ resolution (Proxy @a)))
 
 rationalToFixed3 :: Rational -> Fixed E3
 rationalToFixed3 = rationalToFixed
@@ -229,6 +229,9 @@ rationalToFixed3 = rationalToFixed
 rationalToFixed2 :: Rational -> Fixed E2
 rationalToFixed2 = rationalToFixed
 
+realToFixed :: forall a n. (HasResolution a, Real n) => n -> Fixed a
+realToFixed = rationalToFixed . toRational
+
 -- | Convert `part` and `whole` into percentage including symbol
 --   showing trailing zeroes and to decimal digits
 textPercent :: Real a => a -> a -> Text

test/Handler/Utils/RatingSpec.hs

@@ -28,7 +28,17 @@ spec = describe "Rating file parsing/pretty-printing" $ do
     parseRating' = either (\(_ :: SomeException) -> Nothing) Just . parseRating . flip (File "bewertung.txt") time . Just . LBS.toStrict
 
     time = UTCTime systemEpochDay 0
-    mRating rating = rating { ratingValues = mRating' $ ratingValues rating }
+    mRating rating = rating { ratingValues = mRating' rating $ ratingValues rating }
-    mRating' rating' = rating' { ratingTime = Just time -- There is no field for ratingTime so we just always expect file modification time
+    mRating' rating rating' = rating' { ratingTime = Just time -- The field for ratingTime gets ignored, so we just always expect file modification time
                                , ratingComment = assertM (not . Text.null) $ Text.strip <$> ratingComment rating'
+                               , ratingPoints = normalizePoints $ ratingPoints rating'
                                }
+      where
+        normalizePoints points
+          | hasn't _grading (ratingSheetType rating) || has (_grading . _PassAlways) (ratingSheetType rating)
+          = Nothing
+          | Just grading <- ratingSheetType rating ^? _grading 
+          , has (_passingBound . _Left) grading
+          = fmap (bool 0 1) . gradingPassed grading =<< points
+          | otherwise
+          = points