fix(correction assignment): correcting lecturer's names are shown now
Table only shows sheet correctors, but lecturers may occasionally correct too
This commit is contained in:
parent
d07f53e1d8
commit
16c556b852
@ -1085,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do
|
|||||||
(btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
|
(btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
|
||||||
|
|
||||||
-- gather data
|
-- gather data
|
||||||
(assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
|
(assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames) <- runDB $ do
|
||||||
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
nrParticipants <- count [CourseParticipantCourse ==. cid]
|
nrParticipants <- count [CourseParticipantCourse ==. cid]
|
||||||
|
|
||||||
@ -1141,6 +1141,12 @@ assignHandler tid ssh csh cid assignSids = do
|
|||||||
in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc
|
in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc
|
||||||
)
|
)
|
||||||
|
|
||||||
|
-- lecturerNames :: Map UserId User
|
||||||
|
lecturerNames <- fmap entities2map $ E.select $ E.from $ \(user `E.InnerJoin` lecturer) -> do
|
||||||
|
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
|
||||||
|
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||||
|
return user
|
||||||
|
|
||||||
submissions <- E.select . E.from $ \submission -> do
|
submissions <- E.select . E.from $ \submission -> do
|
||||||
E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
|
E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
|
||||||
let numSubmittors = E.sub_select . E.from $ \subUser -> do
|
let numSubmittors = E.sub_select . E.from $ \subUser -> do
|
||||||
@ -1173,7 +1179,7 @@ assignHandler tid ssh csh cid assignSids = do
|
|||||||
}
|
}
|
||||||
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
|
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
|
||||||
|
|
||||||
return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
|
return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames)
|
||||||
|
|
||||||
let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
|
let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
|
||||||
-- create aggregate maps
|
-- create aggregate maps
|
||||||
@ -1203,7 +1209,6 @@ assignHandler tid ssh csh cid assignSids = do
|
|||||||
corrInfos = sortBy (compare `on` (byName . ciCorrector) ) $ Map.elems corrMap
|
corrInfos = sortBy (compare `on` (byName . ciCorrector) ) $ Map.elems corrMap
|
||||||
where byName Nothing = Nothing
|
where byName Nothing = Nothing
|
||||||
byName (Just uid) = Map.lookup uid correctorMap
|
byName (Just uid) = Map.lookup uid correctorMap
|
||||||
|
|
||||||
corrMapSum :: CorrectionInfo
|
corrMapSum :: CorrectionInfo
|
||||||
corrMapSum = fold corrMap
|
corrMapSum = fold corrMap
|
||||||
|
|
||||||
@ -1213,6 +1218,8 @@ assignHandler tid ssh csh cid assignSids = do
|
|||||||
getCorrector (Just uid)
|
getCorrector (Just uid)
|
||||||
| Just (User{..},loadMap) <- Map.lookup uid correctorMap
|
| Just (User{..},loadMap) <- Map.lookup uid correctorMap
|
||||||
= (nameEmailWidget userEmail userDisplayName userSurname, loadMap)
|
= (nameEmailWidget userEmail userDisplayName userSurname, loadMap)
|
||||||
|
| Just (User{..} ) <- Map.lookup uid lecturerNames
|
||||||
|
= (nameEmailWidget userEmail userDisplayName userSurname, mempty) -- lecturers may also correct in rare cases
|
||||||
getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty)
|
getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty)
|
||||||
-- avoid nestes hamlet $maybe with duplicated $nothing
|
-- avoid nestes hamlet $maybe with duplicated $nothing
|
||||||
getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo
|
getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo
|
||||||
|
|||||||
Reference in New Issue
Block a user