Implementation okay, but throws NoCorrectors (FIXME)
This commit is contained in:
Steffen Jost
parent
718a2b026c
commit
e33704dca4
@ -1042,19 +1042,21 @@ data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiC
|
||||
getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCAssignR = postCAssignR
|
||||
postCAssignR tid ssh csh = do
|
||||
shids <- runDB $ do
|
||||
(shids,cid) <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
assignHandler tid ssh csh shids
|
||||
shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
|
||||
return (shids,cid)
|
||||
assignHandler tid ssh csh cid shids
|
||||
|
||||
getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSAssignR = postSAssignR
|
||||
postSAssignR tid ssh csh shn = do
|
||||
shid <- runDB $ fetchSheetId tid ssh csh shn
|
||||
assignHandler tid ssh csh [shid]
|
||||
(shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
|
||||
assignHandler tid ssh csh cid [shid]
|
||||
|
||||
assignHandler :: TermId -> SchoolId -> CourseShorthand -> [SheetId] -> Handler Html
|
||||
assignHandler tid ssh csh rawSids = do
|
||||
-- DEPRECATED assignHandler'
|
||||
assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
|
||||
assignHandler' tid ssh csh _cid rawSids = do
|
||||
-- gather data
|
||||
openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $
|
||||
\acc sid -> maybeT (return acc) $ do
|
||||
@ -1094,11 +1096,28 @@ assignHandler tid ssh csh rawSids = do
|
||||
else btnForm
|
||||
|
||||
|
||||
assignHandler' :: TermId -> SchoolId -> CourseShorthand -> [SheetId] -> Handler Html
|
||||
assignHandler' tid ssh csh _rawSids = do
|
||||
{- TODO: make buttons for each sheet, so that users see which sheet is assigned
|
||||
data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Button UniWorX ButtonCorrectionsAssign
|
||||
-- Are those needed any more?
|
||||
instance Universe ButtonCorrectionsAssign
|
||||
instance Finite ButtonCorrectionsAssign
|
||||
nullaryPathPiece ''ButtonCorrectionsAssign camelToPathPiece
|
||||
embedRenderMessage ''UniWorX ''ButtonCorrectionsAssign id
|
||||
instance Button UniWorX ButtonCorrectionsAssign where
|
||||
btnClasses BtnCorrectionsAssign = [BCIsButton, BCPrimary]
|
||||
-- use runButtonForm' instead later on
|
||||
-}
|
||||
|
||||
assignHandler :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
|
||||
assignHandler tid ssh csh cid assignSids = do
|
||||
-- evaluate form first, since it affects DB action
|
||||
(btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
|
||||
|
||||
-- gather data
|
||||
(nrParticipants, groupsPossible, infoMap, correctorMap) <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
(nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
|
||||
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
nrParticipants <- count [CourseParticipantCourse ==. cid]
|
||||
|
||||
sheetList <- selectList [SheetCourse ==. cid] [Asc SheetName]
|
||||
@ -1144,7 +1163,19 @@ assignHandler' tid ssh csh _rawSids = do
|
||||
, ciMax = corTime
|
||||
}
|
||||
in Map.insertWith (Map.unionWith (<>)) shnm cinf m
|
||||
return (nrParticipants, groupsPossible, infoMap, correctorMap)
|
||||
-- plan or assign unassigned submissions for given sheets
|
||||
-- assignment :: Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)
|
||||
assignment <- fmap Map.fromList $ forM assignSids $ \sid -> do
|
||||
plan <- planSubmissions sid Nothing
|
||||
let shn = sheetName $ sheets ! sid
|
||||
status <- case btnResult of
|
||||
Nothing -> return (Set.empty, Set.empty)
|
||||
(Just BtnSubmissionsAssign) -> writeSubmissionPlan plan
|
||||
return (shn, (status, countMapElems plan))
|
||||
|
||||
return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
|
||||
|
||||
|
||||
|
||||
let -- create aggregate maps
|
||||
sheetMap :: Map SheetName CorrectionInfo
|
||||
@ -1167,60 +1198,7 @@ assignHandler' tid ssh csh _rawSids = do
|
||||
headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
|
||||
siteLayoutMsg headingShort $ do
|
||||
setTitleI headingLong
|
||||
-- TODO: Move whamlet into separate Widget-File, once completed
|
||||
[whamlet|
|
||||
<div>
|
||||
<h2>_{MsgCorrectionSheets}
|
||||
_{MsgCourseParticipants nrParticipants}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgSheet}
|
||||
$if groupsPossible
|
||||
<th .table__th>_{MsgNrSubmittorsTotal}
|
||||
<th .table__th>_{MsgNrSubmissionsTotal}
|
||||
<th .table__th>_{MsgNrSubmissionsNotAssigned}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
|
||||
$if groupsPossible
|
||||
<td .table__td>#{ciSubmittors}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<td .table__td>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td>#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
<div>
|
||||
<h2>_{MsgCorrectionCorrectors}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgCorrector}
|
||||
<th .table__th>_{MsgNrSubmissionsTotal}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall shn <- sheetNames
|
||||
<th .table__th colspan=3>#{shn}
|
||||
$forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{showCorrector ciCorrector}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<td .table__td>#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
$forall shn <- sheetNames
|
||||
$maybe smap <- Map.lookup shn infoMap
|
||||
$maybe CorrectionInfo{ciAssigned,ciCorrected,ciTot} <- Map.lookup ciCorrector smap
|
||||
<td .table__td>#{ciAssigned}
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=3>
|
||||
$nothing
|
||||
<td .table__td colspan=3>
|
||||
|]
|
||||
$(widgetFile "corrections-overview")
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
module Handler.Utils.Submission
|
||||
( AssignSubmissionException(..)
|
||||
, assignSubmissions
|
||||
, assignSubmissions, writeSubmissionPlan, planSubmissions
|
||||
, submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
|
||||
, submissionFileSource, submissionFileQuery
|
||||
, submissionMultiArchive
|
||||
@ -66,8 +66,15 @@ assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
|
||||
-> YesodDB UniWorX ( Set SubmissionId
|
||||
, 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
|
||||
assignSubmissions sid restriction = planSubmissions sid restriction >>= writeSubmissionPlan
|
||||
|
||||
-- | Assigns all submissions according to an already given assignment plan
|
||||
writeSubmissionPlan :: Map SubmissionId (Maybe UserId)
|
||||
-- ^ map that assigns submissions to correctors
|
||||
-> YesodDB UniWorX ( Set SubmissionId
|
||||
, Set SubmissionId
|
||||
) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
|
||||
writeSubmissionPlan newSubmissionData = do
|
||||
now <- liftIO getCurrentTime
|
||||
execWriterT . forM_ (Map.toList newSubmissionData) $ \(subId, mCorrector) -> case mCorrector of
|
||||
Just corrector -> do
|
||||
@ -78,7 +85,6 @@ assignSubmissions sid restriction = do
|
||||
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
|
||||
|
||||
@ -500,6 +500,11 @@ partMap = Map.fromListWith mappend
|
||||
invertMap :: (Ord k, Ord v) => Map k v -> Map v (Set k)
|
||||
invertMap = groupMap . map swap . Map.toList
|
||||
|
||||
-- | Counts how often a value appears in a map (not derived from invertMap for efficiency reasons)
|
||||
countMapElems :: (Ord v) => Map k v -> Map v Int
|
||||
countMapElems = Map.fromListWith (+) . map (\(_k,v)->(v,1)) . Map.toList
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
-- Functions --
|
||||
|
||||
@ -356,10 +356,11 @@ buttonView btn = do
|
||||
fieldView bField btnId "" mempty (Right btn) False
|
||||
|
||||
|
||||
|
||||
-- | generate a form that only shows a finite amount of buttons
|
||||
buttonForm :: (Button site a, Finite a) => Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
|
||||
buttonForm = buttonForm' universeF
|
||||
|
||||
-- | like `buttonForm`, but for a given list of buttons, i.e. a subset or for buttons outside the Finite typeclass
|
||||
buttonForm' :: Button site a => [a] -> Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
|
||||
buttonForm' btns csrf = do
|
||||
(res, ($ []) -> fViews) <- aFormToForm . disambiguateButtons $ combinedButtonField btns ""
|
||||
@ -370,6 +371,35 @@ buttonForm' btns csrf = do
|
||||
^{fvInput bView}
|
||||
|])
|
||||
|
||||
-- | buttons-only form complete with widget-generation and evaluation; return type determines buttons shown.
|
||||
runButtonForm ::(PathPiece ident, Eq ident, RenderMessage site FormMessage,
|
||||
Button site ButtonSubmit, Button site a, Finite a)
|
||||
=> ident -> HandlerT site IO (WidgetT site IO (), Maybe a)
|
||||
runButtonForm fid = do
|
||||
currentRoute <- getCurrentRoute
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm fid buttonForm
|
||||
let btnForm = wrapForm btnWdgt def { formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
res <- formResultMaybe btnResult (return . Just)
|
||||
return (btnForm, res)
|
||||
|
||||
-- | like `runButtonForm` but showing only a given list of buttons, especially for buttons that are not in the Finite typeclass.
|
||||
runButtonForm' ::(PathPiece ident, Eq ident, RenderMessage site FormMessage,
|
||||
Button site ButtonSubmit, Button site a)
|
||||
=> [a] -> ident -> HandlerT site IO (WidgetT site IO (), Maybe a)
|
||||
runButtonForm' btns fid = do
|
||||
currentRoute <- getCurrentRoute
|
||||
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm fid $ buttonForm' btns
|
||||
let btnForm = wrapForm btnWdgt def { formAction = SomeRoute <$> currentRoute
|
||||
, formEncoding = btnEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
res <- formResultMaybe btnResult (return . Just)
|
||||
return (btnForm, res)
|
||||
|
||||
|
||||
-------------------
|
||||
-- Custom Fields --
|
||||
-------------------
|
||||
|
||||
69
templates/corrections-overview.hamlet
Normal file
69
templates/corrections-overview.hamlet
Normal file
@ -0,0 +1,69 @@
|
||||
<div>
|
||||
<h2>_{MsgCorrectionSheets}
|
||||
_{MsgCourseParticipants nrParticipants}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgSheet}
|
||||
$if groupsPossible
|
||||
<th .table__th>_{MsgNrSubmittorsTotal}
|
||||
<th .table__th colspan=2>_{MsgNrSubmissionsTotal}
|
||||
<th .table__th colspan=2>_{MsgNrSubmissionsNotAssigned}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
|
||||
$if groupsPossible
|
||||
<td .table__td>#{ciSubmittors}
|
||||
$maybe ((splus,sfailed),_) <- Map.lookup sheetName assignment
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<td .table__td .alert-success>(+#{show (Set.size splus)})
|
||||
<td .table__td>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td .alert-danger>(#{show (Set.size sfailed)})
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciSubmissions}
|
||||
<td .table__td colspan=2>#{ciSubmissions - ciAssigned}
|
||||
<td .table__td>#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
<div>
|
||||
<h2>_{MsgCorrectionCorrectors}
|
||||
<table .table .table--striped .table--hover>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgCorrector}
|
||||
<th .table__th>_{MsgNrSubmissionsTotal}
|
||||
<th .table__th>_{MsgNrSubmissionsNotCorrected}
|
||||
<th .table__th colspan=3>_{MsgCorrectionTime}
|
||||
$forall shn <- sheetNames
|
||||
<th .table__th colspan=4>#{shn}
|
||||
$forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
|
||||
<tr .table__row>
|
||||
<td .table__td>^{showCorrector ciCorrector}
|
||||
<td .table__td>#{ciSubmissions}
|
||||
<td .table__td>#{ciSubmissions - ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMin}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
<td .table__td>#{showDiffDays ciMax}
|
||||
$forall shn <- sheetNames
|
||||
$maybe smap <- Map.lookup shn infoMap
|
||||
$maybe CorrectionInfo{ciAssigned,ciCorrected,ciTot} <- Map.lookup ciCorrector smap
|
||||
$maybe (_,cass) <- Map.lookup shn assignment
|
||||
$maybe nrNew <- Map.lookup ciCorrector cass
|
||||
<td .table__td>#{ciAssigned}
|
||||
<td .table__td .alert-success>(+#{nrNew})
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciAssigned}
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=2>#{ciAssigned}
|
||||
<td .table__td>#{ciAssigned - ciCorrected}
|
||||
<td .table__td>#{showAvgsDays ciTot ciCorrected}
|
||||
$nothing
|
||||
<td .table__td colspan=4>
|
||||
$nothing
|
||||
<td .table__td colspan=4>
|
||||
^{btnWdgt}
|
||||
Loading…
Reference in New Issue
Block a user