diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 2292ccfed..4bea35d2b 100644 --- a/src/Handler/Utils/Rating.hs +++ b/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) , "=============================================" diff --git a/test/Handler/Utils/RatingSpec.hs b/test/Handler/Utils/RatingSpec.hs new file mode 100644 index 000000000..feaadd458 --- /dev/null +++ b/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' + } diff --git a/test/Model/RatingSpec.hs b/test/Model/RatingSpec.hs new file mode 100644 index 000000000..44fc4f734 --- /dev/null +++ b/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 () diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs index 9c616915f..654156578 100644 --- a/test/ModelSpec.hs +++ b/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