59 lines
3.0 KiB
Haskell
59 lines
3.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
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
|