Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

.vscode/tasks.json

@@ -1,4 +1,4 @@
-{  
+{
   "version": "2.0.0",
   "tasks": [
     {
@@ -11,7 +11,7 @@
       },
       "presentation": {
         "echo": true,
-        "reveal": "silent",
+        "reveal": "always",
         "focus": false,
         "panel": "dedicated",
         "showReuseMessage": false

messages/uniworx/de.msg

@@ -380,7 +380,9 @@ SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tsh
 SheetGradingPassBinary:  Bestanden/Nicht Bestanden
 SheetGradingInfo: "Bestanden nach Punkten" zählt sowohl zur maximal erreichbaren Gesamtpunktzahl also auch zur Anzahl der zu bestehenden Blätter.
 
+SheetGradingCount': Anzahl
 SheetGradingPoints': Punkte
+SheetGradingPassing': Bestehen
 SheetGradingPassPoints': Bestehen nach Punkten
 SheetGradingPassBinary': Bestanden/Nicht bestanden
 
@@ -388,7 +390,11 @@ 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 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
 
 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal

src/Foundation.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- MonadCrypto
 
 module Foundation where
@@ -144,7 +145,7 @@ pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Cr
 pattern CSubmissionR tid ssh csh shn cid ptn
   = CSheetR tid ssh csh shn (SubmissionR cid ptn)
 
--- Messages
+-- Messages creates type UniWorXMessage and RenderMessage UniWorX instance
 mkMessage "UniWorX" "messages/uniworx" "de"
 mkMessageVariant "UniWorX" "Campus" "messages/campus" "de"
 mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de"
@@ -224,6 +225,16 @@ instance RenderMessage UniWorX SheetType where
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
 
+newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
+  deriving (Generic, Typeable)
+  deriving newtype (Semigroup, Monoid, IsList)
+
+instance RenderMessage UniWorX UniWorXMessages where
+  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
@@ -56,25 +57,33 @@ import Data.Foldable (foldrM)
 
 
 
-type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
+type CorrectionTableExpr  = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
-            (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
+type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
-            -> expr (E.Value Bool)
-
-ratedBy :: Key User -> CorrectionsWhere
-ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
-
-courseIs :: Key Course -> CorrectionsWhere
-courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
-
-sheetIs :: Key Sheet -> CorrectionsWhere
-sheetIs shid (_course,sheet,_submission) = sheet E.^. SheetId E.==. E.val shid
-
-submissionModeIs :: SheetSubmissionMode -> CorrectionsWhere
-submissionModeIs sMode (_course, sheet, _submission) = sheet E.^. SheetSubmissionMode E.==. E.val sMode
-
-
 type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym))
 
+correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
+correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
+    E.on $ corrector E.?. UserId   E.==. submission E.^. SubmissionRatingBy
+    E.on $ sheet     E.^. SheetId  E.==. submission E.^. SubmissionSheet
+    E.on $ course    E.^. CourseId E.==. sheet      E.^. SheetCourse
+    E.where_ $ whereClause t
+    return $ returnStatement t
+
+-- Where Clauses
+ratedBy :: UserId -> CorrectionTableWhere
+ratedBy uid   ((_course `E.InnerJoin` _sheet `E.InnerJoin`  submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
+
+courseIs :: CourseId -> CorrectionTableWhere
+courseIs cid  (( course `E.InnerJoin` _sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = course E.^. CourseId E.==. E.val cid
+
+sheetIs :: Key Sheet -> CorrectionTableWhere
+sheetIs shid  ((_course `E.InnerJoin`  sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetId E.==. E.val shid
+
+submissionModeIs :: SheetSubmissionMode -> CorrectionTableWhere
+submissionModeIs sMode ((_course `E.InnerJoin` sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetSubmissionMode E.==. E.val sMode
+
+
+-- Columns
 colTerm :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgTerm)
         $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
@@ -94,6 +103,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
@@ -116,7 +129,7 @@ colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult
 colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
 
 colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
-colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
   csh = course ^. _2
   tid = course ^. _3
   ssh = course ^. _4
@@ -138,6 +151,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $  \DBRow{ dbrOutput=(
       tid = course ^. _3
       ssh = course ^. _4
       -- shn = sheetName
+
       mkRoute = do
         cid <- encrypt subId
         return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
@@ -176,23 +190,19 @@ colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell
   (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment))
 
 
-type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
-
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => _ -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DB (DBResult m x)
+                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DB (DBResult m x)
 makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
   let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
-      dbtSQLQuery ((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
+      dbtSQLQuery = correctionsTableQuery whereClause
-        E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
+          (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) ->
-        E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
+            let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value CourseName)
-        E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
+                        , course E.^. CourseShorthand
-        E.where_ $ whereClause (course,sheet,submission)
+                        , course E.^. CourseTerm
-        let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value CourseName)
+                        , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
-                    , course E.^. CourseShorthand
+                        )
-                    , course E.^. CourseTerm
+            in (submission, sheet, crse, corrector)
-                    , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
+          )
-                    )
-        return (submission, sheet, crse, corrector)
       dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData
       dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do
         submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
@@ -200,7 +210,7 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
           E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
           E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
-          E.orderBy [E.asc $ user E.^. UserId]
+          E.orderBy [E.asc $ user E.^. UserDisplayName]
           return (user, pseudonym E.?. SheetPseudonymPseudonym)
         let
           submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
@@ -231,6 +241,16 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
       , ( "assignedtime"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
         )
+      , ( "submittors"
+        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
+            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.limit 1
+              return (user E.^. UserDisplayName)
+
+        )
       ]
     , dbtFilter    = Map.fromList
       [ ( "term"
@@ -356,9 +376,16 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
             addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
       redirect currentRoute
 
+  gradingSummary <- runDB $ do
+      let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
+      points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
+      -- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
+      return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
+  let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
   fmap toTypedContent . defaultLayout $ do
     setTitleI MsgCourseCorrectionsTitle
     $(widgetFile "corrections")
+
   where
     authorizedToAssign :: SubmissionId -> DB Bool
     authorizedToAssign sId = do
@@ -642,7 +669,7 @@ postCorrectionsCreateR = do
     FormFailure errs -> forM_ errs $ addMessage Error . toHtml
     FormSuccess (sid, (pss, invalids)) -> do
       forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Warning "templates/messages/ignoredInvalidPseudonym.hamlet")
-      
+
       runDB $ do
         Sheet{..} <- get404 sid
         (sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)

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
@@ -41,7 +42,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
@@ -62,7 +63,7 @@ data SheetForm = SheetForm
       { sfName         :: SheetName
       , sfDescription  :: Maybe Html
       , sfType         :: SheetType
-      , sfGrouping     :: SheetGroup      
+      , sfGrouping     :: SheetGroup
       , sfVisibleFrom  :: Maybe UTCTime
       , sfActiveFrom   :: UTCTime
       , sfActiveTo     :: UTCTime
@@ -97,8 +98,9 @@ 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]))
-      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)      
+                                                          (sfType        <$> template)
+      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
       <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
             & setTooltip MsgSheetVisibleFromTip)
                                                               ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
@@ -118,7 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
       <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarking
             & setTooltip MsgSheetMarkingTip)   (sfMarkingF <$> template)
-      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> template)            
+      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> template)
       <*  submitButton
     return $ case result of
       FormSuccess sheetResult
@@ -137,7 +139,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
       ] ]
 
 getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-getSheetListR tid ssh csh = do 
