diff --git a/.vscode/tasks.json b/.vscode/tasks.json index fabc6a5d5..4c18542ba 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -14,6 +14,7 @@ "reveal": "always", "focus": false, "panel": "dedicated", + "clear": true, "showReuseMessage": false } }, diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 6ce7b8bbb..cd7300b09 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -34,6 +34,12 @@ GenericShort: Kürzel GenericIsNew: Neu GenericHasConflict: Konflikt GenericBack: Zurück +GenericChange: Änderung +GenericNumChange: +/- +GenericMin: Min +GenericAvg: Avg +GenericMax: Max +GenericAll: Insgesamt SummerTerm year@Integer: Sommersemester #{display year} WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year} @@ -316,6 +322,7 @@ Correctors: Korrektoren CorState: Status CorByTut: Zuteilung nach Tutorium CorProportion: Anteil +CorDeficit: Defizit CorByProportionOnly proportion@Rational: #{display proportion} Anteile CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium @@ -391,10 +398,11 @@ UpdatedAssignedCorrectorSingle num@Int64: #{display num} Abgaben wurden dem neue NoCorrector: Kein Korrektor RemovedCorrections num@Int64: Korrektur-Daten wurden von #{display num} Abgaben entfernt. UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den Korrektoren aufgeteilt. +UpdatedSheetCorrectorsAutoAssigned n@Int: #{display n} #{pluralDE n "Abgabe wurde einem Korrektor" "Abgaben wurden Korrektoren"} zugteilt. +UpdatedSheetCorrectorsAutoFailed n@Int: #{display n} #{pluralDE n "Abgabe konnte" "Abgaben konnten"} nicht automatisch zugewiesen werden. CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden: SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt! - CorrectionSheets: Übersicht Korrekturen nach Blättern CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt @@ -402,13 +410,15 @@ AssignSubmissionExceptionNoCorrectorsByProportion: Es sind keine Korrektoren mit AssignSubmissionExceptionSubmissionsNotFound n@Int: #{tshow n} Abgaben konnten nicht gefunden werden NrSubmittorsTotal: Abgebende NrSubmissionsTotal: Abgaben +NrSubmissionsTotalShort: Abg. NrSubmissionsUnassigned: Ohne Korrektor NoCorrectorAssigned: Ohne Korrektor NrCorrectors: Korrektoren NrSubmissionsNewlyAssigned: Neu zugeteilt NrSubmissionsNotAssigned: Nicht zugeteilt NrSubmissionsNotCorrected: Unkorrigiert -CorrectionTime: Korrekturdauer (Min/Avg/Max) +NrSubmissionsNotCorrectedShort: Unkg. +CorrectionTime: Korrekturdauer AssignSubmissionsRandomWarning: Die Zuteilungsvorschau kann von der tatsächlichen Zuteilung abweichen, wenn mehrere Blätter auf einmal zugeteilt werden, da beim Ausgleich der Kontigente nur bereits zugeteilte Abgaben berücksichtigt werden. Da es ein randomisierte Prozess ist, kann es auch bei einzelnen Blättern gerinfgügige Abweichungen geben. CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert: @@ -832,6 +842,7 @@ MenuCourseDelete: Kurs löschen MenuSubmissionNew: Abgabe anlegen MenuSubmissionOwn: Abgabe MenuCorrectors: Korrektoren +MenuCorrectorsChange: Korrektoren ändern MenuSheetEdit: Übungsblatt editieren MenuSheetDelete: Übungsblatt löschen MenuSheetClone: Als neues Übungsblatt klonen diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 38105a37a..bd8120ba7 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -2,6 +2,7 @@ module Database.Esqueleto.Utils ( true, false + , isJust , isInfixOf, hasInfix , any, all , SqlIn(..) @@ -11,7 +12,7 @@ module Database.Esqueleto.Utils , anyFilter, allFilter ) where -import ClassyPrelude.Yesod hiding (isInfixOf, any, all) +import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust) import qualified Data.Set as Set import qualified Data.Foldable as F import qualified Database.Esqueleto as E @@ -34,6 +35,10 @@ true = E.val True false :: E.SqlExpr (E.Value Bool) false = E.val False +-- | Negation of `isNothing` which is missing +isJust :: (E.Esqueleto query expr backend, PersistField typ) => expr (E.Value (Maybe typ)) -> expr (E.Value Bool) +isJust = E.not_ . E.isNothing + -- | Check if the first string is contained in the text derived from the second argument isInfixOf :: (E.Esqueleto query expr backend, E.SqlString s2) => Text -> expr (E.Value s2) -> expr (E.Value Bool) diff --git a/src/Foundation.hs b/src/Foundation.hs index 3be718bb7..3e243af41 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -206,6 +206,15 @@ noneOneMoreDE num noneText singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm +noneMoreDE :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Some + -> Text +noneMoreDE num noneText someText + | num == 0 = noneText + | otherwise = someText + -- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers type IntMaybe = Maybe Int type TextList = [Text] diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 049eda984..81335f4ac 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -337,13 +337,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d , ( "isassigned" , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) - Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingBy + Just True -> E.isJust $ submission E.^. SubmissionRatingBy Just False-> E.isNothing $ submission E.^. SubmissionRatingBy ) , ( "israted" , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) - Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime + Just True -> E.isJust $ submission E.^. SubmissionRatingTime Just False-> E.isNothing $ submission E.^. SubmissionRatingTime ) , ( "corrector-name-email" -- corrector filter does not work for text-filtering @@ -1139,30 +1139,33 @@ assignHandler tid ssh csh cid assignSids = do in List.foldr foldFun False sheetList -- plan or assign unassigned submissions for given sheets - let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) + let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) buildA acc sid = maybeT (return acc) $ do let shn = sheetName $ sheets ! sid -- is sheet closed? guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR -- we must check, whether the submission is already closed and thus assignable - -- has at least one uncorrected / unassigned submisison? - [E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do - E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid - E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy -- no corrector - E.where_ $ E.isNothing $ submission E.^. SubmissionRatingTime -- not done - guard hasSubmission - -- has at least one active corrector? - [E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do - E.where_ $ corrector E.^. SheetCorrectorSheet E.==. E.val sid - E.where_ $ corrector E.^. SheetCorrectorState E.==. E.val CorrectorNormal - -- E.where_ $ corrector E.^. SheetCorrectorLoad E./=. E.val (Load {byTutorial = Nothing, byProportion = 0}) - guard hasCorrector - -- TODO: Refactor guards above! We already have these informations, but forcing the maps inside the DB acces might not be a good idea - -- TODO: Maybe refactor planSubmissions instead to not throw exceptions, but signal "ok" or "not possible" instead! - plan <- lift $ planSubmissions sid Nothing + -- ask for assignment plan + let ignoreExceptions :: AssignSubmissionException -> DB (Map SubmissionId (Maybe UserId), Map UserId Rational) -- silently ignore errors, since we check all sheets and only care about sheets with unassigned corrections + ignoreExceptions NoCorrectors = return mempty + ignoreExceptions NoCorrectorsByProportion = return mempty + ignoreExceptions (SubmissionsNotFound _sids_not_found) = return mempty -- cannot happen, since last argument to planSubmissions is Nothing + (plan,deficit) <- lift $ handle ignoreExceptions $ planSubmissions sid Nothing + guard $ not $ null plan -- only proceed if there is a plan for this sheet + -- implement assignment plan status <- lift $ case btnResult of Nothing -> return (Set.empty, Set.empty) - (Just BtnSubmissionsAssign) -> writeSubmissionPlan plan -- TODO: this comes to late!! - return $ Map.insert shn (status, countMapElems plan) acc + (Just BtnSubmissionsAssign) -> do + status@(sub_ok,sub_fail) <- writeSubmissionPlan plan + let nr_ok = olength sub_ok + nr_fail = olength sub_fail + alert_ok = toMaybe (nr_ok > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoAssigned nr_ok + alert_fail = toMaybe (nr_fail > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoFailed nr_fail + msg_status = bool Success Error $ nr_fail > 0 + msg_header = SomeMessage $ shn <> ":" + when (nr_ok > 0 || nr_fail > 0) $ + addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail] + return status + return $ Map.insert shn (status, countMapElems plan, deficit) acc assignment <- foldM buildA Map.empty assignSids correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do @@ -1213,28 +1216,50 @@ assignHandler tid ssh csh cid assignSids = do -- create aggregate maps sheetMap :: Map SheetName CorrectionInfo sheetMap = Map.map fold infoMap + + sheetLoad :: Map SheetName Load + sheetLoad = -- Map.unionsWith (<>) ((Map.filter () ) . snd) <$> Map.elems correctorMap) + let buildSL acc (_user,mSnSc) = Map.foldlWithKey buildL acc mSnSc + buildL acc s SheetCorrector{sheetCorrectorLoad=l, sheetCorrectorState=CorrectorNormal} + = Map.insertWith (<>) s l acc + buildL acc _ _ = acc + in Map.foldl buildSL Map.empty correctorMap + + deficitMap :: Map UserId Rational + deficitMap = foldMap (view _3) assignment + corrMap :: Map (Maybe UserId) CorrectionInfo corrMap = Map.unionsWith (<>) $ Map.elems infoMap sheetNames = Map.keys infoMap let -- whamlet convenience functions - -- avoid nestes hamelt $maybe with duplicated $nothing + -- avoid nestes hamlet $maybe with duplicated $nothing getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector) getCorrector (Just uid) | Just (User{..},loadMap) <- Map.lookup uid correctorMap = (nameEmailWidget userEmail userDisplayName userSurname, loadMap) getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty) - -- avoid nestes hamelt $maybe with duplicated $nothing + -- avoid nestes hamlet $maybe with duplicated $nothing getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo getCorrSheetStatus corr shn | (Just smap) <- Map.lookup shn infoMap = Map.lookup corr smap getCorrSheetStatus _ _ = Nothing - -- avoid nestes hamelt $maybe with duplicated $nothing + -- avoid nestes hamlet $maybe with duplicated $nothing getCorrNewAssignment :: Maybe UserId -> SheetName -> Maybe Int getCorrNewAssignment corr shn - | (Just (_,cass)) <- Map.lookup shn assignment + | (Just (_,cass,_)) <- Map.lookup shn assignment = Map.lookup corr cass getCorrNewAssignment _ _ = Nothing + -- avoid nestes hamlet $maybe with duplicated $nothing + getCorrDeficit :: Maybe UserId -> Maybe Rational + getCorrDeficit (Just uid) = Map.lookup uid deficitMap + getCorrDeficit _ = Nothing + + getLoadSum :: SheetName -> Text + getLoadSum shn + | (Just load) <- Map.lookup shn sheetLoad + = "Σ" <> showCompactCorrectorLoad load CorrectorNormal + getLoadSum _ = mempty showDiffDays :: Maybe NominalDiffTime -> Text showDiffDays = foldMap formatDiffDays diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 7cb28cfa5..0a1e04e9c 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -66,7 +66,9 @@ 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 = planSubmissions sid restriction >>= writeSubmissionPlan +assignSubmissions sid restriction = do + (plan,_) <- planSubmissions sid restriction + writeSubmissionPlan plan -- | Assigns all submissions according to an already given assignment plan writeSubmissionPlan :: Map SubmissionId (Maybe UserId) @@ -89,8 +91,8 @@ writeSubmissionPlan newSubmissionData = do -- May throw an exception if there are no suitable correctors 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 + -> YesodDB UniWorX (Map SubmissionId (Maybe UserId), Map UserId Rational) + -- ^ Return map that assigns submissions to Corrector and another map showing each current correctors _previous_ deficit planSubmissions sid restriction = do Sheet{..} <- getJust sid correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do @@ -171,6 +173,10 @@ planSubmissions sid restriction = do -> m b withSubmissionData f = f <$> (mappend <$> ask <*> State.get) + -- | Old Deficit for protocol purposes, not used here + oldDeficit :: Map UserId Rational + oldDeficit = Map.mapWithKey (\k _v -> calculateDeficit k submissionData) sheetCorrectors + -- | How many additional submission should the given corrector be assigned, if possible? calculateDeficit :: UserId -> Map SubmissionId (Maybe UserId, Map UserId _, SheetId) -> Rational calculateDeficit corrector submissionState = getSum $ foldMap Sum deficitBySheet @@ -235,7 +241,7 @@ planSubmissions sid restriction = do ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors) - return $ fmap (view _1) newSubmissionData + return (fmap (view _1) newSubmissionData, oldDeficit) 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 diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 621ffd51e..5d3f6ba8b 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -3,20 +3,26 @@ _{MsgCourseParticipants nrParticipants} - +
_{MsgSheet} + _{MsgSheet} $if groupsPossible - _{MsgNrSubmittorsTotal} - _{MsgNrSubmissionsTotal} + _{MsgNrSubmittorsTotal} + _{MsgNrSubmissionsTotal} _{MsgNrSubmissionsNotAssigned} - _{MsgNrSubmissionsNotCorrected} + _{MsgNrSubmissionsNotCorrected} _{MsgCorrectionTime} +
+ _{MsgGenericNumChange} + _{MsgGenericMin} + _{MsgGenericAvg} + _{MsgGenericMax} $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)} $if groupsPossible #{ciSubmittors} #{ciSubmissions} - $maybe ((splus,sfailed),_) <- Map.lookup sheetName assignment + $maybe ((splus,sfailed),_,_) <- Map.lookup sheetName assignment $if 0 < Set.size sfailed #{ciSubmissions - ciAssigned} (-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)}) @@ -24,9 +30,11 @@ #{ciSubmissions - ciAssigned} (-#{show (Set.size splus)}) $else - #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciAssigned} + $nothing - #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciCorrected} #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} @@ -35,43 +43,62 @@

