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

Mino

Browse Source
This commit is contained in:
SJost 2018-11-20 15:48:29 +03:00
parent a3d22baa5b
commit b0732ae6c6
3 changed files with 30 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Handler/Corrections.hs
View File

@ -550,8 +550,11 @@ postCorrectionR tid ssh csh shn cid = do
uid <- requireAuthId uid <- requireAuthId
void . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True void . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
{-case res of
(Left _) -> addMessageI Success MsgRatingFilesUpdated
(Right RatingNotExpected) -> addMessageI Error MsgRatingNotExpected
(Right other) -> throw other-}
addMessageI Success MsgRatingFilesUpdated
redirect $ CSubmissionR tid ssh csh shn cid CorrectionR redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
mr <- getMessageRender mr <- getMessageRender

1
src/Handler/Utils/Submission.hs
View File

@ -421,6 +421,7 @@ sinkSubmission userId mExists isUpdate = do
when anyChanges $ do when anyChanges $ do
Sheet{..} <- lift $ getJust submissionSheet Sheet{..} <- lift $ getJust submissionSheet
--TODO: should display errorMessages
mapM_ throwM $ validateRating sheetType r' mapM_ throwM $ validateRating sheetType r'
touchSubmission touchSubmission

3
src/Jobs/Queue.hs
View File

@ -77,7 +77,8 @@ type YesodJobDB site = ReaderT (YesodPersistBackend site) (WriterT (Set QueuedJo
queueDBJob :: Job -> ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) () queueDBJob :: Job -> ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) ()
queueDBJob job = mapReaderT lift (queueJobUnsafe job) >>= tell . Set.singleton queueDBJob job = mapReaderT lift (queueJobUnsafe job) >>= tell . Set.singleton
runDBJobs :: (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) a -> m a runDBJobs :: (MonadHandler m, HandlerSite m ~ UniWorX)
=> ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) a -> m a
runDBJobs act = do runDBJobs act = do
(ret, jIds) <- liftHandlerT . runDB $ mapReaderT runWriterT act (ret, jIds) <- liftHandlerT . runDB $ mapReaderT runWriterT act
forM_ jIds $ writeJobCtl . JobCtlPerform forM_ jIds $ writeJobCtl . JobCtlPerform