diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 856e4e3ec..46c76046c 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -69,7 +69,7 @@ CourseSemester: Semester CourseSchool: Institut CourseSchoolShort: Fach CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt -CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich +CourseRegisterFromTip: Ohne Datum ist keine eigenständige Anmeldung von Studierenden möglich CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein CourseFilterSearch: Volltext-Suche @@ -145,8 +145,8 @@ SubmissionFile: Datei zur Abgabe SubmissionFiles: Abgegebene Dateien SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt. -SubmissionsDeleteQuestion count@Int: Wollen Sie #{pluralDE count "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen? -SubmissionsDeleted count@Int: #{pluralDE count "Abgabe gelöscht" "Abgaben gelöscht"} +SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen? +SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"} SubmissionGroupName: Gruppenname @@ -416,8 +416,9 @@ SheetTypeNotGraded: Unbewertet SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer. SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt. -SheetGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Blätter -SubmissionGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Abgaben +SummaryTitle: Zusammenfassung über alle +SheetGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Blatt" "Blätter"} +SubmissionGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Abgabe" "Abgaben"} SheetTypeBonus': Bonus SheetTypeNormal': Normal @@ -587,6 +588,6 @@ AuthTagAuthentication: Authentifizierung erfüllt Anforderungen AuthTagRead: Zugriff ist nur lesend AuthTagWrite: Zugriff ist i.A. schreibend -DeleteCopyStringIfSure count@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE count "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab. +DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab. DeleteConfirmation: Bestätigung DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen. \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index 14b182683..7d5aef0cd 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -147,10 +147,11 @@ pattern CSubmissionR tid ssh csh shn cid ptn = CSheetR tid ssh csh shn (SubmissionR cid ptn) -pluralDE :: Int -- ^ Count - -> Text -- ^ Singular - -> Text -- ^ Plural - -> Text +pluralDE :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text pluralDE num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index b9a9c60ee..794d88071 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -248,10 +248,9 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId - E.orderBy [E.asc $ user E.^. UserDisplayName] + E.orderBy [E.asc $ user E.^. UserSurname] E.limit 1 - return (user E.^. UserDisplayName) - + return (user E.^. UserSurname) ) ] , dbtFilter = Map.fromList diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 0450740dc..b107ae83b 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -202,7 +202,7 @@ getSheetListR tid ssh csh = do ] psValidator = def - & defaultSorting [SortAscBy "submission-since"] + & defaultSorting [SortDescBy "submission-since"] (table,raw_statistics) <- runDB $ liftA2 (,) (dbTableWidget' psValidator DBTable diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs index 150b7cd63..43b98a92f 100644 --- a/src/Handler/Utils/SheetType.hs +++ b/src/Handler/Utils/SheetType.hs @@ -9,25 +9,22 @@ import Utils.Lens addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary addBonusToPoints sts = - sts & _normalSummary . _achievedPoints %~ maxBonusPts . addBonusPts - & _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass + sts & _normalSummary . _achievedPasses %~ (min passmax . (passbonus +)) + & _normalSummary . _achievedPoints %~ (min ptsmax . (ptsbonus +)) where - bonusPoints = sts ^. _bonusSummary . _achievedPoints - maxPoints = sts ^. _normalSummary . _sumGradePoints - maxBonusPts = fmap $ min maxPoints - addBonusPts = maybeAdd bonusPoints + passmax = sts ^. _normalSummary . _numMarkedPasses + passbonus = sts ^. _bonusSummary . _achievedPasses + ptsmax = sts ^. _normalSummary . _sumMarkedPoints + ptsbonus = sts ^. _bonusSummary . _achievedPoints - bonusPasses = sts ^. _bonusSummary . _achievedPasses - maxPasses = sts ^. _normalSummary . _numGradePasses - maxBonusPass = fmap $ min maxPasses - addBonusPass = maybeAdd bonusPasses - -gradeSummaryWidget :: RenderMessage UniWorX msg => (Int -> msg) -> SheetTypeSummary -> Widget +gradeSummaryWidget :: RenderMessage UniWorX msg => (Integer -> msg) -> SheetTypeSummary -> Widget gradeSummaryWidget title sts = let SheetTypeSummary{..} = addBonusToPoints sts - sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded) - hasPassings = positiveSum $ numGradePasses sumSummaries - hasPoints = positiveSum $ sumGradePoints sumSummaries + sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded) + hasPasses = positiveSum $ numSheetsPasses sumSummaries + hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries + hasPoints = positiveSum $ numSheetsPoints sumSummaries + hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") | (sumHeader,summary) <- [ (MsgSheetTypeNormal' ,normalSummary) diff --git a/src/Model.hs b/src/Model.hs index 417c551fb..9eb258cc3 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -11,7 +11,7 @@ import Database.Persist.Quasi import Database.Persist.TH.Directory -- import Data.Time -- import Data.ByteString -import Model.Types +import Model.Types hiding (_maxPoints, _passingPoints) import Cron.Types import Data.Aeson (Value) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 0e56bc058..ba3fca139 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -109,7 +109,7 @@ instance FromJSON a => FromJSON (E.Value a) where parseJSON = fmap E.Value . parseJSON - +type Count = Sum Integer type Points = Centi toPoints :: Integral a => a -> Points -- deprecated @@ -123,6 +123,8 @@ fromPoints = round instance DisplayAble Points +instance DisplayAble a => DisplayAble (Sum a) where + display (Sum x) = display x data SheetGrading = Points { maxPoints :: Points } @@ -137,17 +139,35 @@ deriveJSON defaultOptions } ''SheetGrading derivePersistFieldJSON ''SheetGrading +makeLenses_ ''SheetGrading + +_passingBound :: Fold SheetGrading (Either () Points) +_passingBound = folding passPts + where + passPts :: SheetGrading -> Maybe (Either () Points) + passPts (Points{}) = Nothing + passPts (PassPoints{passingPoints}) = Just $ Right passingPoints + passPts (PassBinary) = Just $ Left () + gradingPassed :: SheetGrading -> Points -> Maybe Bool -gradingPassed (Points {}) _ = Nothing -gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints -gradingPassed (PassBinary {}) pts = Just $ pts /= 0 +gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound + where pBinary _ = pts /= 0 + pPoints b = pts >= b + data SheetGradeSummary = SheetGradeSummary - { numSheets :: Sum Int - , numGradePasses :: Sum Int - , sumGradePoints :: Sum Points - , achievedPasses :: Maybe (Sum Int) - , achievedPoints :: Maybe (Sum Points) + { numSheets :: Count -- Total number of sheets, includes all + , numSheetsPasses :: Count -- Number of sheets required to pass FKA: numGradePasses + , numSheetsPoints :: Count -- Number of sheets having points FKA: sumGradePointsd + , sumSheetsPoints :: Sum Points -- Total of all points in all sheets + -- Marking dependend + , numMarked :: Count -- Number of already marked sheets + , numMarkedPasses :: Count -- Number of already marked sheets with passes + , numMarkedPoints :: Count -- Number of already marked sheets with points + , sumMarkedPoints :: Sum Points -- Achieveable points within marked sheets + -- + , achievedPasses :: Count -- Achieved passes (within marked sheets) + , achievedPoints :: Sum Points -- Achieved points (within marked sheets) } deriving (Generic, Read, Show, Eq) instance Monoid SheetGradeSummary where @@ -160,20 +180,23 @@ instance Semigroup SheetGradeSummary where makeLenses_ ''SheetGradeSummary sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary +sheetGradeSum gr Nothing = mempty + { numSheets = 1 + , numSheetsPasses = bool mempty 1 $ has _passingBound gr + , numSheetsPoints = bool mempty 1 $ has _maxPoints gr + , sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints + } sheetGradeSum gr (Just p) = - let baseSum = (sheetGradeSum gr Nothing) { achievedPasses = Sum . bool 0 1 <$> gradingPassed gr p } - in case gr of PassBinary -> baseSum - _other -> baseSum { achievedPoints = Just $ Sum $ p } -sheetGradeSum (Points {..}) Nothing = mempty { numSheets = Sum 1 - , sumGradePoints = Sum maxPoints - } -sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets = Sum 1 - , numGradePasses = Sum 1 - , sumGradePoints = Sum maxPoints - } -sheetGradeSum (PassBinary) Nothing = mempty { numSheets = Sum 1 - , numGradePasses = Sum 1 - } + let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing + in unmarked + { numMarked = numSheets + , numMarkedPasses = numSheetsPasses + , numMarkedPoints = numSheetsPoints + , sumMarkedPoints = sumSheetsPoints + , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p + , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr + } + data SheetType = Normal { grading :: SheetGrading } @@ -193,7 +216,7 @@ data SheetTypeSummary = SheetTypeSummary { normalSummary , bonusSummary , informationalSummary :: SheetGradeSummary - , numNotGraded :: Sum Int + , numNotGraded :: Count } deriving (Generic, Read, Show, Eq) instance Monoid SheetTypeSummary where diff --git a/src/Utils.hs b/src/Utils.hs index 08a26fc99..0ef105453 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -337,7 +337,7 @@ ifMaybeM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argu ifMaybeM Nothing dft _ = return dft ifMaybeM (Just x) _ act = act x -maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespear: one $maybe instead of $with & $if +maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespeare: one $maybe instead of $with & $if maybePositive a | a > 0 = Just a | otherwise = Nothing diff --git a/templates/widgets/gradingSummary.hamlet b/templates/widgets/gradingSummary.hamlet index a1c62237c..204f4fd28 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -1,15 +1,25 @@ $# Displays gradings Summary for various purposes +$# Expects several variables: +$# sumSummaries :: SheetGradeSummary -- summary over all grading types +$# hasPasses :: Maybe Int -- Should Passing be displayed? +$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets +$# hasPoints :: Maybe Points -- Should Points be displayed? +$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets $# --
-

