datatype Load refactored as discussed

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

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)

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
 
 
 

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"
 

src/Utils/Lens.hs

@@ -12,4 +12,4 @@ makeClassy_ ''Entity
 
 makeClassy_ ''SheetCorrector
 
-makeClassyPrisms ''Load
+-- makeClassy_ ''Load