This commit is contained in:
Steffen Jost 2019-05-28 19:22:14 +02:00
parent c105e0c627
commit 0fc9c326b9

View File

@ -129,7 +129,7 @@ assignSubmissions sid restriction = do
(E.Value sheetId, Entity subId Submission{..}, _) <- submissionDataRaw (E.Value sheetId, Entity subId Submission{..}, _) <- submissionDataRaw
guard $ sheetId == sid guard $ sheetId == sid
case restriction of case restriction of
Just restriction' -> Just restriction' ->
guard $ subId `Set.member` restriction' guard $ subId `Set.member` restriction'
Nothing -> Nothing ->
guard $ is _Nothing submissionRatingBy guard $ is _Nothing submissionRatingBy
@ -146,7 +146,7 @@ assignSubmissions sid restriction = do
=> (Map SubmissionId a -> b) => (Map SubmissionId a -> b)
-> m b -> m b
withSubmissionData f = f <$> (mappend <$> ask <*> State.get) withSubmissionData f = f <$> (mappend <$> ask <*> State.get)
-- | How many additional submission should the given corrector be assigned, if possible? -- | How many additional submission should the given corrector be assigned, if possible?
calculateDeficit :: UserId -> Map SubmissionId (Maybe UserId, Map UserId _, SheetId) -> Rational calculateDeficit :: UserId -> Map SubmissionId (Maybe UserId, Map UserId _, SheetId) -> Rational
calculateDeficit corrector submissionState = getSum $ foldMap Sum deficitBySheet calculateDeficit corrector submissionState = getSum $ foldMap Sum deficitBySheet
@ -178,7 +178,7 @@ assignSubmissions sid restriction = do
, fromMaybe 0 $ do , fromMaybe 0 $ do
guard $ corrState /= CorrectorExcused guard $ corrState /= CorrectorExcused
return . negate $ (byProportion / proportionSum) * fromIntegral sheetSize return . negate $ (byProportion / proportionSum) * fromIntegral sheetSize
] ]
| otherwise | otherwise
= assigned = assigned
return $ negate extra return $ negate extra
@ -257,6 +257,7 @@ submissionMultiArchive (Set.toList -> ids) = do
execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) -> execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid) tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
setContentDisposition' $ Just "submissions.zip"
(<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do (<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
let let
fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File