Always form a monoidal sum during a run of dbTable

Fixes #142
2018-08-06 17:39:31 +02:00 · 2018-08-06 17:39:31 +02:00 · d2242f21ff
commit d2242f21ff
parent 8d70518fbb
9 changed files with 103 additions and 117 deletions
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@ -187,7 +187,7 @@ getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
      whereClause = const $ E.val True
      validator = def
        & defaultSorting [("course", SortAsc), ("term", SortDesc)]
-  coursesTable <- makeCourseTable whereClause colonnade validator
+  ((), coursesTable) <- makeCourseTable whereClause colonnade validator
  defaultLayout $ do
    setTitleI MsgCourseListTitle
    [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
@ -217,7 +217,7 @@ getTermCourseListR tid = do
      whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
      validator = def
        & defaultSorting [("cshort", SortAsc)]
-  coursesTable <- makeCourseTable whereClause colonnade validator
+  ((), coursesTable) <- makeCourseTable whereClause colonnade validator
  defaultLayout $ do
    setTitleI . MsgTermCourseListTitle $ tid
    $(widgetFile "courses")
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@ -65,7 +65,7 @@ homeAnonymous = do
                        E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
            return course

-      colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (WidgetT UniWorX IO) ())
+      colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
@ -77,7 +77,7 @@ homeAnonymous = do
        , sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
            cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
        ]
-  courseTable <- dbTable def $ DBTable
+  ((), courseTable) <- dbTable def $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = colonnade
    , dbtProj      = return
@ -144,7 +144,7 @@ homeUser uid = do
                                             , E.Value UTCTime
                                             , E.Value (Maybe SubmissionId)
                                             ))
-                                      (DBCell (WidgetT UniWorX IO) ())
+                                      (DBCell (HandlerT UniWorX IO) ())
      colonnade = mconcat
        [ -- dbRow
          sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } ->
@ -162,7 +162,7 @@ homeUser uid = do
                                        tickmark
        ]
  let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
-  sheetTable <- dbTable validator $ DBTable
+  ((), sheetTable) <- dbTable validator $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = colonnade
    , dbtProj      = \dbRow@DBRow{ dbrOutput = (E.Value tid, E.Value csh, E.Value shn, _, _) }
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -56,6 +56,8 @@ import qualified Data.Map as Map
 import Data.Map (Map, (!), (!?))
 import qualified Data.Map as Map

+import Data.Monoid (Sum(..))
+
 import Control.Lens
 import Utils.Lens

@ -199,7 +201,8 @@ getSheetListR tid csh = do
                    mkRoute = do
                      cid <- mkCid
                      return $ CSubmissionR tid csh sheetName cid CorrectionR
-                in anchorCellM mkRoute $(widgetFile "widgets/rating")
+                    protoCell = anchorCellM mkRoute $(widgetFile "widgets/rating")
+                in protoCell & cellContents %~ (<* tell (sheetTypeSum (sheetType, submissionRatingPoints)))
      , sortable Nothing -- (Just "percent")
                        (i18nCell MsgRatingPercent)
          $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
@ -214,7 +217,7 @@ getSheetListR tid csh = do
      ]          
    psValidator = def
      & defaultSorting [("submission-since", SortAsc)]
-  table <- dbTable psValidator $ DBTable
+  (SheetTypeSummary{..}, table) <- dbTable psValidator $ DBTable
    { dbtSQLQuery  = sheetData
    , dbtColonnade = sheetCol
    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
@ -248,19 +251,6 @@ getSheetListR tid csh = do
    , dbtStyle     = def
    , dbtIdent     = "sheets" :: Text
    }
-  cTime <- Just <$> liftIO getCurrentTime -- TODO: HACK - remove me and the 2 next TODOs, see issue #142
-  rawStats <- runDB $ do -- compute the values of the table once again, since dbTable does not provide a list of raw values for summation/statistics
-    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
-        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
-      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-        E.&&.   (E.not_ $ E.isNothing $ sheet E.^. SheetVisibleFrom) -- TODO see above #142
-        E.&&.   sheet E.^. SheetVisibleFrom E.<=. E.val cTime        -- TODO see above #142
-      return $ (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
-
-  let sheetTypeSummary = foldl' sumSheetTypes emptySheetTypeSummary
-                       $ map (\(st,mp) -> (E.unValue st, join $ E.unValue mp)) rawStats
  defaultLayout $ do
    $(widgetFile "sheetList")
    $(widgetFile "widgets/sheetTypeSummary")
@ -301,7 +291,7 @@ getSShowR tid csh shn = do
        ]
  let psValidator = def
        & defaultSorting [("type", SortAsc), ("path", SortAsc)]
