Neue Statistik nun auch für Blattübersicht

messages/uniworx/de.msg

@@ -391,7 +391,8 @@ 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.
-SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den normalen Punkten hinzugezählt.
+SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt.
+SheetGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Abgaben/Blätter
 
 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal

src/Handler/Corrections.hs

@@ -102,6 +102,10 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
               shn   = sheetName $ entityVal sheet
           in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]
 
+colSheetType :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
+colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType)
+        $ \DBRow{ dbrOutput=(_, sheet, _, _, _) } -> i18nCell . sheetType $ entityVal sheet
+
 colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
   DBRow{ dbrOutput = (_, _, _, Nothing  , _) } -> cell mempty
@@ -383,23 +387,6 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
       let route  = CSubmissionR tid ssh csh shn cID SAssignR
       (== Authorized) <$> evalAccessDB route True
 
-gradeSummaryWidget ::  SheetTypeSummary -> Widget
-gradeSummaryWidget 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")
-
-
 type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData)
 
 downloadAction :: ActionCorrections'
@@ -448,6 +435,7 @@ postCorrectionsR = do
         , colAssigned
         , colRating
         , colRated
+        , colSheetType
         ] -- Continue here
       psValidator = def
         & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
@@ -468,6 +456,7 @@ postCCorrectionsR tid ssh csh = do
         , colSMatrikel
         , colSubmittors
         , colSubmissionLink
+        , colSheetType
         , colRating
         , colRated
         , colCorrector
@@ -782,6 +771,7 @@ postCorrectionsGradeR = do
         , colSheet
         , colPseudonyms
         , colSubmissionLink
+        , colSheetType
         , colRated
         , colRatedField
         , colPointsField

src/Handler/Sheet.hs

@@ -41,7 +41,7 @@ import qualified Data.Map as Map
 
 import Data.Map (Map, (!?))
 
-import Data.Monoid (Sum(..), Any(..))
+import Data.Monoid (Any(..))
 
 -- import Control.Lens
 import Utils.Lens
@@ -152,7 +152,8 @@ getSheetListR tid ssh csh = do
       E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
       return (sheet, lastSheetEdit sheet, submission)
     sheetCol = widgetColonnade . mconcat $
-      [ sortable (Just "name") (i18nCell MsgSheet)
+      [ -- TODO: dbRow add numbers
+        sortable (Just "name") (i18nCell MsgSheet)
           $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
       , sortable (Just "last-edit") (i18nCell MsgLastEdit)
           $ \(_, E.Value mEditTime, _) -> maybe mempty timeCell mEditTime
@@ -228,7 +229,7 @@ getSheetListR tid ssh csh = do
     , dbtIdent     = "sheets" :: Text
     }
   -- Collect summary over all Sheets, not just the ones shown due to pagination:
-  SheetTypeSummary{..} <- do
+  statistics <- gradeSummaryWidget <$> do
     rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
       E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
       E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
@@ -236,7 +237,6 @@ getSheetListR tid ssh csh = do
       E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
       return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
     return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
-  let statistics = $(widgetFile "widgets/sheetTypeSummary")
   defaultLayout $ do
     $(widgetFile "sheetList")
 

src/Handler/Utils/Rating.hs

@@ -12,6 +12,7 @@ module Handler.Utils.Rating
   , parseRating
   , SubmissionContent
   , extractRatings
+  , gradeSummaryWidget
   ) where
 
 import Import
@@ -32,6 +33,8 @@ 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
@@ -199,3 +202,35 @@ 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 ::  SheetTypeSummary -> Widget
+gradeSummaryWidget 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/Table/Pagination.hs

@@ -571,6 +571,7 @@ formCell genIndex genForm input = FormCell
 
 -- Predefined colonnades
 
+--Number column?
 dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
 dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
 

src/Model/Rating.hs

@@ -2,8 +2,6 @@ module Model.Rating where
 
 import ClassyPrelude.Yesod
 import Model
-import Utils
-import Control.Lens
 -- import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException(..))
 import GHC.Generics (Generic)
@@ -36,19 +34,3 @@ data RatingException = RatingNotUnicode UnicodeException -- ^ Rating failed to p
   deriving (Show, Eq, Generic, Typeable)
 
 instance Exception RatingException
-
--- 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

templates/widgets/gradingSummary.hamlet

@@ -1,6 +1,7 @@
 $# Displays gradings Summary for various purposes
 $# --
 <div>
+  <h3>_{MsgSheetGradingSummaryTitle $ getSum $ numSheets $ sumSummaries}
   <table .table .table--striped>
     <tr .table__row .table__row--head>
       <th>
@@ -23,7 +24,9 @@ $# --
         <td .table__td>#{display nrNoGrade}
   $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
     <p>_{MsgSheetTypeInfo}
-    <p>_{MsgSheetGradingBonusIncluded}
+    $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints)
+      <p>_{MsgSheetGradingBonusIncluded}
   $nothing
+    $#TODO: MsgSheetTypeInfo into part about Bonus and about Informational
     $maybe _ <- positiveSum $ informationalSummary ^. _numSheets
       <p>_{MsgSheetTypeInfo}