_{title $ getSum $ numSheets $ sumSummaries} +

_{MsgSummaryTitle} _{title $ getSum $ numSheets $ sumSummaries} +$# TODO: Durschnittliche Punktzahl anzeigen +$# TODO: Extra-Spalte für Punkte Bewertet = numMarkedPoints / Punkte Gesamt = sumSheetPoints +$# + $maybe _ <- positiveSum $ summary ^. _numSheets +
- $# empty cell for row headers - $maybe _ <- hasPassings - _{MsgSheetGradingPassing'} + $# empty cell for row headers + $maybe _ <- hasMarkedPasses + _{MsgCorrected} + $maybe _ <- hasPasses + _{MsgSheetGradingPassing'} + $maybe _ <- hasMarkedPoints + _{MsgCorrected} $maybe _ <- hasPoints - _{MsgSheetGradingPoints'} + _{MsgSheetGradingPoints'} _{MsgSheetGradingCount'} $# Number of Sheet/Submissions used for calculating maximum passes/points $forall row <- rowWdgts @@ -17,14 +27,18 @@ $# -- $maybe nrNoGrade <- positiveSum $ numNotGraded
_{MsgSheetTypeNotGraded} - $maybe _ <- hasPassings + $maybe _ <- hasMarkedPasses - $maybe _ <- hasPoints + $maybe _ <- hasPasses + + $maybe _ <- hasMarkedPoints + $maybe _ <- hasPoints + #{display nrNoGrade} $maybe _ <- positiveSum $ bonusSummary ^. _numSheets -

