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