Minor cleanup & restrict assignSubmissions

src/Handler/Corrections.hs

@@ -130,7 +130,7 @@ makeCorrectionsTable whereClause colChoices = do
                         )
                         -- TODO
                       ]
-    , dbtFilter    =  mempty {- [ ( "term"
+    , dbtFilter    =  [] {- [ ( "term"
                         , FilterColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) tids -> if
                             | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
                             | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
@@ -162,6 +162,7 @@ correctionsR whereClause (formColonnade -> displayColumns) actions = do
     (actionRes, action) <- multiAction actions
     return ((,) <$> actionRes <*> selectionRes, table <> action)
 
+  Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
   case actionRes of
     FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs
     FormMissing      -> return ()
@@ -171,20 +172,21 @@ correctionsR whereClause (formColonnade -> displayColumns) actions = do
       sendResponse =<< submissionMultiArchive ids
     FormSuccess (CorrSetCorrectorData uid, subs) -> do
       addMessage "danger" $ "Setting correctors not implemented yet" -- TODO
-      Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
       redirect currentRoute
 
   fmap toTypedContent . defaultLayout $ do
     setTitleI MsgCourseCorrectionsTitle
     $(widgetFile "corrections")
 
+
+type ActionCorrections' = (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
   
-downloadAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
+downloadAction :: ActionCorrections'
 downloadAction = ( CorrDownload
                  , return (pure CorrDownloadData, mempty)
                  )
 
-assignAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
+assignAction :: ActionCorrections'
 assignAction = ( CorrSetCorrector
                , return (pure undefined, mempty) -- TODO
                )

src/Handler/Utils/Submission.hs

@@ -57,12 +57,12 @@ data AssignSubmissionException = NoCorrectorsByProportion
 instance Exception AssignSubmissionException
 
 -- | Assigns all submissions according to sheet corrector loads
-assignSubmissions ::
+assignSubmissions :: SheetId -- ^ Sheet do distribute to correction
-    SheetId -- ^ Sheet do distribute to correction
+                  -> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
-    -> YesodDB UniWorX (Set SubmissionId -- ^ assigned submissions
+                  -> YesodDB UniWorX ( Set SubmissionId -- ^ assigned submissions
-                       ,Set SubmissionId -- ^ unassigend submissions (no tutors by load)
+                                     , Set SubmissionId -- ^ unassigend submissions (no tutors by load)
-                       )
+                                     )
-assignSubmissions sid = do
+assignSubmissions sid restriction = do
     correctors <- selectList [SheetCorrectorSheet ==. sid] []
     let corrsGroup = filter hasTutorialLoad correctors -- needed as List within Esqueleto
     let corrsProp  = filter hasPositiveLoad correctors
@@ -82,7 +82,8 @@ assignSubmissions sid = do
                 E.where_ (tutorial   E.^. TutorialTutor `E.in_` E.valList (map (sheetCorrectorUser . entityVal) corrsGroup))
                 return $ tutorial E.^. TutorialTutor
         E.on $ user E.?. UserId `E.in_` E.justList tutors
-        E.where_ $  submission E.^. SubmissionSheet E.==. E.val sid
+        E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid
+             E.&&. maybe (E.val True) (submission E.^. SubmissionId `E.in_`) (E.valList . Set.toList <$> restriction)
         E.orderBy [E.rand] -- randomize for fair tutor distribution
         return (submission E.^. SubmissionId, user) -- , listToMaybe tutors)