_{MsgSheetTypeInfoBonus} - $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints) +

_{MsgSheetTypeInfoBonus} # + $maybe _ <- positiveSum $ bonusSummary ^. _achievedPoints _{MsgSheetGradingBonusIncluded} $maybe _ <- positiveSum $ informationalSummary ^. _numSheets

_{MsgSheetTypeInfoNotGraded} diff --git a/templates/widgets/gradingSummaryRow.hamlet b/templates/widgets/gradingSummaryRow.hamlet index 01e63efeb..0b40eeba3 100644 --- a/templates/widgets/gradingSummaryRow.hamlet +++ b/templates/widgets/gradingSummaryRow.hamlet @@ -1,33 +1,40 @@ $# Displays one row of the grading summary $# Expects several variables: -$# hasPassing :: Maybe Int -- Should Passing be displayed? -$# hasPoints :: Maybe Poibts -- Should Points be displayed? $# summary :: SheetGradeSummary -- summary to display $# sumHeader :: UniWorXMessage -- row header +$# hasPasses :: Maybe Int -- Should Passing be displayed? +$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets +$# hasPoints :: Maybe Points -- Should Points be displayed? +$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets $# - $maybe nrSheets <- positiveSum $ summary ^. _numSheets -

_{sumHeader} - $maybe _ <- hasPassings - $with Sum pmax <- summary ^. _numGradePasses - $maybe Sum pacv <- summary ^. _achievedPasses - - $if pmax /= 0 - #{textPercentInt pacv pmax} - - #{display pacv} / #{display pmax} - $nothing - - #{display pmax } + $maybe _ <- hasMarkedPasses + $with Sum pmax <- summary ^. _numMarkedPasses + $with Sum pacv <- summary ^. _achievedPasses + + $if pmax > 0 + #{textPercentInt pacv pmax} + + #{display pacv} / #{display pmax} + $maybe _ <- hasPasses + + #{display $ summary ^. _numSheetsPasses} + $maybe _ <- hasMarkedPoints + $with Sum pmax <- summary ^. _sumMarkedPoints + $with Sum pacv <- summary ^. _achievedPoints + + $if pmax > 0 + #{textPercent $ realToFrac $ pacv / pmax} + + #{display pacv} / #{display pmax} + \ (_{title $ getSum $ summary ^. _numMarkedPoints}) $maybe _ <- hasPoints - $with Sum pmax <- summary ^. _sumGradePoints - $maybe Sum pacv <- summary ^. _achievedPoints - - $if pmax /= 0 - #{textPercent $ realToFrac $ pacv / pmax} - - #{display pacv} / #{display pmax} - $nothing - - #{display pmax } - #{display nrSheets} \ No newline at end of file + + #{display (summary ^. _sumSheetsPoints)} + \ (_{title $ getSum $ summary ^. _numSheetsPoints}) + #{display $ summary ^. _numSheets} \ No newline at end of file diff --git a/templates/widgets/sheetTypeSummary.hamlet b/templates/widgets/sheetTypeSummary.hamlet deleted file mode 100644 index 8609b82b2..000000000 --- a/templates/widgets/sheetTypeSummary.hamlet +++ /dev/null @@ -1,41 +0,0 @@ -$# DEPRECATED IN FAVOUR OF widgets/gradingSummary.hamlet DO NOT USE !!! -$with realGrades <- normalSummary <> bonusSummary - $# $with allGrades <- realGrades <> informationalSummary -
- $maybe realPoints <- positiveSum (sumGradePoints realGrades) -

