From b32654b7203a2802270e40a1c01a1c67ccc5b8b1 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 19 Dec 2018 09:26:12 +0100 Subject: [PATCH 1/8] Bugfix: Abgabengruppe nach Nachnamen sortieren --- src/Handler/Corrections.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 946ad1ae9..cf3860950 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -249,9 +249,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) ) ] From 47b2808dd4fc6faf468b08b5dfa3649d0dd6a452 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 19 Dec 2018 11:35:36 +0100 Subject: [PATCH 2/8] SheetGradeSummary Refactor Attempt1 --- messages/uniworx/de.msg | 2 +- src/Handler/Corrections.hs | 1 - src/Handler/Sheet.hs | 2 +- src/Model/Types.hs | 29 ++++++++++++++-------- templates/widgets/gradingSummary.hamlet | 4 +++ templates/widgets/gradingSummaryRow.hamlet | 2 +- 6 files changed, 26 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 78f999ee3..4326f365c 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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index cf3860950..0b1514618 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -252,7 +252,6 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d E.orderBy [E.asc $ user E.^. UserSurname] E.limit 1 return (user E.^. UserSurname) - ) ] , dbtFilter = Map.fromList diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 090fefcd5..447a8a006 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -201,7 +201,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/Model/Types.hs b/src/Model/Types.hs index 0e56bc058..48a1c742e 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 @@ -130,6 +130,8 @@ data SheetGrading | PassBinary -- non-zero means passed deriving (Eq, Read, Show, Generic) +makeLenses_ ''SheetGrading + deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel @@ -143,11 +145,15 @@ gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints gradingPassed (PassBinary {}) pts = Just $ pts /= 0 data SheetGradeSummary = SheetGradeSummary - { numSheets :: Sum Int - , numGradePasses :: Sum Int - , sumGradePoints :: Sum Points - , achievedPasses :: Maybe (Sum Int) - , achievedPoints :: Maybe (Sum Points) + { numSheets -- Total number of sheets, includes all + , numGradePasses -- Number of sheets required to pass + , numPointSheets -- Number of sheets having points + , numMarked :: Count -- Number of already marked sheets + , numMarkedPoints:: Count -- Number of already marked sheets + , numMarkedPasses:: Count -- Number of already marked sheets + , sumGradePoints :: Sum Points -- Total of achievable points + , achievedPasses :: Count -- + , achievedPoints :: Sum Points -- } deriving (Generic, Read, Show, Eq) instance Monoid SheetGradeSummary where @@ -160,15 +166,18 @@ instance Semigroup SheetGradeSummary where makeLenses_ ''SheetGradeSummary sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary -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 gr (Just p) = sheetGradeSum gr Nothing + { numMarked = 1 + , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p + , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr + } sheetGradeSum (Points {..}) Nothing = mempty { numSheets = Sum 1 + , numPointSheets = Sum 1 , sumGradePoints = Sum maxPoints } sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets = Sum 1 , numGradePasses = Sum 1 + , numPointSheets = Sum 1 , sumGradePoints = Sum maxPoints } sheetGradeSum (PassBinary) Nothing = mempty { numSheets = Sum 1 diff --git a/templates/widgets/gradingSummary.hamlet b/templates/widgets/gradingSummary.hamlet index a1c62237c..8221fc293 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -1,4 +1,8 @@ $# Displays gradings Summary for various purposes +$# Expects several variables: +$# hasPassing :: Maybe Int -- Should Passing be displayed? +$# hasPoints :: Maybe Points -- Should Points be displayed? +$# summary :: SheetGradeSummary -- summary to display $# --

_{title $ getSum $ numSheets $ sumSummaries} diff --git a/templates/widgets/gradingSummaryRow.hamlet b/templates/widgets/gradingSummaryRow.hamlet index 01e63efeb..7b37b3176 100644 --- a/templates/widgets/gradingSummaryRow.hamlet +++ b/templates/widgets/gradingSummaryRow.hamlet @@ -1,7 +1,7 @@ $# Displays one row of the grading summary $# Expects several variables: $# hasPassing :: Maybe Int -- Should Passing be displayed? -$# hasPoints :: Maybe Poibts -- Should Points be displayed? +$# hasPoints :: Maybe Points -- Should Points be displayed? $# summary :: SheetGradeSummary -- summary to display $# sumHeader :: UniWorXMessage -- row header $# From a507c0884fe99bfe80509f7f822880f64ac8df44 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 19 Dec 2018 12:42:00 +0100 Subject: [PATCH 3/8] intermediate --- src/Model/Types.hs | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 48a1c742e..fde3ced5c 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -144,16 +144,22 @@ gradingPassed (Points {}) _ = Nothing gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints gradingPassed (PassBinary {}) pts = Just $ pts /= 0 + +newtype SheetGradeSummary + data SheetGradeSummary = SheetGradeSummary - { numSheets -- Total number of sheets, includes all - , numGradePasses -- Number of sheets required to pass - , numPointSheets -- Number of sheets having points - , numMarked :: Count -- Number of already marked sheets - , numMarkedPoints:: Count -- Number of already marked sheets - , numMarkedPasses:: Count -- Number of already marked sheets - , sumGradePoints :: Sum Points -- Total of achievable points - , achievedPasses :: Count -- - , achievedPoints :: Sum Points -- + { numSheets :: Count -- Total number of sheets, includes all + , numSheetsPasses :: Count -- Number of sheets required to pass + , numSheetsPoints :: Count -- Number of sheets having points + , 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 Point -- 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 From 9ba09c999835ebc50830e97f7d9a2414e4003d5a Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 19 Dec 2018 13:52:26 +0100 Subject: [PATCH 4/8] Type SheetGradeSummery decided upon --- src/Model/Types.hs | 54 +++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index fde3ced5c..56743ac54 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -130,8 +130,6 @@ data SheetGrading | PassBinary -- non-zero means passed deriving (Eq, Read, Show, Generic) -makeLenses_ ''SheetGrading - deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel @@ -139,14 +137,22 @@ 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 -newtype SheetGradeSummary - data SheetGradeSummary = SheetGradeSummary { numSheets :: Count -- Total number of sheets, includes all , numSheetsPasses :: Count -- Number of sheets required to pass @@ -172,23 +178,23 @@ instance Semigroup SheetGradeSummary where makeLenses_ ''SheetGradeSummary sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary -sheetGradeSum gr (Just p) = sheetGradeSum gr Nothing - { numMarked = 1 - , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p - , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr - } -sheetGradeSum (Points {..}) Nothing = mempty { numSheets = Sum 1 - , numPointSheets = Sum 1 - , sumGradePoints = Sum maxPoints - } -sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets = Sum 1 - , numGradePasses = Sum 1 - , numPointSheets = Sum 1 - , sumGradePoints = Sum maxPoints - } -sheetGradeSum (PassBinary) Nothing = mempty { numSheets = Sum 1 - , numGradePasses = Sum 1 - } +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 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 } From 82aef8a254e4d28f9a7f706d77558b7fdfd9af7b Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 19 Dec 2018 15:48:38 +0100 Subject: [PATCH 5/8] refactor sheetGradeSummary part 2 --- src/Handler/Utils/SheetType.hs | 25 ++++++++++------------ src/Model/Types.hs | 20 ++++++++--------- src/Utils.hs | 2 +- templates/widgets/gradingSummary.hamlet | 10 +++++---- templates/widgets/gradingSummaryRow.hamlet | 9 ++++++-- 5 files changed, 35 insertions(+), 31 deletions(-) diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs index 150b7cd63..9b83f6270 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 + update _achievedPoints _sumSheetsPoints $ + update _achievedPasses _numSheetsPasses sts where - bonusPoints = sts ^. _bonusSummary . _achievedPoints - maxPoints = sts ^. _normalSummary . _sumGradePoints - maxBonusPts = fmap $ min maxPoints - addBonusPts = maybeAdd bonusPoints - - bonusPasses = sts ^. _bonusSummary . _achievedPasses - maxPasses = sts ^. _normalSummary . _numGradePasses - maxBonusPass = fmap $ min maxPasses - addBonusPass = maybeAdd bonusPasses + update lachieved lmax s = + let bonus = s ^. _bonusSummary . lachieved + valmax = s ^. _normalSummary . lmax + in s & _normalSummary . lachieved %~ min valmax . (bonus +) gradeSummaryWidget :: RenderMessage UniWorX msg => (Int -> 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) + hasPassings = 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/Types.hs b/src/Model/Types.hs index 56743ac54..1d7389038 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -154,18 +154,18 @@ gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound data SheetGradeSummary = SheetGradeSummary - { numSheets :: Count -- Total number of sheets, includes all - , numSheetsPasses :: Count -- Number of sheets required to pass - , numSheetsPoints :: Count -- Number of sheets having points - , sumSheetsPoints :: Sum Points -- Total of all points in all sheets + { 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 Point -- Achieveable points within marked sheets + , 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 Point -- Achieveable points within marked sheets -- - , achievedPasses :: Count -- Achieved passes (within marked sheets) - , achievedPoints :: Sum Points -- Achieved 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 diff --git a/src/Utils.hs b/src/Utils.hs index 4bc4c1c9f..f61ed6981 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 8221fc293..cb389d6a0 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -1,8 +1,10 @@ $# Displays gradings Summary for various purposes $# Expects several variables: -$# hasPassing :: Maybe Int -- Should Passing be displayed? -$# hasPoints :: Maybe Points -- Should Points be displayed? -$# summary :: SheetGradeSummary -- summary to display +$# sumSummaries :: SheetGradeSummary -- summary over all grading types +$# hasPassing :: 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} @@ -27,7 +29,7 @@ $# -- #{display nrNoGrade} $maybe _ <- positiveSum $ bonusSummary ^. _numSheets -

_{MsgSheetTypeInfoBonus} +

_{MsgSheetTypeInfoBonus} # $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints) _{MsgSheetGradingBonusIncluded} $maybe _ <- positiveSum $ informationalSummary ^. _numSheets diff --git a/templates/widgets/gradingSummaryRow.hamlet b/templates/widgets/gradingSummaryRow.hamlet index 7b37b3176..42dc8da26 100644 --- a/templates/widgets/gradingSummaryRow.hamlet +++ b/templates/widgets/gradingSummaryRow.hamlet @@ -1,9 +1,14 @@ $# Displays one row of the grading summary $# Expects several variables: -$# hasPassing :: Maybe Int -- Should Passing be displayed? -$# hasPoints :: Maybe Points -- Should Points be displayed? $# summary :: SheetGradeSummary -- summary to display $# sumHeader :: UniWorXMessage -- row header +$# hasPassing :: 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 +$# +$# TODO: Durschnittliche Punktzahl anzeigen +$# TODO: Extra-Spalte für Punkte Bewertet = numMarkedPoints / Punkte Gesamt = sumSheetPoints $# $maybe nrSheets <- positiveSum $ summary ^. _numSheets From 7d726f48c3400f75fe7a28c96f67a91ab3fc38c1 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 20 Dec 2018 19:18:29 +0100 Subject: [PATCH 6/8] gradingSummary Refactor finished --- templates/widgets/sheetTypeSummary.hamlet | 41 ----------------------- 1 file changed, 41 deletions(-) delete mode 100644 templates/widgets/sheetTypeSummary.hamlet 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. - From fb8d0c049fd27cc3442665edede850fa8b36f7a9 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 20 Dec 2018 19:18:48 +0100 Subject: [PATCH 7/8] Grading Summary Refactor finished --- messages/uniworx/de.msg | 5 ++- src/Handler/Utils/SheetType.hs | 16 +++---- src/Model.hs | 2 +- src/Model/Types.hs | 6 ++- templates/widgets/gradingSummary.hamlet | 26 +++++++---- templates/widgets/gradingSummaryRow.hamlet | 52 +++++++++++----------- 6 files changed, 60 insertions(+), 47 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4326f365c..4e5ddb679 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -407,8 +407,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} Blätter +SubmissionGradingSummaryTitle count@Integer: #{display count} Abgaben SheetTypeBonus': Bonus SheetTypeNormal': Normal diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs index 9b83f6270..43b98a92f 100644 --- a/src/Handler/Utils/SheetType.hs +++ b/src/Handler/Utils/SheetType.hs @@ -9,19 +9,19 @@ import Utils.Lens addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary addBonusToPoints sts = - update _achievedPoints _sumSheetsPoints $ - update _achievedPasses _numSheetsPasses sts + sts & _normalSummary . _achievedPasses %~ (min passmax . (passbonus +)) + & _normalSummary . _achievedPoints %~ (min ptsmax . (ptsbonus +)) where - update lachieved lmax s = - let bonus = s ^. _bonusSummary . lachieved - valmax = s ^. _normalSummary . lmax - in s & _normalSummary . lachieved %~ min valmax . (bonus +) + passmax = sts ^. _normalSummary . _numMarkedPasses + passbonus = sts ^. _bonusSummary . _achievedPasses + ptsmax = sts ^. _normalSummary . _sumMarkedPoints + ptsbonus = sts ^. _bonusSummary . _achievedPoints -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 $ numSheetsPasses sumSummaries + hasPasses = positiveSum $ numSheetsPasses sumSummaries hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries hasPoints = positiveSum $ numSheetsPoints sumSummaries hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries diff --git a/src/Model.hs b/src/Model.hs index 91de5c48c..9df99df4b 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -10,7 +10,7 @@ import ClassyPrelude.Yesod import Database.Persist.Quasi -- 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 1d7389038..ba3fca139 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -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 } @@ -162,7 +164,7 @@ data SheetGradeSummary = SheetGradeSummary , 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 Point -- Achieveable points within marked sheets + , sumMarkedPoints :: Sum Points -- Achieveable points within marked sheets -- , achievedPasses :: Count -- Achieved passes (within marked sheets) , achievedPoints :: Sum Points -- Achieved points (within marked sheets) @@ -214,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/templates/widgets/gradingSummary.hamlet b/templates/widgets/gradingSummary.hamlet index cb389d6a0..204f4fd28 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -1,21 +1,25 @@ $# Displays gradings Summary for various purposes $# Expects several variables: $# sumSummaries :: SheetGradeSummary -- summary over all grading types -$# hasPassing :: Maybe Int -- Should Passing be displayed? +$# 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} + $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 @@ -23,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) + $maybe _ <- positiveSum $ bonusSummary ^. _achievedPoints _{MsgSheetGradingBonusIncluded} $maybe _ <- positiveSum $ informationalSummary ^. _numSheets

_{MsgSheetTypeInfoNotGraded} diff --git a/templates/widgets/gradingSummaryRow.hamlet b/templates/widgets/gradingSummaryRow.hamlet index 42dc8da26..0b40eeba3 100644 --- a/templates/widgets/gradingSummaryRow.hamlet +++ b/templates/widgets/gradingSummaryRow.hamlet @@ -2,7 +2,7 @@ $# Displays one row of the grading summary $# Expects several variables: $# summary :: SheetGradeSummary -- summary to display $# sumHeader :: UniWorXMessage -- row header -$# hasPassing :: Maybe Int -- Should Passing be displayed? +$# 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 @@ -10,29 +10,31 @@ $# $# TODO: Durschnittliche Punktzahl anzeigen $# TODO: Extra-Spalte für Punkte Bewertet = numMarkedPoints / Punkte Gesamt = sumSheetPoints $# - $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 From dd3e321b7b7144514d6bd0fb9f39ccf19c124774 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 20 Dec 2018 19:27:09 +0100 Subject: [PATCH 8/8] Merge completed --- messages/uniworx/de.msg | 10 +++++----- src/Foundation.hs | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 602641b4e..f09698963 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -144,8 +144,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 @@ -415,8 +415,8 @@ SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die B 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. SummaryTitle: Zusammenfassung über alle -SheetGradingSummaryTitle count@Integer: #{display count} Blätter -SubmissionGradingSummaryTitle count@Integer: #{display count} Abgaben +SheetGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Blatt" "Blätter"} +SubmissionGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Abgabe" "Abgaben"} SheetTypeBonus': Bonus SheetTypeNormal': Normal @@ -586,6 +586,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 b63830a54..ceb1c7722 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