fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
Fixes #532
This commit is contained in:
Gregor Kleen 2020-05-05 17:27:33 +02:00
parent 970ca784b0
commit 14f9ab6a31
1 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Handler/Corrections.hs
View File

@ -1132,10 +1132,7 @@ postCorrectionsGradeR = do
{ dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
} }
case tableRes of formResult tableRes $ \resMap -> do
FormMissing -> return ()
FormFailure errs -> forM_ errs $ addMessage Error . toHtml
FormSuccess resMap -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
s@Submission{..} <- get404 subId s@Submission{..} <- get404 subId
@ -1152,6 +1149,7 @@ postCorrectionsGradeR = do
let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|] let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
content = Right $(widgetFile "messages/correctionsUploaded") content = Right $(widgetFile "messages/correctionsUploaded")
unless (null subs') $ addMessageModal Success trigger content unless (null subs') $ addMessageModal Success trigger content
redirect CorrectionsGradeR
siteLayoutMsg MsgCorrectionsGrade $ do siteLayoutMsg MsgCorrectionsGrade $ do
setTitleI MsgCorrectionsGrade setTitleI MsgCorrectionsGrade