diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e1cfd10d2..e0a5882a3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -17,7 +17,7 @@ BtnLecInvAccept: Annehmen BtnLecInvDecline: Ablehnen BtnCorrInvAccept: Annehmen BtnCorrInvDecline: Ablehnen -BtnSubmissionsAssign: Abgaben zuteilen +BtnSubmissionsAssign: Abgaben automatisch zuteilen Aborted: Abgebrochen @@ -379,6 +379,7 @@ CorrDownload: Herunterladen CorrUploadField: Korrekturen CorrUpload: Korrekturen hochladen CorrSetCorrector: Korrektor zuweisen +CorrSetCorrectorTooltip: Bereits verteilte Abgaben müssen zuerst Korrektor zugewiesen werden, bevor diese neu verteilt werden. CorrAutoSetCorrector: Korrekturen verteilen CorrDelete: Abgaben löschen NatField name@Text: #{name} muss eine natürliche Zahl sein! @@ -827,7 +828,7 @@ MenuCorrectionsUpload: Korrekturen hochladen MenuCorrectionsDownload: Offene Abgaben herunterladen MenuCorrectionsCreate: Abgaben registrieren MenuCorrectionsGrade: Abgaben online korrigieren -MenuCorrectionsAssign: Abgaben an Korrektoren zuteilen +MenuCorrectionsAssign: Abgaben automatisch zuteilen MenuAuthPreds: Authorisierungseinstellungen MenuTutorialDelete: Tutorium löschen MenuTutorialEdit: Tutorium editieren diff --git a/src/Foundation.hs b/src/Foundation.hs index 675d6638b..4567440f8 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -967,7 +967,7 @@ evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . dnf let authVarSpecificity = authTagSpecificity `on` plVar authDNF = sortBy (authVarSpecificity `on` maximumBy authVarSpecificity . impureNonNull) $ map (sortBy authVarSpecificity) authDNF' - + authTagIsInactive = not . authTagIsActive evalAuthTag :: AuthTag -> WriterT (Set AuthTag) m AuthResult @@ -1427,6 +1427,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR tid ssh csh CInviteR) = return ("Einladung", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR) breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR) + breadcrumb (CourseR tid ssh csh CAssignR) = return ("Zuteilen" , Just $ CourseR tid ssh csh CCorrectionsR) breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR) breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR) @@ -1440,10 +1441,11 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CTutorialR tid ssh csh tutn TDeleteR) = return ("Löschen", Just $ CTutorialR tid ssh csh tutn TUsersR) breadcrumb (CTutorialR tid ssh csh tutn TCommR) = return ("Mitteilung", Just $ CTutorialR tid ssh csh tutn TUsersR) - breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR) - breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Bearbeiten", Just $ CSheetR tid ssh csh shn SShowR) - breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("Löschen", Just $ CSheetR tid ssh csh shn SShowR) - breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben", Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR) + breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Bearbeiten" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("Löschen" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben" , Just $ CSheetR tid ssh csh shn SShowR) + breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilen" , Just $ CSheetR tid ssh csh shn SSubsR) breadcrumb (CSheetR tid ssh csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 10364c814..20182e398 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -555,7 +555,7 @@ assignAction selId = ( CorrSetCorrector correctors' <- forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (SomeMessage userDisplayName, ) <$> encrypt entityKey - cId <- wopt (selectFieldList correctors' :: Field (HandlerT UniWorX IO) CryptoUUIDUser) (fslI MsgCorrector) Nothing + cId <- wopt (selectFieldList correctors' :: Field (HandlerT UniWorX IO) CryptoUUIDUser) (fslI MsgCorrector & setTooltip MsgCorrSetCorrectorTooltip) Nothing fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId ) @@ -1055,39 +1055,33 @@ assignHandler tid ssh csh rawSids = do -- guard $ saiCorrectorNr > 0 -- COMMENTED OUT BECAUSE we should show sheets without possible correctors to inform the user about these problematic sheets return $ Map.insert sid SubAssignInfo{..} acc let sids = Map.keys openSubs + linkBack <- simpleLinkI (SomeMessage MsgGenericBack) <$> case sids of + [sid] -> do Sheet{sheetName} <- runDB $ getJust sid + return $ CSheetR tid ssh csh sheetName SSubsR + _ -> return $ CourseR tid ssh csh CCorrectionsR -- process form currentRoute <- getCurrentRoute ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm FIDAssignSubmissions buttonForm - let headingShort = MsgMenuCorrectionsAssign + assignmentStatus <- case btnResult of + FormSuccess BtnSubmissionsAssign -> do -- Button was pressed, assign and report + -- Assign submissions + runDB $ (\f -> foldM f Map.empty sids) $ + \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing + -- Too much important information for an alert. Display proper info page instead + other -> do + formFailure2Alerts other -- show possible allerts + return Map.empty -- no assignments performed + let btnForm = wrapForm btnWdgt def + { formAction = SomeRoute <$> currentRoute + , formEncoding = btnEnctype + , formSubmit = FormNoSubmit + } + headingShort = MsgMenuCorrectionsAssign headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign - case btnResult of - FormSuccess BtnSubmissionsAssign -> do -- Button was pressed, assign and report - -- Assign submissions - status <- runDB $ (\f -> foldM f Map.empty sids) $ - \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing - -- Too much important information for an alert. Display proper info page instead - -- TODO: following convenience links available via breadcrumbs already? Or as PrimaryActions? - link <- case sids of - [sid] -> do Sheet{sheetName} <- runDB $ getJust sid - return $ CSheetR tid ssh csh sheetName SSubsR - _ -> return $ CourseR tid ssh csh CCorrectionsR - siteLayoutMsg headingShort $ do - setTitleI headingLong - $(widgetFile "corrections-assign-result") - simpleLinkI (SomeMessage MsgGenericBack) link - - other -> do -- all other cases, show what can be done - formFailure2Alerts other - -- show info about assignments - let btnForm = wrapForm btnWdgt def - { formAction = SomeRoute <$> currentRoute - , formEncoding = btnEnctype - , formSubmit = FormNoSubmit - } - status = Map.empty -- allows reuse of widget - siteLayoutMsg headingShort $ do - setTitleI headingLong - $(widgetFile "corrections-assign-result") - btnForm - + siteLayoutMsg headingShort $ do + setTitleI headingLong + $(widgetFile "corrections-assign") + if null sids || not (null assignmentStatus) + then linkBack -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction? + else btnForm diff --git a/templates/corrections-assign-result.hamlet b/templates/corrections-assign-result.hamlet deleted file mode 100644 index 2312758cf..000000000 --- a/templates/corrections-assign-result.hamlet +++ /dev/null @@ -1,46 +0,0 @@ -$# Display a table showing the result of the corrector assignment for possibly several sheets -$# Expected variables" -$# sids :: list of SheetId -$# openSubs :: Map from SheetId to SubAssignInfo, a datatype collecting info about open submissions -$# status :: Map from SheetId to (Set SubmissionId, Set SubmisionId), i.e. assigned submissions and unassigned submissions for that sheet -
- - - -
- _{MsgSheet} - - _{MsgNrSubmissionsTotal} - - _{MsgNrSubmissionsUnassigned} - - _{MsgNrCorrectors} - - _{MsgNrSubmissionsNewlyAssigned} - - _{MsgNrSubmissionsNotAssigned} - - $forall sid <- sids - $case Map.lookup sid openSubs - $of Nothing - - $of Just SubAssignInfo{saiName, saiSubmissionNr, saiUnassignedNr, saiCorrectorNr} -
- #{saiName} - - #{show saiSubmissionNr} - - #{show saiUnassignedNr} - - #{show saiCorrectorNr} - $case Map.lookup sid status - $of Nothing - - - - - $of Just (assigned,unassigned) - - #{show (Set.size assigned)} - - #{show (Set.size unassigned)} diff --git a/templates/corrections-assign.hamlet b/templates/corrections-assign.hamlet new file mode 100644 index 000000000..56bbbeeb5 --- /dev/null +++ b/templates/corrections-assign.hamlet @@ -0,0 +1,52 @@ +$# Display a table showing the result of the corrector assignment for possibly several sheets +$# Expected variables" +$# sids :: list of SheetId +$# openSubs :: Map from SheetId to SubAssignInfo, a datatype collecting info about open submissions +$# assignmentStatus :: Map from SheetId to (Set SubmissionId, Set SubmisionId), i.e. assigned submissions and unassigned submissions for that sheet +$if null sids +

+ _{MsgSheetNoOldUnassigned} +$else +

+ + + +
+ _{MsgSheet} + + _{MsgNrSubmissionsTotal} + + _{MsgNrSubmissionsUnassigned} + + _{MsgNrCorrectors} + $# Header-Styling indicates, whether assignment was attempted or not. + $with hasAssignment <- not (Map.null assignmentStatus) + + _{MsgNrSubmissionsNewlyAssigned} + + _{MsgNrSubmissionsNotAssigned} + + $forall sid <- sids + $case Map.lookup sid openSubs + $of Nothing + + $of Just SubAssignInfo{saiName, saiSubmissionNr, saiUnassignedNr, saiCorrectorNr} +
+ #{saiName} + + #{show saiSubmissionNr} + + #{show saiUnassignedNr} + + #{show saiCorrectorNr} + $case Map.lookup sid assignmentStatus + $of Nothing + + + + + $of Just (assigned,unassigned) + + #{show (Set.size assigned)} + + #{show (Set.size unassigned)}