assignSubmission split into planning and assigning part
This commit is contained in:
Steffen Jost
parent
d832587b65
commit
0185fd3c87
@ -1744,7 +1744,7 @@ pageActions InstanceR = [
|
||||
]
|
||||
pageActions (HelpR) = [
|
||||
-- MenuItem
|
||||
-- { menuItemType = PageActionPrime
|
||||
-- { menuItemType = PageActionPrime
|
||||
-- , menuItemLabel = MsgInfoLecturerTitle
|
||||
-- , menuItemIcon = Nothing
|
||||
-- , menuItemRoute = SomeRoute InfoLecturerR
|
||||
@ -1754,7 +1754,7 @@ pageActions (HelpR) = [
|
||||
]
|
||||
pageActions (ProfileR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuProfileData
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute ProfileDataR
|
||||
@ -1762,7 +1762,7 @@ pageActions (ProfileR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuAuthPreds
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute AuthPredsR
|
||||
@ -1772,7 +1772,7 @@ pageActions (ProfileR) =
|
||||
]
|
||||
pageActions TermShowR =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuTermCreate
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute TermEditR
|
||||
@ -1782,7 +1782,7 @@ pageActions TermShowR =
|
||||
]
|
||||
pageActions (TermCourseListR tid) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseNew
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute CourseNewR
|
||||
@ -1790,7 +1790,7 @@ pageActions (TermCourseListR tid) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuTermEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ TermEditExistR tid
|
||||
@ -1810,7 +1810,7 @@ pageActions (TermSchoolCourseListR _tid _ssh) =
|
||||
]
|
||||
pageActions (CourseListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCourseNew
|
||||
, menuItemIcon = Just "book"
|
||||
, menuItemRoute = SomeRoute CourseNewR
|
||||
@ -1820,7 +1820,7 @@ pageActions (CourseListR) =
|
||||
]
|
||||
pageActions (CourseNewR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgInfoLecturerTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoLecturerR
|
||||
@ -1849,7 +1849,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
in runDB $ lecturerAccess `or2M` existsVisible
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
|
||||
@ -1877,7 +1877,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseMembers
|
||||
, menuItemIcon = Just "user-graduate"
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR
|
||||
@ -1885,7 +1885,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseCommunication
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CCommR
|
||||
@ -1893,7 +1893,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CEditR
|
||||
@ -1901,7 +1901,7 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseClone
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemRoute = SomeRoute (CourseNewR, [("tid", toPathPiece tid), ("ssh", toPathPiece ssh), ("csh", toPathPiece csh)])
|
||||
@ -1909,9 +1909,9 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CDeleteR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
@ -1919,17 +1919,17 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CCorrectionsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh SheetListR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetCurrent
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetCurrentR
|
||||
@ -1939,7 +1939,7 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetOldUnassigned
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassignedR
|
||||
@ -1949,25 +1949,25 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CCorrectionsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
|
||||
, ("corrections-school", CI.original $ unSchoolKey ssh)
|
||||
, ("corrections-course", CI.original csh)
|
||||
@ -1988,7 +1988,7 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
return ok
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetNewR
|
||||
@ -2082,7 +2082,7 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR
|
||||
@ -2094,7 +2094,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionOwnR
|
||||
@ -2118,49 +2118,49 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
, menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectors
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSheetEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetClone
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemIcon = Just "copy"
|
||||
, menuItemRoute = SomeRoute (CourseR tid ssh csh SheetNewR, [("shn", toPathPiece shn)])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SDelR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
@ -2168,7 +2168,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SSubsR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissionNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SubmissionNewR
|
||||
@ -2176,25 +2176,25 @@ pageActions (CSheetR tid ssh csh shn SSubsR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectors
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrectionsAssign
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SAssignR
|
||||
, menuItemModal = True
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuCorrection
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
@ -2202,7 +2202,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgCorrectorAssignTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubAssignR
|
||||
@ -2210,7 +2210,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSubmissionDelete
|
||||
, menuItemIcon = Just "trash"
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR
|
||||
@ -2220,7 +2220,7 @@ pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
]
|
||||
pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSubmissionDelete
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSubmissionR tid ssh csh shn cid SubDelR
|
||||
@ -2230,17 +2230,17 @@ pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) =
|
||||
]
|
||||
pageActions (CSheetR tid ssh csh shn SCorrR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuSubmissions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuSheetEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
|
||||
@ -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
|
||||
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)
|
||||
return $ fmap (view _1) newSubmissionData
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user