-  fileTable <- dbTable psValidator $ DBTable
+  ((), fileTable) <- dbTable psValidator $ DBTable
    { dbtSQLQuery = fileData
    , dbtColonnade = colonnadeFiles
    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -246,7 +246,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
  maySubmit <- (== Authorized) <$> isAuthorized actionUrl True

  -- Maybe construct a table to display uploaded archive files
-  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
+  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
      colonnadeFiles cid = mconcat
        [ sortable (Just "path") (textCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
              Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
@ -299,7 +299,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
                        ]
        , dbtFilter = []
        }
-  mFileTable <- traverse (dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
+  mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid

  defaultLayout $ do
    setTitleI $ MsgSubmissionEditHead tid csh shn
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -78,7 +78,7 @@ getTermShowR = do
 --                       #{termToText termName}
 --                 |]
 --           ]
-      table <- dbTable def $ DBTable
+      ((), table) <- dbTable def $ DBTable
        { dbtSQLQuery = termData
        , dbtColonnade = colonnadeTerms
        , dbtProj = return . dbrOutput
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@ -4,7 +4,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

 module Handler.Users where

@ -12,6 +12,8 @@ import Import
 -- import Data.Text
 import Handler.Utils

+import Utils.Lens
+
 import qualified Data.Map as Map
 import qualified Data.Set as Set

@ -29,7 +31,7 @@ hijackUserForm uid csrf = do
 getUsersR :: Handler Html
 getUsersR = do
  let
-    colonnadeUsers = dbColonnade . mconcat $
+    dbtColonnade = dbColonnade . mconcat $
      [ dbRow
      , sortable (Just "display-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
          (AdminUserR <$> encrypt uid)
@ -40,32 +42,28 @@ getUsersR = do
 --       , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
 --           (AdminUserR <$> encrypt uid)
 --           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
-      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
-          { dbCellContents = do
-              schools <- E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
-                E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
-                E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
-                E.orderBy [E.asc $ school E.^. SchoolShorthand]
-                return $ school E.^. SchoolShorthand
-              return [whamlet|
-                  <ul .list--inline .list--comma-separated>
-                    $forall (E.Value sh) <- schools
-                      <li>#{sh}
-                |]
-          }
-      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> mempty
-          { dbCellContents = do
-              schools <- E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
-                E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
-                E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
-                E.orderBy [E.asc $ school E.^. SchoolShorthand]
-                return $ school E.^. SchoolShorthand
-              return [whamlet|
-                  <ul .list--inline .list--comma-separated>
-                    $forall (E.Value sh) <- schools
-                      <li>#{sh}
-                |]
-          }
+      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
+          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
+            E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
+            E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
+            E.orderBy [E.asc $ school E.^. SchoolShorthand]
+            return $ school E.^. SchoolShorthand
+          return [whamlet|
+            <ul .list--inline .list--comma-separated>
+              $forall (E.Value sh) <- schools
+                <li>#{sh}
+            |]
+      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
+          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
+            E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
+            E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
+            E.orderBy [E.asc $ school E.^. SchoolShorthand]
+            return $ school E.^. SchoolShorthand
+          return [whamlet|
+            <ul .list--inline .list--comma-separated>
+              $forall (E.Value sh) <- schools
+                <li>#{sh}
+            |]
      , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
          (hijackView, hijackEnctype) <- liftHandlerT . generateFormPost $ hijackUserForm uid
          cID <- encrypt uid
@ -77,9 +75,9 @@ getUsersR = do
    psValidator = def
      & defaultSorting [("display-name", SortAsc)]
  
-  userList <- dbTable psValidator $ DBTable
+  ((), userList) <- dbTable psValidator $ DBTable
    { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
-    , dbtColonnade = colonnadeUsers
+    , dbtColonnade
    , dbtProj      = return
    , dbtSorting   = Map.fromList
        [ ( "display-name"
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -40,6 +40,7 @@ module Handler.Utils.Table.Pagination
  , dbRow, dbSelect
  , (&)
  , module Control.Monad.Trans.Maybe
+  , module Colonnade
  ) where

 import Handler.Utils.Table.Pagination.Types
@ -271,46 +272,46 @@ cellAttrs = dbCell . _1
 cellContents :: IsDBTable m x => Lens' (DBCell m x) (WriterT x m Widget)
 cellContents = dbCell . _2

-instance IsDBTable (WidgetT UniWorX IO) () where
-  type DBResult (WidgetT UniWorX IO) () = Widget
+instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where
+  type DBResult (HandlerT UniWorX IO) x = (x, Widget)
  -- type DBResult' (WidgetT UniWorX IO) () = ()

-  data DBCell (WidgetT UniWorX IO) () = WidgetCell
+  data DBCell (HandlerT UniWorX IO) x = WidgetCell
    { wgtCellAttrs :: [(Text, Text)]
-    , wgtCellContents :: Widget
+    , wgtCellContents :: WriterT x (HandlerT UniWorX IO) Widget
    }

  dbCell = iso
-    (\WidgetCell{..} -> (wgtCellAttrs, return wgtCellContents))
-    (\(attrs, mkWidget) -> WidgetCell attrs . join . fmap fst $ runWriterT mkWidget)
+    (\WidgetCell{..} -> (wgtCellAttrs, wgtCellContents))
+    (\(attrs, mkWidget) -> WidgetCell attrs mkWidget)
  
  -- dbWidget Proxy Proxy = iso (, ()) $ view _1
-  dbWidget _ = return
-  dbHandler _ f x = return $ f x
-  runDBTable = return . join . fmap (view _2)
+  dbWidget _ = return . snd
+  dbHandler _ f = return . over _2 f
+  runDBTable act = liftHandlerT act

-instance Monoid (DBCell (WidgetT UniWorX IO) ()) where
-  mempty = WidgetCell mempty mempty
-  (WidgetCell a c) `mappend` (WidgetCell a' c') = WidgetCell (mappend a a') (mappend c c')
+instance Monoid x => Monoid (DBCell (HandlerT UniWorX IO) x) where
+  mempty = WidgetCell mempty $ return mempty
+  (WidgetCell a c) `mappend` (WidgetCell a' c') = WidgetCell (mappend a a') (mappend <$> c <*> c')

-instance IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) () where
-  type DBResult (ReaderT SqlBackend (HandlerT UniWorX IO)) () = Widget
+instance Monoid x => IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) x where
+  type DBResult (ReaderT SqlBackend (HandlerT UniWorX IO)) x = (x, Widget)

-  data DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) () = DBCell
+  data DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x = DBCell
    { dbCellAttrs :: [(Text, Text)]
-    , dbCellContents :: ReaderT SqlBackend (HandlerT UniWorX IO) Widget
+    , dbCellContents :: WriterT x (ReaderT SqlBackend (HandlerT UniWorX IO)) Widget
    }

  dbCell = iso
-    (\DBCell{..} -> (dbCellAttrs, lift dbCellContents))
-    (\(attrs, mkWidget) -> DBCell attrs . fmap fst $ runWriterT mkWidget)
+    (\DBCell{..} -> (dbCellAttrs, dbCellContents))
+    (\(attrs, mkWidget) -> DBCell attrs mkWidget)

-  dbWidget _ = return
-  dbHandler _ f x = return $ f x
+  dbWidget _ = return . snd
+  dbHandler _ f = return . over _2 f
  -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget)
-  runDBTable = fmap snd . mapReaderT liftHandlerT
+  runDBTable = mapReaderT liftHandlerT

-instance Monoid (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ()) where
+instance Monoid x => Monoid (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x) where
  mempty = DBCell mempty $ return mempty
  (DBCell a c) `mappend` (DBCell a' c') = DBCell (mappend a a') (mappend <$> c <*> c')

@ -454,9 +455,9 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),

 --- DBCell utility functions

