UniworxMessages allows combining messages

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

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

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

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)

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")

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")

templates/widgets/gradingSummary.hamlet

@@ -22,11 +22,14 @@ $# --
         $maybe _ <- hasPoints
           <td .table__td colspan=2>
         <td .table__td>#{display nrNoGrade}
+  $# TODO: for Steffen: show messages conditional upon table content
   $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
-    <p>_{MsgSheetTypeInfo}
+    <p>_{MsgSheetTypeInfoBonus}
+    <p>_{MsgSheetTypeInfoNotGraded}
     $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints)
       <p>_{MsgSheetGradingBonusIncluded}
   $nothing
     $#TODO: MsgSheetTypeInfo into part about Bonus and about Informational
     $maybe _ <- positiveSum $ informationalSummary ^. _numSheets
-      <p>_{MsgSheetTypeInfo}
+      <p>_{MsgSheetTypeInfoBonus}
+      <p>_{MsgSheetTypeInfoNotGraded}