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, MsgRendererS(..), _Integer) import Text.Shakespeare.I18N (renderMessage) import Utils.Lens (_ratingValues, _ratingPoints) import qualified Data.Conduit.Combinators as C 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) [] parseRating' :: LBS.ByteString -> Maybe Rating' parseRating' = either (\(_ :: SomeException) -> Nothing) (Just . fst) . parseRating . flip (File "bewertung.txt") time . Just . C.sourceLazy time = UTCTime systemEpochDay 0 mRating rating = rating { ratingValues = mRating' rating $ ratingValues rating } 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