fix(rating-files): support integral points values

Fixes #604

src/Handler/Utils/Rating/Format.hs

@@ -91,6 +91,8 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
                 -> mempty
               | has (_passingBound . _Left) mode
                 -> mapEvents (str' "passed") (YAML.Scalar () . maybe YAML.SNull YAML.SBool $ gradingPassed mode =<< ratingPoints)
+              | Just ratingPoints' <- ratingPoints ^? _Just . _Integer
+                -> mapEvents (str' "points") (YAML.Scalar () $ YAML.SInt ratingPoints')
               | otherwise
                 -> mapEvents (str' "points") (YAML.Scalar () $ maybe YAML.SNull (YAML.SFloat . realToFrac) ratingPoints)
         , mapEvents (str' "rating_done") (YAML.Scalar () $ YAML.SBool ratingDone)
@@ -177,7 +179,10 @@ formatRating (MsgRenderer mr) DateTimeFormatter{..} cID Rating{ ratingValues = R
 instance ns ~ CryptoIDNamespace (CI FilePath) SubmissionId => YAML.FromYAML (Maybe UTCTime -> Maybe Text -> (Rating', Maybe (Explicit.CryptoFileName ns))) where
   parseYAML = YAML.withMap "Rating'" $ \m -> do
     ratingDone <- m YAML..:? "rating_done" YAML..!= False
-    ratingPoints' <- fmap (realToFixed :: Double -> Points) <$> m YAML..:? "points"
+    ratingPoints' <- asum
+      [ fmap (fromIntegral :: Integer -> Points) <$> m YAML..:? "points"
+      , 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

src/Utils.hs

@@ -359,6 +359,9 @@ cutOffPercent (abs -> offset) (abs -> full) (abs -> achieved)
   where
     percent = achieved / full
 
+_Integer :: (RealFrac a, Integral b) => Prism' a b
+_Integer = prism' fromIntegral $ fmap (view _1) . assertM' (has $ _2 . only 0) . properFraction
+
 ------------
 -- Monoid --
 ------------

src/Utils/Lens.hs

@@ -232,8 +232,8 @@ makeLenses_ ''ExternalExamOfficeSchool
 makeLenses_ ''ExternalExamStaff
 makeLenses_ ''ExternalExamResult
 
+makeLenses_ ''Rating
 makeLenses_ ''Rating'
-  
 
 -- makeClassy_ ''Load
 

test/Handler/Utils/RatingSpec.hs

@@ -10,16 +10,24 @@ import qualified Data.ByteString.Lazy as LBS
 
 import qualified Data.Text as Text
 
-import Utils (assertM, MsgRendererS(..))
+import Utils (assertM, MsgRendererS(..), _Integer)
 import Text.Shakespeare.I18N (renderMessage)
 
+import Utils.Lens (_ratingValues, _ratingPoints)
+
 
 spec :: Spec
 spec = describe "Rating file parsing/pretty-printing" $ do
   it "roundtrips" . property $ \(_ :: SubmissionId, subId) (mRating -> rating) ->
     parseRating' (formatRating mr' def subId rating) === Just (ratingValues rating)
+  it "roundtrips for integral points" . property $ \(_ :: SubmissionId, subId) (over (_ratingValues . _ratingPoints . _Just) (fromInteger . round) . mRating -> rating) ->
+    has (_ratingValues . _ratingPoints . _Just . _Integer) rating
+      ==> parseRating' (formatRating mr' def subId rating) === Just (ratingValues rating)
   it "has idempotent formatting" . property $ \(_ :: SubmissionId, subId) (mRating -> rating) ->
     fmap (\r' -> formatRating mr' def subId $ rating { ratingValues = r' }) (parseRating' $ formatRating mr' def subId rating) === Just (formatRating mr' def subId rating)
+  it "has idempotent formatting for integral points" . property $ \(_ :: SubmissionId, subId) (over (_ratingValues . _ratingPoints . _Just) (fromInteger . round) . mRating -> rating) ->
+    has (_ratingValues . _ratingPoints . _Just . _Integer) rating
+      ==> fmap (\r' -> formatRating mr' def subId $ rating { ratingValues = r' }) (parseRating' $ formatRating mr' def subId rating) === Just (formatRating mr' def subId rating)
   where
     mr' :: forall site. MsgRendererS site
     mr' = MsgRenderer $ renderMessage (error "foundation inspected" :: site) []