- Gesamtpunktzahl #{display realPoints} - $maybe nPts <- getSum <$> achievedPoints realGrades - \ davon #{display nPts} erreicht - $maybe bPts <- getSum <$> achievedPoints bonusSummary - \ (inklusive #{display bPts} # - $maybe achievedBonus <- positiveSum (sumGradePoints bonusSummary) - von #{display achievedBonus} erreichbaren # - Bonuspunkten) - $if realPoints /= 0 - \ #{textPercent $ realToFrac $ nPts / realPoints} - \. - $maybe fakePoints <- positiveSum (sumGradePoints informationalSummary) -

- Hinweis: - \ #{display fakePoints} Punkte gab es für Aufgabenblätter, # - welche nicht gewertet wurden, sondern nur informativen Charakter besitzen - $maybe achievedFakes <- getSum <$> achievedPoints informationalSummary - , davon wurden #{display achievedFakes} erreicht - $if fakePoints /= 0 - \ #{textPercent $ realToFrac $ achievedFakes / fakePoints} - \. - - $maybe reqPasses <- positiveSum (numGradePasses normalSummary) -

- Aufgaben zum Bestehen: #{display reqPasses} - $maybe passed <- getSum <$> achievedPasses realGrades - \ davon #{display passed} bestanden - $maybe bonusPassed <- getSum <$> achievedPasses bonusSummary - \ (inklusive #{display bonusPassed} Bonusaufgaben) - \. - - $maybe noGradeSheets <- positiveSum numNotGraded -

- #{display noGradeSheets} unbewertete Aufgabenblätter. -