+getSheetListR tid ssh csh = do
   muid <- maybeAuthId
   Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
   let
@@ -152,18 +154,19 @@ 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)
+      [ dbRow
-          $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
+      , sortable (Just "name") (i18nCell MsgSheet)
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
       , sortable (Just "last-edit") (i18nCell MsgLastEdit)
-          $ \(_, E.Value mEditTime, _) -> maybe mempty timeCell mEditTime
+          $ \DBRow{dbrOutput=(_, E.Value mEditTime, _)} -> maybe mempty timeCell mEditTime
       , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveFrom
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveFrom
       , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveTo
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveTo
       , sortable Nothing (i18nCell MsgSheetType)
-          $ \(Entity _ Sheet{..}, _, _) -> i18nCell sheetType
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> i18nCell sheetType
       , sortable Nothing (i18nCell MsgSubmission)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
               Nothing -> mempty
               (Just (Entity sid Submission{..})) ->
                 let mkCid = encrypt sid -- TODO: executed twice
@@ -172,7 +175,7 @@ getSheetListR tid ssh csh = do
                       return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                 in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{display cid2}|])
       , sortable (Just "rating") (i18nCell MsgRating)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
               Nothing -> mempty
               (Just (Entity sid Submission{..})) ->
                 let mkCid = encrypt sid
