Minor Bugfix

This commit is contained in:
Steffen Jost 2019-06-17 09:55:02 +02:00
parent d5b094d6b4
commit 55cd175f06
2 changed files with 28 additions and 26 deletions

View File

@ -1128,6 +1128,32 @@ assignHandler tid ssh csh cid assignSids = do
let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
in List.foldr foldFun False sheetList
-- plan or assign unassigned submissions for given sheets
let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int))
buildA acc sid = maybeT (return acc) $ do
let shn = sheetName $ sheets ! sid
-- is sheet closed?
guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR -- we must check, whether the submission is already closed and thus assignable
-- has at least one submisison?
[E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do
E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy
guard hasSubmission
-- has at least one active corrector?
[E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do
E.where_ $ corrector E.^. SheetCorrectorSheet E.==. E.val sid
E.where_ $ corrector E.^. SheetCorrectorState E.==. E.val CorrectorNormal
-- E.where_ $ corrector E.^. SheetCorrectorLoad E./=. E.val (Load {byTutorial = Nothing, byProportion = 0})
guard hasCorrector
-- TODO: Refactor guards above! We already have these informations, but forcing the maps inside the DB acces might not be a good idea
-- TODO: Maybe refactor planSubmissions instead to not throw exceptions, but signal "ok" or "not possible" instead!
plan <- lift $ planSubmissions sid Nothing
status <- lift $ case btnResult of
Nothing -> return (Set.empty, Set.empty)
(Just BtnSubmissionsAssign) -> writeSubmissionPlan plan -- TODO: this comes to late!!
return $ Map.insert shn (status, countMapElems plan) acc
assignment <- foldM buildA Map.empty assignSids
correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
E.where_ $ corrector E.^. SheetCorrectorSheet `E.in_` E.valList sheetIds
@ -1166,31 +1192,7 @@ assignHandler tid ssh csh cid assignSids = do
, ciMax = corTime
}
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
-- plan or assign unassigned submissions for given sheets
let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int))
buildA acc sid = maybeT (return acc) $ do
let shn = sheetName $ sheets ! sid
-- is sheet closed?
guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR -- we must check, whether the submission is already closed and thus assignable
-- has at least one submisison?
[E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do
E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy
guard hasSubmission
-- has at least one active corrector?
[E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do
E.where_ $ corrector E.^. SheetCorrectorSheet E.==. E.val sid
E.where_ $ corrector E.^. SheetCorrectorState E.==. E.val CorrectorNormal
-- E.where_ $ corrector E.^. SheetCorrectorLoad E./=. E.val (Load {byTutorial = Nothing, byProportion = 0})
guard hasCorrector
-- TODO: Refactor guards above! We already have these informations, but forcing the maps inside the DB acces might not be a good idea
-- TODO: Maybe refactor planSubmissions instead to not throw exceptions, but signal "ok" or "not possible" instead!
plan <- lift $ planSubmissions sid Nothing
status <- lift $ case btnResult of
Nothing -> return (Set.empty, Set.empty)
(Just BtnSubmissionsAssign) -> writeSubmissionPlan plan
return $ Map.insert shn (status, countMapElems plan) acc
assignment <- foldM buildA Map.empty assignSids
return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference

View File

@ -60,5 +60,5 @@
<td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciAssigned - ciCorrected}
<td .table__td>#{showAvgsDays ciTot ciCorrected}
$nothing
<td .table__td colspan=5>
<td .table__td colspan=4>
^{btnWdgt}