assign submission reports results now

src/Handler/Utils/Submission.hs

@@ -26,6 +26,7 @@ import qualified Control.Monad.Random as Rand
 
 import Data.Maybe
 
+import qualified Data.List as List
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Map (Map, (!?))
@@ -47,7 +48,12 @@ data AssignSubmissionException = NoCorrectorsByProportion
 
 instance Exception AssignSubmissionException
 
-assignSubmissions :: SheetId -> YesodDB UniWorX ()
+-- | Assigns all submissions according to sheet corrector loads
+assignSubmissions ::
+    SheetId -- ^ Sheet do distribute to correction
+    -> YesodDB UniWorX (Set SubmissionId -- ^ assigned submissions
+                       ,Set SubmissionId -- ^ unassigend submissions (no tutors by load)
+                       )
 assignSubmissions sid = do
     correctors <- selectList [SheetCorrectorSheet ==. sid] []
     let (corrsGroup, (filterNonPositive -> corrsProp)) = partition (is _ByTutorial . sheetCorrectorLoad . entityVal) correctors
@@ -75,24 +81,22 @@ assignSubmissions sid = do
       (smid, Just tutid) -> do
         _1 %= Map.insert smid tutid
         when (any ((== tutid) . sheetCorrectorUser . entityVal) corrsProp && countsToLoad' tutid) $
-          _2 %= delFirst (Just tutid)
+          _2 %= List.delete (Just tutid)
       (smid, Nothing) -> do
         (q:qs) <- use _2
         _2 .= qs
         case q of
           Just q  -> _1 %= Map.insert smid q
-          Nothing -> throwM NoCorrectorsByProportion
+          Nothing -> return () -- NOTE: throwM NoCorrectorsByProportion
 
     forM_ (Map.toList subTutor) $ \(smid, tutid) -> update smid [SubmissionRatingBy =. Just tutid]
         
-    return ()
+    let assignedSubmissions   = Map.keysSet subTutor
+        unassigendSubmissions = Map.keysSet subTutor' \\ assignedSubmissions
+    return (assignedSubmissions, unassigendSubmissions)
     where
       filterNonPositive = filter $ (> 0) . load . sheetCorrectorLoad . entityVal
 
-      delFirst _ [] = []
-      delFirst x (y:ys)
-        | x == y = ys
-        | otherwise = y:delFirst x ys