@@ -180,15 +183,15 @@ getSheetListR tid ssh csh = do
                       cid' <- mkCid
                       return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                 in anchorCellM mkRoute $(widgetFile "widgets/rating")
-      , sortable Nothing -- (Just "percent") 
+      , sortable Nothing -- (Just "percent")
                         (i18nCell MsgRatingPercent)
-          $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType}, _, mbSub)} -> case mbSub of
               (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
                     | maxPoints /= 0 ->
                         let percent = sPoints / maxPoints
-                        in textCell $ textPercent $ realToFrac percent    
+                        in textCell $ textPercent $ realToFrac percent
                   _other -> mempty
               _other -> mempty
       ]
@@ -197,8 +200,8 @@ getSheetListR tid ssh csh = do
   table <- runDB $ dbTableWidget' psValidator DBTable
     { dbtSQLQuery  = sheetData
     , dbtColonnade = sheetCol
-    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
+    , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) }
-                   -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
+                   -> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
     , dbtSorting   = Map.fromList
       [ ( "name"
         , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
@@ -228,7 +231,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 MsgSheetGradingSummaryTitle <$> 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
@@ -238,7 +241,6 @@ getSheetListR tid ssh csh = do
     return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
   defaultLayout $ do
     $(widgetFile "sheetList")
-    $(widgetFile "widgets/sheetTypeSummary")
 
 data ButtonGeneratePseudonym = BtnGenerate
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
@@ -398,7 +400,7 @@ getSheetNewR tid ssh csh = do
           { sfName         = stepTextCounterCI sheetName
           , sfDescription  = sheetDescription
           , sfType         = sheetType
-          , sfGrouping     = sheetGrouping          
+          , sfGrouping     = sheetGrouping
           , sfVisibleFrom  = addOneWeek <$> sheetVisibleFrom
           , sfActiveFrom   = addOneWeek     sheetActiveFrom
           , sfActiveTo     = addOneWeek     sheetActiveTo
@@ -431,7 +433,7 @@ getSEditR tid ssh csh shn = do
         { sfName         = sheetName
         , sfDescription  = sheetDescription
         , sfType         = sheetType
-        , sfGrouping     = sheetGrouping        
+        , sfGrouping     = sheetGrouping
         , sfVisibleFrom  = sheetVisibleFrom
         , sfActiveFrom   = sheetActiveFrom
         , sfActiveTo     = sheetActiveTo

src/Handler/Utils/Form.hs

@@ -263,7 +263,7 @@ multiFileField permittedFiles' = Field{..}
       pVals <- lift permittedFiles'
       let
         decrypt' :: CryptoUUIDFile -> Handler (Maybe FileId)
-        decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt 
+        decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt
       yieldMany vals
         .| C.filter (/= unpackZips)
         .| C.map fromPathPiece .| C.catMaybes
@@ -288,7 +288,7 @@ multiFileField permittedFiles' = Field{..}
           let fuiChecked
                 | Right sentVals' <- sentVals = fuiId' `elem` sentVals'
                 | otherwise = True
-          return FileUploadInfo{..}     
+          return FileUploadInfo{..}
       fileInfos <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do
           E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals)
           E.orderBy [E.asc $ file E.^. FileTitle]
@@ -303,13 +303,13 @@ multiFileField permittedFiles' = Field{..}
 
 
 data SheetGrading' = Points' | PassPoints' | PassBinary'
-  deriving (Eq, Ord, Read, Show, Enum, Bounded)      
+  deriving (Eq, Ord, Read, Show, Enum, Bounded)
 
 instance Universe SheetGrading'
 instance Finite SheetGrading'
 
 nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'")
-embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)  
+embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)
 
 
 data SheetType' = Bonus' | Normal' | Informational' | NotGraded'
@@ -319,7 +319,7 @@ instance Universe SheetType'
 instance Finite SheetType'
 
 nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'")
-embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)  
+embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)
 
 
 data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups'
