fix(submissions): only notify submittors if rating changes doneness

This commit is contained in:
Gregor Kleen 2019-07-17 17:35:12 +02:00
parent ddda584b08
commit 4f1162c363

View File

@ -491,17 +491,20 @@ sinkSubmission userId mExists isUpdate = do
alreadySeen <- gets $ is (_Wrapped . _Just) . sinkSeenRating
when alreadySeen $ throwM DuplicateRating
Submission{..} <- lift $ getJust submissionId
submission <- lift $ getJust submissionId
now <- liftIO getCurrentTime
let
rated = submissionRatingBy == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files
r' = let Rating'{..} = r
in Rating'
{ ratingTime = now <$ guard rated
, ..
}
let Rating'{..} = r'
rated = submissionRatingBy submission == Just userId -- FIXME: This behaviour is unintuitive and needs to be replaced with an "isDone"-Field in rating files
r'@Rating'{..} = r
{ ratingTime = now <$ guard rated -- Ignore `ratingTime` from result @r@ of `parseRating` to ensure plausible timestamps (`parseRating` returns file modification time for consistency with `ratingFile`)
}
submission' = submission
{ submissionRatingPoints = ratingPoints
, submissionRatingComment = ratingComment
, submissionRatingTime = ratingTime
, submissionRatingBy = userId <$ guard rated -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
}
tellSt $ mempty{ sinkSeenRating = Last $ Just r' }
unless isUpdate $ throwM RatingWithoutUpdate
@ -510,25 +513,23 @@ sinkSubmission userId mExists isUpdate = do
--
-- 'fileModified' is simply stored and never inspected while
-- 'submissionChanged' is always set to @now@.
let anyChanges = or $
[ submissionRatingPoints /= ratingPoints
, submissionRatingComment /= ratingComment
let anyChanges = any (\f -> f submission submission') $
[ (/=) `on` submissionRatingPoints
, (/=) `on` submissionRatingComment
, (/=) `on` submissionRatingDone
, (/=) `on` submissionRatingBy
]
when anyChanges $ do
touchSubmission
Sheet{..} <- lift $ getJust submissionSheet
Sheet{..} <- lift . getJust $ submissionSheet submission'
mapM_ throwM $ validateRating sheetType r'
when (submissionRatingDone r') $ tellSt mempty { sinkSubmissionNotifyRating = Any True }
lift $ update submissionId
[ SubmissionRatingPoints =. ratingPoints
, SubmissionRatingComment =. ratingComment
, SubmissionRatingTime =. ratingTime
, SubmissionRatingBy =. (userId <$ guard rated) -- This is never an update due to the definition of rated; this is done so idempotency of uploads is maintained (FIXME: when "isDone"-Field is introduced, set this to `Just userId`)
]
when (submissionRatingDone submission' && not (submissionRatingDone submission)) $
tellSt mempty { sinkSubmissionNotifyRating = Any True }
lift $ replace submissionId submission'
where
a /~ b = not $ a ~~ b