diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index df3bae1ca..5b3537b00 100644 --- a/src/Handler/Corrections.hs +++ b/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 ) diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 27f88daf7..dd99a6d9c 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -57,12 +57,12 @@ data AssignSubmissionException = NoCorrectorsByProportion instance Exception AssignSubmissionException -- | 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 +assignSubmissions :: SheetId -- ^ Sheet do distribute to correction + -> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider + -> YesodDB UniWorX ( Set SubmissionId -- ^ assigned submissions + , Set SubmissionId -- ^ unassigend submissions (no tutors by load) + ) +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)