fix(rating files): better descriptions & tests

src/Handler/Utils/Rating.hs

@@ -47,8 +47,8 @@ instance Pretty x => Pretty (CI x) where
 
 
 instance Pretty SheetGrading where
-  pretty Points{..}     = pretty ( show maxPoints <> " Punkte" :: String)
-  pretty PassPoints{..} = pretty ( show maxPoints <> " Punkte, bestanden ab " <> show passingPoints <> " Punkte" :: String )
+  pretty Points{..}     = pretty ( "Maximal " <> show maxPoints <> " Punkt(e)" :: String)
+  pretty PassPoints{..} = pretty ( "Maximal " <> show maxPoints <> " Punkt(e), bestanden ab " <> show passingPoints <> " Punkt(en)" :: String )
   pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
 
 
@@ -113,7 +113,7 @@ formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
       [ Just $ "Veranstaltung:" <+> pretty ratingCourseName
       , Just $ "Blatt:" <+> pretty ratingSheetName
       , ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
-      , ("Bewertung:" <+>) . pretty <$> (ratingSheetType ^? _grading)
+      , ("Bewertungsschema:" <+>) . pretty <$> (ratingSheetType ^? _grading)
       ]
     , "Abgabe-Id:" <+> pretty (Text.unpack $ toPathPiece cID)
     , "============================================="

test/Handler/Utils/RatingSpec.hs

@@ -0,0 +1,30 @@
+module Handler.Utils.RatingSpec where
+
+import TestImport
+import Handler.Utils.Rating
+import ModelSpec ()
+import Model.RatingSpec ()
+
+import Data.Time.Clock.System (systemEpochDay)
+import qualified Data.ByteString.Lazy as LBS
+
+import qualified Data.Text as Text
+
+import Utils (assertM)
+
+
+spec :: Spec
+spec = describe "Rating file parsing/pretty-printing" $ do
+  it "roundtrips" . property $ \(_ :: SubmissionId, subId) (mRating -> rating) ->
+    parseRating' (formatRating subId rating) === Just (ratingValues rating)
+  it "has idempotent formatting" . property $ \(_ :: SubmissionId, subId) (mRating -> rating) ->
+    fmap (\r' -> formatRating subId $ rating { ratingValues = r' }) (parseRating' $ formatRating subId rating) === Just (formatRating subId rating)
+  where
+    parseRating' :: LBS.ByteString -> Maybe Rating'
+    parseRating' = parseRating . flip (File "bewertung.txt") time . Just . LBS.toStrict
+
+    time = UTCTime systemEpochDay 0
+    mRating rating = rating { ratingValues = mRating' $ ratingValues rating }
+    mRating' rating' = rating' { ratingTime = Just time -- There is no field for ratingTime so we just always expect file modification time
+                               , ratingComment = assertM (not . Text.null) $ Text.strip <$> ratingComment rating'
+                               }

test/Model/RatingSpec.hs

@@ -0,0 +1,16 @@
+module Model.RatingSpec where
+
+import TestImport
+import ModelSpec ()
+import Model.Rating
+
+instance Arbitrary Rating' where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary Rating where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+spec :: Spec
+spec = return ()

test/ModelSpec.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module ModelSpec where
 
 import TestImport
@@ -22,6 +24,13 @@ import Utils
 import System.FilePath
 import Data.Time
 
+import Data.CryptoID.Poly
+import qualified Data.CryptoID.Class.ImplicitNamespace as Implicit
+
+import Control.Monad.Catch.Pure (Catch, runCatch)
+
+import System.IO.Unsafe (unsafePerformIO)
+
 
 instance Arbitrary EmailAddress where
     arbitrary = do
@@ -145,6 +154,11 @@ instance Arbitrary Term where
   arbitrary = genericArbitrary
   shrink = genericShrink
 
+instance {-# OVERLAPS #-} (HasCryptoID ns ct pt (ReaderT CryptoIDKey Catch), Arbitrary pt, ns ~ Implicit.CryptoIDNamespace ct pt) => Arbitrary (pt, CryptoID ns ct) where
+  arbitrary = arbitrary <&> \pt -> (pt, either (error . show) id . runCatch $ runReaderT (Implicit.encrypt pt) tmpKey)
+    where
+      tmpKey = unsafePerformIO genKey
+
 spec :: Spec
 spec = do
   parallel $ do