assignSubmission split into planning and assigning part

This commit is contained in:
Steffen Jost 2019-06-13 09:49:17 +02:00
parent d832587b65
commit 0185fd3c87
2 changed files with 76 additions and 66 deletions

View File

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

View File

@ -67,6 +67,24 @@ assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
, Set SubmissionId , Set SubmissionId
) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load ) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
assignSubmissions sid restriction = do 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 Sheet{..} <- getJust sid
correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet 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) ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors)
now <- liftIO getCurrentTime return $ fmap (view _1) newSubmissionData
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)
where where
maximumsBy :: (Ord a, Ord b) => (a -> b) -> Set a -> Set a 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 maximumsBy f xs = flip Set.filter xs $ \x -> maybe True (((==) `on` f) x . maximumBy (comparing f)) $ fromNullable xs