-widgetColonnade :: Headedness h
-                => Colonnade h r (DBCell (WidgetT UniWorX IO) ())
-                -> Colonnade h r (DBCell (WidgetT UniWorX IO) ())
+widgetColonnade :: (Headedness h, Monoid x)
+                => Colonnade h r (DBCell (HandlerT UniWorX IO) x)
+                -> Colonnade h r (DBCell (HandlerT UniWorX IO) x)
 widgetColonnade = id

 formColonnade :: (Headedness h, Monoid a)
@ -464,9 +465,9 @@ formColonnade :: (Headedness h, Monoid a)
              -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
 formColonnade = id

-dbColonnade :: Headedness h
-            => Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ())
-            -> Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) ())
+dbColonnade :: (Headedness h, Monoid x)
+            => Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x)
+            -> Colonnade h r (DBCell (ReaderT SqlBackend (HandlerT UniWorX IO)) x)
 dbColonnade = id

 cell :: IsDBTable m a => Widget -> DBCell m a
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@ -21,6 +21,7 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Fixed
+import Data.Monoid (Sum(..))

 import Database.Persist.TH
 import Database.Persist.Class
@ -42,6 +43,7 @@ import Data.Aeson (FromJSON(..), ToJSON(..), withText, Value(..))
 import Data.Aeson.TH (deriveJSON, defaultOptions)

 import GHC.Generics (Generic)
+import Generics.Deriving.Monoid (gmemptydefault, gmappenddefault)
 import Data.Typeable (Typeable)

 import Text.Shakespeare.I18N (ToMessage(..), RenderMessage(..))
