diff --git a/models b/models index 4cc88aaf2..ce5229b24 100644 --- a/models +++ b/models @@ -79,7 +79,7 @@ Lecturer user UserId course CourseId UniqueLecturer user course -Corrector +Corrector -- deprecated user UserId course CourseId load Load @@ -117,6 +117,7 @@ SheetCorrector user UserId sheet SheetId load Load + UniqueSheetCorrector user sheet SheetFile sheet SheetId file FileId diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index d369216e1..b15ec6adf 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -124,7 +124,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser) E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] - E.limit 10 + E.limit 3 -- TODO for Debug Purposes return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime) let lastEdits = map (bimap E.unValue E.unValue) lastEditValues return (sheet,buddies,oldfiles,lastEdits) diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 99920219b..7cfc97f4e 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -56,9 +56,15 @@ assignSubmissions :: ) assignSubmissions sid = do correctors <- selectList [SheetCorrectorSheet ==. sid] [] - let (corrsGroup, (filterNonPositive -> corrsProp)) = partition (is _ByTutorial . sheetCorrectorLoad . entityVal) correctors - countsToLoad' :: UserId -> Bool - countsToLoad' uid = fromMaybe (error "Called `countsToLoad'` on entity not element of `corrsGroup`") $ listToMaybe [sheetCorrectorLoad | Entity _ SheetCorrector{..} <- corrsGroup, sheetCorrectorUser == uid] >>= preview _ByTutorial + let corrsGroup = filter hasTutorialLoad correctors -- needed as List within Esqueleto + let corrsProp = filter hasPositiveLoad correctors + let countsToLoad' :: UserId -> Bool + countsToLoad' uid = -- refactor by simply using Map.(!) + fromMaybe (error "Called `countsToLoad'` on entity not element of `corrsGroup`") $ + Map.lookup uid loadMap + loadMap :: Map UserId Bool + loadMap = Map.fromList [(sheetCorrectorUser,b) | Entity _ SheetCorrector{ sheetCorrectorLoad = (Load {byTutorial = Just b}), .. } <- corrsGroup] + subs <- E.select . E.from $ \(submission `E.LeftOuterJoin` user) -> do let tutors = E.subList_select . E.from $ \(submissionUser `E.InnerJoin` tutorialUser `E.InnerJoin` tutorial) -> do -- Uncomment next line for equal chance between tutors, irrespective of the number of students per tutor per submission group @@ -72,7 +78,7 @@ assignSubmissions sid = do E.orderBy [E.rand] -- randomize for fair tutor distribution return (submission E.^. SubmissionId, user) -- , listToMaybe tutors) - queue <- liftIO . Rand.evalRandIO . sequence . repeat $ Rand.weightedMay [ (sheetCorrectorUser, load sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsProp] + queue <- liftIO . Rand.evalRandIO . sequence . repeat $ Rand.weightedMay [ (sheetCorrectorUser, byProportion sheetCorrectorLoad) | Entity _ SheetCorrector{..} <- corrsProp] let subTutor' :: Map SubmissionId (Maybe UserId) subTutor' = Map.fromListWith (<|>) $ map (over (_2.traverse) entityKey . over _1 E.unValue) subs @@ -95,7 +101,8 @@ assignSubmissions sid = do unassigendSubmissions = Map.keysSet subTutor' \\ assignedSubmissions return (assignedSubmissions, unassigendSubmissions) where - filterNonPositive = filter $ (> 0) . load . sheetCorrectorLoad . entityVal + hasPositiveLoad = (> 0) . byProportion . sheetCorrectorLoad . entityVal + hasTutorialLoad = isJust . byTutorial . sheetCorrectorLoad . entityVal diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 9be9a1c2b..b5d761046 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -77,7 +77,11 @@ data ExamStatus = Attended | NoShow | Voided deriving (Show, Read, Eq, Ord, Enum, Bounded) derivePersistField "ExamStatus" -data Load = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational } +-- | Specify a corrector's workload +data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational } + = Load { byTutorial :: Maybe Bool -- ^ Just all from Tutorial, True if counting towards overall workload + , byProportion :: Rational -- ^ workload proportion of all submission not assigned to tutorial leaders + } deriving (Show, Read, Eq) derivePersistField "Load" diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index c2d8371b8..c57898cba 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -12,4 +12,4 @@ makeClassy_ ''Entity makeClassy_ ''SheetCorrector -makeClassyPrisms ''Load +-- makeClassy_ ''Load