assignSubmission split into planning and assigning part

src/Foundation.hs

@@ -1923,7 +1923,7 @@ pageActions (CourseR tid ssh csh CCorrectionsR) =
       , menuItemLabel = MsgMenuCorrectionsAssign
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
-      , menuItemModal = True
+      , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   ]
@@ -1961,7 +1961,7 @@ pageActions (CourseR tid ssh csh SheetListR) =
       , menuItemLabel = MsgMenuCorrectionsAssign
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
-      , menuItemModal = True
+      , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
@@ -2138,7 +2138,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
       , menuItemLabel = MsgMenuCorrectionsAssign
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
-      , menuItemModal = True
+      , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   , MenuItem
@@ -2188,7 +2188,7 @@ pageActions (CSheetR tid ssh csh shn SSubsR) =
       , menuItemLabel = MsgMenuCorrectionsAssign
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
-      , menuItemModal = True
+      , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
   ]

src/Handler/Utils/Submission.hs

@@ -67,6 +67,24 @@ assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
                                      , Set SubmissionId
                                      ) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
 assignSubmissions sid restriction = do
+    newSubmissionData <- planSubmissions sid restriction
+    now <- liftIO getCurrentTime
+    execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, mCorrector) -> case mCorrector of
+      Just corrector -> do
+        lift $ update subId [ SubmissionRatingBy       =. Just corrector
+                            , SubmissionRatingAssigned =. Just now
+                            ]
+        tell (Set.singleton subId, mempty)
+      Nothing ->
+        tell (mempty, Set.singleton subId)
+
+
+-- | Compute a map that shows which submissions ought the be assigned to each corrector according to sheet corrector loads, but does not alter database yet!
+planSubmissions :: SheetId -- ^ Sheet to distribute to correctors
+                  -> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
+                  -> YesodDB UniWorX (Map SubmissionId (Maybe UserId))
+                  -- ^ Return map that assigns submissions to Corrector
+planSubmissions sid restriction = do
     Sheet{..} <- getJust sid
     correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do
       E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
@@ -210,15 +228,7 @@ assignSubmissions sid restriction = do
 
         ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors)
 
-    now <- liftIO getCurrentTime
+    return $ fmap (view _1) newSubmissionData
-    execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, (mCorrector, _, _)) -> case mCorrector of
-      Just corrector -> do
-        lift $ update subId [ SubmissionRatingBy       =. Just corrector
-                            , SubmissionRatingAssigned =. Just now
-                            ]
-        tell (Set.singleton subId, mempty)
-      Nothing ->
-        tell (mempty, Set.singleton subId)
   where
     maximumsBy :: (Ord a, Ord b) => (a -> b) -> Set a -> Set a
     maximumsBy f xs = flip Set.filter xs $ \x -> maybe True (((==) `on` f) x . maximumBy (comparing f)) $ fromNullable xs