From d6ef0c1b651e89964c3839fbd5c1a590b30a9ca0 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 31 Oct 2018 17:07:19 +0100 Subject: [PATCH] Tooltips clarifying sheetTypes and sheetGrading at sheet creation --- messages/uniworx/de.msg | 2 ++ src/Handler/Sheet.hs | 3 ++- src/Handler/Utils/Form.hs | 3 ++- src/Model/Types.hs | 23 ++++++++++++++++++----- 4 files changed, 24 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7c03d6713..548904e49 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -356,6 +356,7 @@ SheetGrading: Bewertung SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten SheetGradingPassBinary: Bestanden/Nicht Bestanden +SheetGradingInfo: "Bestanden nach Punkten" zählt sowohl zur maximal erreichbaren Gesamtpunktzahl also auch zur Anzahl der zu bestehenden Blätter. SheetGradingPoints': Punkte SheetGradingPassPoints': Bestehen nach Punkten @@ -365,6 +366,7 @@ SheetTypeBonus grading@SheetGrading: Bonus SheetTypeNormal grading@SheetGrading: Normal SheetTypeInformational grading@SheetGrading: Keine Wertung SheetTypeNotGraded: Unbewertet +SheetTypeInfo: Bonus Blätter zählen, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. Blätter ohne Wertung werden nirgends nicht angerechnet, eine Punktangabe dient dort nur zur Rückmeldung an die Teilnehmer. SheetTypeBonus': Bonus SheetTypeNormal': Normal diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 0a25a30a6..9870665f2 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -102,7 +102,8 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm <$> areq ciField (fslI MsgSheetName) (sfName <$> template) <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) - <*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template) + <*> sheetTypeAFormReq (fslI MsgSheetType + & setTooltip MsgSheetTypeInfo) (sfType <$> template) <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) <*> aopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 9fc3a8daf..c30458e16 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -391,7 +391,8 @@ sheetTypeAFormReq fs template = multiActionA fs selOptions (classify' <$> templa , ( Informational', Informational <$> gradingReq ) , ( NotGraded', pure NotGraded ) ] - gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading) (template >>= preview _grading) + gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading + & setTooltip MsgSheetGradingInfo) (template >>= preview _grading) classify' :: SheetType -> SheetType' classify' = \case diff --git a/src/Model/Types.hs b/src/Model/Types.hs index acd08a9a6..5dabaed5b 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -132,6 +132,16 @@ gradingPassed (Points {}) _ = Nothing gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints gradingPassed (PassBinary {}) pts = Just $ pts /= 0 +-- just for SheetTypeSummary (no lenses available here?!) +getMaxPoints :: SheetGrading -> Points +getMaxPoints PassBinary = 0 +getMaxPoints other = maxPoints other + +getPassPoints :: SheetGrading -> Points +getPassPoints PassPoints {..} = passingPoints +getPassPoints _ = 0 + + data SheetType = Bonus { grading :: SheetGrading } @@ -152,6 +162,7 @@ data SheetTypeSummary = SheetTypeSummary { sumBonusPoints :: Sum Points , sumNormalPoints :: Sum Points , numPassSheets :: Sum Int + , numPassBonus :: Sum Int , numNotGraded :: Sum Int , achievedBonus :: Maybe (Sum Points) , achievedNormal :: Maybe (Sum Points) @@ -164,12 +175,14 @@ instance Monoid SheetTypeSummary where sheetTypeSum :: (SheetType, Maybe Points) -> SheetTypeSummary -sheetTypeSum = error "TODO sheetTypeSum" +-- sheetTypeSum (Bonus{..}, achieved) = mempty { sumBonusPoints = Sum $ fromMaybe 0 (grading ^? _maxPoints), achievedBonus = Sum <$> achieved } +sheetTypeSum = error "TODO" {- -sheetTypeSum (Bonus{..}, achieved) = mempty { sumBonusPoints = Sum maxPoints, achievedBonus = Sum <$> achieved } -sheetTypeSum (Normal{..}, achieved) = mempty { sumNormalPoints = Sum maxPoints, achievedNormal = Sum <$> achieved } -sheetTypeSum (Pass{..}, achieved) = mempty { numPassSheets = Sum 1, achievedPasses = Sum . bool 0 1 . (passingPoints <=) <$> achieved} -sheetTypeSum (NotGraded, _ ) = mempty { numNotGraded = Sum 1 } +sheetTypeSum (Bonus{..}, achieved) = mempty { sumBonusPoints = Sum $ getMaxPoints grading + , achievedBonus = Sum <$> achieved } +sheetTypeSum (Normal{..}, achieved) = mempty { sumNormalPoints = Sum $ getMaxPoints grading, achievedNormal = Sum <$> achieved } +sheetTypeSum (Informational{..}, achieved) = mempty { } +sheetTypeSum (NotGraded, _ ) = mempty { numNotGraded = Sum 1 } -} data SheetGroup