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

Don't attempt to dequeue corrector who isn't (also) proportional

Browse Source
This commit is contained in:
Gregor Kleen 2018-04-26 18:28:26 +02:00
parent 6d7522410a
commit 99d112b31c
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,7 +50,7 @@ instance Exception AssignSubmissionException
assignSubmissions :: SheetId -> YesodDB UniWorX () assignSubmissions :: SheetId -> YesodDB UniWorX ()
assignSubmissions sid = do assignSubmissions sid = do
correctors <- selectList [SheetCorrectorSheet ==. sid] [] correctors <- selectList [SheetCorrectorSheet ==. sid] []
let (corrsGroup, corrsProp) = partition (is _ByTutorial . sheetCorrectorLoad . entityVal) correctors let (corrsGroup, (filterNonPositive -> corrsProp)) = partition (is _ByTutorial . sheetCorrectorLoad . entityVal) correctors
countsToLoad' :: UserId -> Bool countsToLoad' :: UserId -> Bool
countsToLoad' uid = fromMaybe (error "Called `countsToLoad'` on entity not element of `corrsGroup`") $ listToMaybe [sheetCorrectorLoad | Entity _ SheetCorrector{..} <- corrsGroup, sheetCorrectorUser == uid] >>= preview _ByTutorial countsToLoad' uid = fromMaybe (error "Called `countsToLoad'` on entity not element of `corrsGroup`") $ listToMaybe [sheetCorrectorLoad | Entity _ SheetCorrector{..} <- corrsGroup, sheetCorrectorUser == uid] >>= preview _ByTutorial
subs <- E.select . E.from $ \(submission `E.LeftOuterJoin` user) -> do subs <- E.select . E.from $ \(submission `E.LeftOuterJoin` user) -> do
@ -74,7 +74,7 @@ assignSubmissions sid = do
subTutor <- fmap fst . flip execStateT (Map.empty, queue) . forM_ (Map.toList subTutor') $ \case subTutor <- fmap fst . flip execStateT (Map.empty, queue) . forM_ (Map.toList subTutor') $ \case
(smid, Just tutid) -> do (smid, Just tutid) -> do
_1 %= Map.insert smid tutid _1 %= Map.insert smid tutid
when (countsToLoad' tutid) $ when (any ((== tutid) . sheetCorrectorUser . entityVal) corrsProp && countsToLoad' tutid) $
_2 %= delFirst (Just tutid) _2 %= delFirst (Just tutid)
(smid, Nothing) -> do (smid, Nothing) -> do
(q:qs) <- use _2 (q:qs) <- use _2
@ -87,6 +87,8 @@ assignSubmissions sid = do
return () return ()
where where
filterNonPositive = filter $ (> 0) . load . sheetCorrectorLoad . entityVal
delFirst _ [] = [] delFirst _ [] = []
delFirst x (y:ys) delFirst x (y:ys)
| x == y = ys | x == y = ys