diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 315d0e3de..8b15af8b0 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -390,7 +390,8 @@ SheetTypeBonus grading@SheetGrading: Bonus SheetTypeNormal grading@SheetGrading: Normal SheetTypeInformational grading@SheetGrading: Keine Wertung SheetTypeNotGraded: Unbewertet -SheetTypeInfo: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information an die Teilnehmer. +SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. +SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information an die Teilnehmer. 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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 2dec96886..b80b2630c 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -228,7 +228,11 @@ newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX] deriving newtype (Semigroup, Monoid, IsList) instance RenderMessage UniWorX UniWorXMessages where - renderMessage foundation ls (UniWorXMessages msgs) = foldMap (renderMessage foundation ls) msgs + renderMessage foundation ls (UniWorXMessages msgs) = + intercalate " " $ map (renderMessage foundation ls) msgs + +uniworxMessages :: [UniWorXMessage] -> UniWorXMessages +uniworxMessages = UniWorXMessages . map SomeMessage -- Menus and Favourites data MenuType = NavbarAside | NavbarRight | NavbarSecondary | PageActionPrime | PageActionSecondary diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 649bb4078..0ebeef68e 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -7,6 +7,7 @@ import Jobs import Handler.Utils import Handler.Utils.Submission import Handler.Utils.Table.Cells +import Handler.Utils.SheetType -- import Handler.Utils.Zip import Utils.Lens diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index c88371762..6728e11a2 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -6,6 +6,7 @@ import System.FilePath (takeFileName) import Handler.Utils -- import Handler.Utils.Zip import Handler.Utils.Table.Cells +import Handler.Utils.SheetType -- import Data.Time -- import qualified Data.Text as T @@ -97,7 +98,8 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do <$> areq ciField (fslI MsgSheetName) (sfName <$> template) <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) <*> sheetTypeAFormReq (fslI MsgSheetType - & setTooltip MsgSheetTypeInfo) (sfType <$> template) + & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded])) + (sfType <$> template) <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) <*> aopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 11cb411e8..8c8b4f273 100644 --- a/src/Handler/Utils/Rating.hs +++ b/src/Handler/Utils/Rating.hs @@ -12,7 +12,6 @@ module Handler.Utils.Rating , parseRating , SubmissionContent , extractRatings - , gradeSummaryWidget ) where import Import @@ -33,8 +32,6 @@ import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as Lazy.ByteString -import Data.Monoid (Sum(..)) - import Text.Read (readEither) import System.FilePath @@ -202,35 +199,3 @@ isRatingFile' (takeFileName -> fName) = Just cID | otherwise = Nothing - --- TODO: maybe move elsewhere, but Model is a bit overful already -addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary -addBonusToPoints sts = - sts & _normalSummary . _achievedPoints %~ maxBonusPts . addBonusPts - & _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass - 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 - -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 - rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") - | (sumHeader,summary) <- - [ (MsgSheetTypeNormal' ,normalSummary) - , (MsgSheetTypeBonus' ,bonusSummary) - , (MsgSheetTypeInformational' ,informationalSummary) - ] ] - in if 0 == numSheets sumSummaries - then mempty - else $(widgetFile "widgets/gradingSummary") diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs new file mode 100644 index 000000000..69885e759 --- /dev/null +++ b/src/Handler/Utils/SheetType.hs @@ -0,0 +1,39 @@ +module Handler.Utils.SheetType + ( + gradeSummaryWidget + ) where + +import Import +import Data.Monoid (Sum(..)) +import Utils.Lens hiding ((<.>)) + +addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary +addBonusToPoints sts = + sts & _normalSummary . _achievedPoints %~ maxBonusPts . addBonusPts + & _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass + 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 + +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 + rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") + | (sumHeader,summary) <- + [ (MsgSheetTypeNormal' ,normalSummary) + , (MsgSheetTypeBonus' ,bonusSummary) + , (MsgSheetTypeInformational' ,informationalSummary) + ] ] + in if 0 == numSheets sumSummaries + then mempty + else $(widgetFile "widgets/gradingSummary") diff --git a/templates/widgets/gradingSummary.hamlet b/templates/widgets/gradingSummary.hamlet index e728bcfbd..f72c1edd9 100644 --- a/templates/widgets/gradingSummary.hamlet +++ b/templates/widgets/gradingSummary.hamlet @@ -22,11 +22,14 @@ $# -- $maybe _ <- hasPoints #{display nrNoGrade} + $# TODO: for Steffen: show messages conditional upon table content $maybe _ <- positiveSum $ bonusSummary ^. _numSheets -

_{MsgSheetTypeInfo} +

_{MsgSheetTypeInfoBonus} +

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

_{MsgSheetGradingBonusIncluded} $nothing $#TODO: MsgSheetTypeInfo into part about Bonus and about Informational $maybe _ <- positiveSum $ informationalSummary ^. _numSheets -

_{MsgSheetTypeInfo} \ No newline at end of file +

_{MsgSheetTypeInfoBonus} +

_{MsgSheetTypeInfoNotGraded} \ No newline at end of file