_{MsgCorrectionCorrectors} - +
_{MsgCorrector} - _{MsgNrSubmissionsTotal} - _{MsgNrSubmissionsNotCorrected} + _{MsgCorrector} + _{MsgGenericAll} + _{MsgCorProportion} _{MsgCorrectionTime} $forall shn <- sheetNames #{shn} $# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)} +
_{MsgNrSubmissionsTotal} + _{MsgNrSubmissionsNotCorrected} + _{MsgCorDeficit} + _{MsgGenericMin} + _{MsgGenericAvg} + _{MsgGenericMax} + $forall _shn <- sheetNames + _{MsgCorProportion} + _{MsgNrSubmissionsTotalShort} + _{MsgGenericNumChange} + _{MsgNrSubmissionsNotCorrectedShort} + _{MsgGenericAvg} $forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap $with (nameW,loadM) <- getCorrector ciCorrector
^{nameW} #{ciSubmissions} #{ciSubmissions - ciCorrected} + + $maybe deficit <- getCorrDeficit ciCorrector + #{display deficit} #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} #{showDiffDays ciMax} $forall shn <- sheetNames - $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM - #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} - $nothing - + + $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM + #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} $maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn + #{ciSubmissions} $maybe nrNew <- getCorrNewAssignment ciCorrector shn - #{ciSubmissions} $# #{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap` (+#{nrNew}) $nothing - #{ciSubmissions} + #{ciSubmissions - ciCorrected} #{showAvgsDays ciTot ciCorrected} $nothing - + + + + $if 0 < length sheetNames
$forall shn <- sheetNames - ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)} + #{getLoadSum shn} + ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} ^{btnWdgt}

_{MsgAssignSubmissionsRandomWarning} \ No newline at end of file diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 9db97efb6..2fdc1b3de 100644 --- a/templates/default-layout.lucius +++ b/templates/default-layout.lucius @@ -502,7 +502,7 @@ ul.list--inline { @media (min-width: 768px) { .deflist { - grid-template-columns: max-content minmax(auto, max-content); + grid-template-columns: max-content minmax(0, max-content); .deflist { margin-top: -10px; @@ -580,7 +580,7 @@ section { justify-content: center; } } - + .form-group__input > .notification { margin: 0; }