fix(corrections-grade-r): add get following post

Fixes #532
This commit is contained in:
Gregor Kleen 2020-05-05 17:27:33 +02:00
parent 970ca784b0
commit 14f9ab6a31

View File

@ -1132,26 +1132,24 @@ postCorrectionsGradeR = do
{ dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
} }
case tableRes of formResult tableRes $ \resMap -> do
FormMissing -> return () now <- liftIO getCurrentTime
FormFailure errs -> forM_ errs $ addMessage Error . toHtml subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
FormSuccess resMap -> do s@Submission{..} <- get404 subId
now <- liftIO getCurrentTime if
subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
s@Submission{..} <- get404 subId -> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet
if Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
| submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s , SubmissionRatingComment =. mComment
-> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet , SubmissionRatingBy =. Just uid
Just subId <$ update subId [ SubmissionRatingPoints =. mPoints , SubmissionRatingTime =. now <$ guard rated
, SubmissionRatingComment =. mComment ]
, SubmissionRatingBy =. Just uid | otherwise -> return Nothing
, SubmissionRatingTime =. now <$ guard rated subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
] let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
| otherwise -> return Nothing content = Right $(widgetFile "messages/correctionsUploaded")
subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)] unless (null subs') $ addMessageModal Success trigger content
let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|] redirect CorrectionsGradeR
content = Right $(widgetFile "messages/correctionsUploaded")
unless (null subs') $ addMessageModal Success trigger content
siteLayoutMsg MsgCorrectionsGrade $ do siteLayoutMsg MsgCorrectionsGrade $ do
setTitleI MsgCorrectionsGrade setTitleI MsgCorrectionsGrade