@@ -333,31 +333,31 @@ embedRenderMessage ''UniWorX ''SheetGroup' (("SheetGroup" <>) . dropSuffix "'")
 
 sheetGradingAFormReq :: FieldSettings UniWorX -> Maybe SheetGrading -> AForm Handler SheetGrading
 sheetGradingAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
-  where 
+  where
-    selOptions = Map.fromList 
+    selOptions = Map.fromList
-      [ ( Points', Points <$> maxPointsReq )
+      [ ( Points',     Points     <$> maxPointsReq )
       , ( PassPoints', PassPoints <$> maxPointsReq <*> passPointsReq )
       , ( PassBinary', pure PassBinary)
       ]
-    classify' :: SheetGrading -> SheetGrading' 
+    classify' :: SheetGrading -> SheetGrading'
-    classify' = \case 
+    classify' = \case
-      Points {} -> Points'
+      Points     {} -> Points'
       PassPoints {} -> PassPoints'
       PassBinary {} -> PassBinary'
-    
+
-    maxPointsReq  = apreq pointsField (fslI MsgSheetGradingMaxPoints) (template >>= preview _maxPoints)
+    maxPointsReq  = apreq pointsField (fslI MsgSheetGradingMaxPoints)     (template >>= preview _maxPoints)
     passPointsReq = apreq pointsField (fslI MsgSheetGradingPassingPoints) (template >>= preview _passingPoints)
 
 
 sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType
 sheetTypeAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
-  where 
+  where
     selOptions = Map.fromList
       [ ( Bonus' , Bonus  <$> gradingReq )
       , ( Normal', Normal <$> gradingReq )
       , ( Informational', Informational <$> gradingReq  )
       , ( NotGraded', pure NotGraded )
-      ]    
+      ]
     gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading
         & setTooltip MsgSheetGradingInfo) (template >>= preview _grading)
 
@@ -440,8 +440,8 @@ utcTimeField = Field
     fieldTimeFormat :: String
     --fieldTimeFormat = "%e.%m.%y %k:%M"
     fieldTimeFormat = "%Y-%m-%dT%H:%M"
-    
+
-    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any 
+    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
     readTime :: Text -> Either UniWorXMessage UTCTime
     readTime t =
       case localTimeToUTC <$> parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of
@@ -595,7 +595,7 @@ formResultModal res finalDest handler = maybeT_ $ do
     FormMissing -> mzero
     FormFailure errs -> mapM_ (addMessage Error . toHtml) errs >> mzero
     FormSuccess val -> lift . execWriterT $ handler val
-  
+
   isModal <- hasCustomHeader HeaderIsModal
   if
     | isModal   -> sendResponse $ toJSON messages

src/Handler/Utils/Rating.hs

@@ -51,7 +51,7 @@ instance Pretty x => Pretty (CI x) where
   pretty = pretty . CI.original
 
 
-instance Pretty SheetGrading where   
+instance Pretty SheetGrading where
   pretty Points{..}     = pretty ( show maxPoints <> " Punkte" :: String)
   pretty PassPoints{..} = pretty ( show maxPoints <> " Punkte, bestanden ab " <> show passingPoints <> " Punkte" :: String )
   pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
@@ -59,12 +59,12 @@ instance Pretty SheetGrading where
 
 validateRating :: SheetType -> Rating' -> [RatingException]
 validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..}
-  | rp < 0 
+  | rp < 0
-    = [RatingNegative] 
+    = [RatingNegative]
-  | NotGraded <- ratingSheetType 
+  | NotGraded <- ratingSheetType
     = [RatingNotExpected]
   | (Just maxPoints ) <- ratingSheetType ^?  _grading . _maxPoints
-  , rp > maxPoints 
+  , rp > maxPoints
     = [RatingExceedsMax]
   | (Just PassBinary) <- ratingSheetType ^? _grading
   , not (rp == 0 || rp == 1)
@@ -98,7 +98,7 @@ getRating submissionId = runMaybeT $ do
     , E.unValue -> ratingComment
     , E.unValue -> ratingTime
     ) ] <- lift query
-  
+
   return Rating{ ratingValues = Rating'{..}, .. }
 
 formatRating :: CryptoFileNameSubmission -> Rating -> Lazy.ByteString

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

src/Handler/Utils/Table/Pagination.hs

@@ -183,7 +183,7 @@ instance Default (PSValidator m x) where
     Just pi -> swap . (\act -> execRWS act pi def) $ do
       asks piSorting >>= maybe (return ()) (\s -> modify $ \ps -> ps { psSorting = s })
       asks piFilter >>= maybe (return ()) (\f -> modify $ \ps -> ps { psFilter = f })
-      
+
       l <- asks piLimit
       case l of
         Just l'
@@ -258,7 +258,7 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
 
   data DBCell m x :: *
   dbCell :: Iso' (DBCell m x) ([(Text, Text)], WriterT x m Widget)
-    
+
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
   -- | Format @DBTable@ when sort-circuiting
   dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> DBResult m x -> m' Widget
@@ -284,7 +284,7 @@ instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where
   dbCell = iso
     (\WidgetCell{..} -> (wgtCellAttrs, wgtCellContents))
     (uncurry WidgetCell)
-  
+
   -- dbWidget Proxy Proxy = iso (, ()) $ view _1
   dbWidget _ _ = return . snd
   dbHandler _ _ f = return . over _2 f
@@ -331,7 +331,7 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
   dbCell = iso
     (\FormCell{..} -> (formCellAttrs, WriterT $ fmap swap formCellContents))
     (\(attrs, mkWidget) -> FormCell attrs . fmap swap $ runWriterT mkWidget)
-  
+
   -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
   --                            ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
   dbWidget dbtable pi = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . addPIHiddenField dbtable pi
@@ -353,10 +353,10 @@ addPIHiddenField DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } pi form fragmen
 instance Monoid a => Monoid (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a)) where
   mempty = FormCell mempty (return mempty)
   (FormCell a c) `mappend` (FormCell a' c') = FormCell (mappend a a') (mappend <$> c <*> c')
-  
+
 instance IsDBTable m a => IsString (DBCell m a) where
   fromString = cell . fromString
-      
+
 
 dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
@@ -378,7 +378,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , fieldView = error "multiTextField: should not be rendered"
       , fieldEnctype = UrlEncoded
       }
-    
+
   piResult <- lift . runInputGetResult $ PaginationInput
     <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
     <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
@@ -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/Import/NoFoundation.hs

@@ -35,10 +35,12 @@ import Mail                   as Import
 import Data.Data              as Import (Data)
 import Data.Typeable          as Import (Typeable)
 import GHC.Generics           as Import (Generic)
+import GHC.Exts               as Import (IsList)
 
 import Data.Hashable          as Import
 import Data.List.NonEmpty     as Import (NonEmpty(..))
 import Data.Text.Encoding.Error    as Import(UnicodeException(..))
+import Data.Semigroup         as Import (Semigroup)
 
 import Control.Monad.Morph    as Import (MFunctor(..))
 

src/Model/Rating.hs

@@ -2,7 +2,6 @@ module Model.Rating where
 
 import ClassyPrelude.Yesod
 import Model
-
 -- import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException(..))
 import GHC.Generics (Generic)

src/Model/Types.hs

@@ -135,10 +135,11 @@ gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints
 gradingPassed (PassBinary {}) pts = Just $ pts /= 0
 
 data SheetGradeSummary = SheetGradeSummary
-  { sumGradePoints :: Sum Points
+  { numSheets      :: Sum Int
   , numGradePasses :: Sum Int
-  , achievedPoints :: Maybe (Sum Points)
+  , sumGradePoints :: Sum Points
   , achievedPasses :: Maybe (Sum Int)
+  , achievedPoints :: Maybe (Sum Points)
   } deriving (Generic, Read, Show, Eq)
 
 instance Monoid SheetGradeSummary where
@@ -146,18 +147,25 @@ instance Monoid SheetGradeSummary where
   mappend = mappenddefault
 
 instance Semigroup SheetGradeSummary where
-  (<>) = mappend -- remove for GHC > 8.4.x
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+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 (Points {..})    Nothing = mempty { sumGradePoints = Sum maxPoints }
+sheetGradeSum (Points {..})    Nothing = mempty { numSheets      = Sum 1
-sheetGradeSum (PassPoints{..}) Nothing = mempty { sumGradePoints = Sum maxPoints
+                                                , sumGradePoints = Sum maxPoints
-                                                , numGradePasses = Sum 1 }
+                                                }
-sheetGradeSum (PassBinary)     Nothing = mempty { numGradePasses = Sum 1 }
+sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets      = Sum 1
-
+                                                , numGradePasses = Sum 1
+                                                , sumGradePoints = Sum maxPoints
+                                                }
+sheetGradeSum (PassBinary)     Nothing = mempty { numSheets      = Sum 1
+                                                , numGradePasses = Sum 1
+                                                }
 
 data SheetType
   = Normal        { grading :: SheetGrading }
@@ -174,19 +182,26 @@ deriveJSON defaultOptions
 derivePersistFieldJSON ''SheetType
 
 data SheetTypeSummary = SheetTypeSummary
-  { normalSummary, bonusSummary, informationalSummary :: SheetGradeSummary
+  { normalSummary
-  , numNotGraded  :: Sum Int
+  , bonusSummary
+  , informationalSummary :: SheetGradeSummary
+  , numNotGraded :: Sum Int
   } deriving (Generic, Read, Show, Eq)
 
 instance Monoid SheetTypeSummary where
   mempty  = memptydefault
   mappend = mappenddefault
 
+instance Semigroup SheetTypeSummary where
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+makeLenses_ ''SheetTypeSummary
+
 sheetTypeSum :: SheetType -> Maybe Points -> SheetTypeSummary
 sheetTypeSum Bonus{..}         mps = mempty { bonusSummary         = sheetGradeSum grading mps }
 sheetTypeSum Normal{..}        mps = mempty { normalSummary        = sheetGradeSum grading mps }
 sheetTypeSum Informational{..} mps = mempty { informationalSummary = sheetGradeSum grading mps }
-sheetTypeSum NotGraded _           = mempty { numNotGraded = Sum 1 }
+sheetTypeSum NotGraded _           = mempty { numNotGraded         = Sum 1 }
 
 data SheetGroup
   = Arbitrary { maxParticipants :: Natural }

src/Utils.hs

@@ -213,6 +213,9 @@ textPercent x = lz <> pack (show rx) <> "%"
    rx = fromIntegral (round' $ 1000.0*x) / 10.0
    lz = if rx < 10.0 then "0" else ""
 
+textPercentInt :: Integral a => a -> a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
+textPercentInt part whole = textPercent $ (fromIntegral part) / (fromIntegral whole)
+
 stepTextCounterCI :: CI Text -> CI Text -- find and increment rightmost-number, preserving leading zeroes
 stepTextCounterCI = CI.map stepTextCounter
 
@@ -317,14 +320,13 @@ toNothing = const Nothing
 toNothingS :: String -> Maybe b
 toNothingS = const Nothing
 
-maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
+maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap/ap
 maybeAdd (Just x) (Just y) = Just (x + y)
 maybeAdd Nothing y  = y
 maybeAdd x Nothing  = x
 
 maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m
-maybeEmpty (Just x) f = f x
+maybeEmpty = flip foldMap
-maybeEmpty Nothing  _ = mempty
 
 whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
@@ -339,7 +341,7 @@ maybePositive a | a > 0     = Just a
                 | otherwise = Nothing
 
 positiveSum :: (Num a, Ord a) => Sum a -> Maybe a -- like maybePositive
-positiveSum (Sum x) = maybePositive x
+positiveSum = maybePositive . getSum
 
 maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
 maybeM dft act mb = mb >>= maybe dft act
@@ -369,7 +371,6 @@ instance Ord a => Ord (NTop (Maybe a)) where
   compare (NTop (Just x)) (NTop (Just y)) = compare x y
 
 
-
 ------------
 -- Either --
 ------------

templates/corrections.hamlet

@@ -1,5 +1,7 @@
-<div .container>
+<section>
   <form method=POST enctype=#{tableEncoding} action=@{currentRoute}>
     ^{table}
     <button type=submit>
       _{MsgBtnSubmit}
+<section>
+  ^{statistics}

templates/sheetList.hamlet

@@ -1 +1,4 @@
-^{table}
+<section>
+  ^{table}
+<section>
+  ^{statistics}

templates/standalone/alerts.julius

@@ -29,7 +29,7 @@
       var iconEl = document.createElement('DIV');
       var closeEl = document.createElement('DIV');
       var dataDecay = alertEl.dataset.decay;
-      var autoDecay = 30;
+      var autoDecay = 10;
       if (dataDecay) {
         autoDecay = parseInt(dataDecay, 10);
       }

templates/widgets/gradingSummary.hamlet

@@ -0,0 +1,30 @@
+$# Displays gradings Summary for various purposes
+$# --
+<div>
+  <h3>_{title $ getSum $ numSheets $ sumSummaries}
+  <table .table .table--striped>
+    <tr .table__row .table__row--head>
+      <th>
+      $# empty cell for row headers
+      $maybe _ <- hasPassings
+        <th .table__th colspan=2>_{MsgSheetGradingPassing'}
+      $maybe _ <- hasPoints
+        <th .table__th colspan=2>_{MsgSheetGradingPoints'}
+      <th .table__th>_{MsgSheetGradingCount'}
+        $# Number of Sheet/Submissions used for calculating maximum passes/points
+    $forall row <- rowWdgts
+      ^{row}
+    $maybe nrNoGrade <- positiveSum $ numNotGraded
+      <tr .table__row>
+        <th .table__th>_{MsgSheetTypeNotGraded}
+        $maybe _ <- hasPassings
+          <td colspan=2>
+        $maybe _ <- hasPoints
+          <td .table__td colspan=2>
+        <td .table__td>#{display nrNoGrade}
+  $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
+    <p>_{MsgSheetTypeInfoBonus}
+      $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints)
+        _{MsgSheetGradingBonusIncluded}
+  $maybe _ <- positiveSum $ informationalSummary ^. _numSheets
+    <p>_{MsgSheetTypeInfoNotGraded}

templates/widgets/gradingSummaryRow.hamlet

@@ -0,0 +1,33 @@
+$# Displays one row of the grading summary
+$# Expects several variables:
+$#  hasPassing :: Maybe Int    -- Should Passing be displayed?
+$#  hasPoints  :: Maybe Poibts -- Should Points  be displayed?
+$#  summary    :: SheetGradeSummary -- summary to display
+$#  sumHeader  :: UniWorXMessage    -- row header
+$#
+  $maybe nrSheets <- positiveSum $ summary ^. _numSheets
+    <tr .table__row >
+      <th .table__th>_{sumHeader}
+      $maybe _ <- hasPassings
+        $with Sum pmax <- summary ^. _numGradePasses
+          $maybe Sum pacv <- summary ^. _achievedPasses
+              <td .table__td>
+                $if pmax /= 0
+                  #{textPercentInt pacv pmax}
+              <td .table__td>
+                #{display pacv} / #{display pmax}
+          $nothing
+            <td .table__td colspan=2>
+              #{display pmax }
+      $maybe _ <- hasPoints
+        $with Sum pmax <- summary ^. _sumGradePoints
+          $maybe Sum pacv <- summary ^. _achievedPoints
+              <td .table__td>
+                $if pmax /= 0
+                  #{textPercent $ realToFrac $ pacv / pmax}
+              <td .table__td>
+                #{display pacv} / #{display pmax}
+          $nothing
+            <td .table__td colspan=2>
+              #{display pmax }
+      <td .table__td>#{display nrSheets}

templates/widgets/rating.hamlet

@@ -3,18 +3,19 @@ $#  submissionRatingPoints :: Maybe points
 
 $maybe points <- submissionRatingPoints
   $maybe grading <- preview _grading sheetType
-    $case grading	
+    $case grading
       $of Points{..}
-        _{MsgAchievedOf points maxPoints}          
+        _{MsgAchievedOf points maxPoints}
-      $of PassPoints{}
+      $of PassPoints{maxPoints}
-        $if fromMaybe False (gradingPassed grading points)
+        $if fromMaybe False (gradingPassed grading points)
-          _{MsgPassed}
+          _{MsgPassed}, _{MsgAchievedOf points maxPoints}
-        $else
+        $else
-          _{MsgNotPassed}
+          _{MsgNotPassed}, _{MsgAchievedOf points maxPoints}
-      $of PassBinary 
+      $of PassBinary
         $if fromMaybe False (gradingPassed grading points)
           _{MsgPassed}
         $else
           _{MsgNotPassed}
+    , _{SheetTypeHeader sheetType}
   $nothing
     #{tickmarkS}

templates/widgets/sheetTypeSummary.hamlet

@@ -1,9 +1,9 @@
-$with realGrades <- normalSummary <> bonusSummary 
+$# DEPRECATED IN FAVOUR OF widgets/gradingSummary.hamlet DO NOT USE !!!
+$with realGrades <- normalSummary <> bonusSummary
   $# $with allGrades <- realGrades <> informationalSummary
   <div>
-    <ul>    
+      $maybe realPoints <- positiveSum (sumGradePoints realGrades)
-      $maybe realPoints <- positiveSum (sumGradePoints realGrades) 
+        <p>
-        <li>     
           Gesamtpunktzahl #{display realPoints}
           $maybe nPts <- getSum <$> achievedPoints realGrades
             \ davon #{display nPts} erreicht
@@ -13,21 +13,21 @@ $with realGrades <- normalSummary <> bonusSummary
                 von #{display achievedBonus} erreichbaren #
               Bonuspunkten)
             $if realPoints /= 0
-              \ #{textPercent $ realToFrac $ nPts / realPoints}    
+              \ #{textPercent $ realToFrac $ nPts / realPoints}
             \.
       $maybe fakePoints <- positiveSum (sumGradePoints informationalSummary)
-        <li>
+        <p>
-          <em>Hinweis: 
+          <em>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}    
+              \ #{textPercent $ realToFrac $ achievedFakes / fakePoints}
           \.
 
-      $maybe reqPasses <- positiveSum (numGradePasses normalSummary)      
+      $maybe reqPasses <- positiveSum (numGradePasses normalSummary)
-        <li>
+        <p>
           Aufgaben zum Bestehen: #{display reqPasses}
           $maybe passed <- getSum <$> achievedPasses realGrades
             \ davon #{display passed} bestanden
@@ -36,6 +36,6 @@ $with realGrades <- normalSummary <> bonusSummary
             \.
 
       $maybe noGradeSheets <- positiveSum numNotGraded
-        <li>
+        <p>
           #{display noGradeSheets} unbewertete Aufgabenblätter.