@ -77,29 +79,24 @@ deriveJSON defaultOptions ''SheetType
 derivePersistFieldJSON "SheetType"

 data SheetTypeSummary = SheetTypeSummary
-  { sumBonusPoints  :: Points
-  , sumNormalPoints :: Points
-  , numPassSheets   :: Int
-  , numNotGraded    :: Int
-  , achievedBonus   :: Maybe Points
-  , achievedNormal  :: Maybe Points
-  , achievedPasses  :: Maybe Int
-  }
+  { sumBonusPoints  :: Sum Points
+  , sumNormalPoints :: Sum Points
+  , numPassSheets   :: Sum Int
+  , numNotGraded    :: Sum Int
+  , achievedBonus   :: Maybe (Sum Points)
+  , achievedNormal  :: Maybe (Sum Points)
+  , achievedPasses  :: Maybe (Sum Int)
+  } deriving (Generic)

+instance Monoid SheetTypeSummary where
+  mempty = gmemptydefault
+  mappend = gmappenddefault

-emptySheetTypeSummary :: SheetTypeSummary
-emptySheetTypeSummary = SheetTypeSummary 0 0 0 0 Nothing Nothing Nothing
-
-- TODO: refactor with lenses!
-sumSheetTypes :: SheetTypeSummary -> (SheetType, Maybe Points) -> SheetTypeSummary
-sumSheetTypes sts@(SheetTypeSummary {..}) (Bonus {..}, achieved)
-  = sts{ sumBonusPoints =sumBonusPoints +maxPoints, achievedBonus  = maybeAdd achievedBonus  achieved }
-sumSheetTypes sts@(SheetTypeSummary {..}) (Normal {..}, achieved)
-  = sts{ sumNormalPoints=sumNormalPoints+maxPoints, achievedNormal = maybeAdd achievedNormal achieved }
-sumSheetTypes sts@(SheetTypeSummary {..}) (Pass   {..}, achieved)
-  = sts{ numPassSheets=numPassSheets+1, achievedPasses = maybeAdd achievedPasses (bool 0 1 <$> (passingPoints <=) <$> achieved) }
-sumSheetTypes sts@(SheetTypeSummary {..}) (NotGraded, _achieved)
-  = sts{ numNotGraded=numNotGraded+1 }
+sheetTypeSum :: (SheetType, Maybe Points) -> SheetTypeSummary
+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 }


 data SheetGroup
--- a/templates/widgets/sheetTypeSummary.hamlet
+++ b/templates/widgets/sheetTypeSummary.hamlet
@ -1,23 +1,23 @@
 <div>
-  $if 0 < sumNormalPoints sheetTypeSummary
-    Gesamtpunktzahl #{display (sumNormalPoints sheetTypeSummary)}
-    $maybe nPts <- (maybeAdd (achievedNormal sheetTypeSummary) (achievedBonus sheetTypeSummary))
+  $if 0 < getSum sumNormalPoints
+    Gesamtpunktzahl #{display (getSum sumNormalPoints)}
+    $maybe nPts <- (maybeAdd (getSum <$> achievedNormal) (getSum <$> achievedBonus))
      \ davon #{display nPts} erreicht
-      $maybe bPts <- achievedBonus sheetTypeSummary
+      $maybe bPts <- getSum <$> achievedBonus
        \ (inklusive #{display bPts} #
-        $if 0 < sumBonusPoints sheetTypeSummary
-          von #{display $ sumBonusPoints sheetTypeSummary} erreichbaren #
+        $if 0 < getSum sumBonusPoints
+          von #{display $ getSum sumBonusPoints} erreichbaren #
        Bonuspunkten)
-      \ #{textPercent $ realToFrac $ nPts / (sumNormalPoints sheetTypeSummary)}
+      \ #{textPercent $ realToFrac $ nPts / (getSum sumNormalPoints)}


 <div>
-  $if 0 < numPassSheets sheetTypeSummary
-    Blätter zum Bestehen: #{display (numPassSheets sheetTypeSummary)}
-    $maybe passed <- achievedPasses sheetTypeSummary
-      \ davon #{display (achievedPasses sheetTypeSummary)} bestanden.
+  $if 0 < getSum numPassSheets
+    Blätter zum Bestehen: #{display (getSum numPassSheets)}
+    $maybe passed <- getSum <$> achievedPasses
+      \ davon #{display passed} bestanden.

 <div>
-  $if 0 < numNotGraded sheetTypeSummary
-    Unbewertet: #{display (numNotGraded sheetTypeSummary)} Blätter
+  $if 0 < getSum numNotGraded
+    Unbewertet: #{display (getSum numNotGraded)} Blätter