fix(user): fix pagination and count for supervision tables

messages/uniworx/categories/settings/personal_settings/de-de-formal.msg

@@ -29,7 +29,7 @@ Remarks: Hinweis:
 
 ProfileNoSupervisor: Keine übergeordneten Ansprechpartner vorhanden
 ProfileSupervisor n@Int m@Int: #{n} #{pluralDE n "übergeordneter" "übergeordnete"} Ansprechpartner#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")}
-ProfileSupervisorRemark n@Int m@Int l@Int: #{m}/#{n} #{pluralDE m "übergeordneter" "übergeordnete"} Ansprechpartner mit Benachrichtigungsumleitung#{noneMoreDE l "" (", davon " <> tshow l <> " mit postalischer Benachrichtigung")}
+ProfileSupervisorRemark n@Int m@Int l@Int: #{m} von #{n} #{pluralDE m "übergeordneter" "übergeordnete"} Ansprechpartner mit Benachrichtigungsumleitung#{noneMoreDE l "" (", davon " <> tshow l <> " mit postalischer Benachrichtigung")}
 ProfileNoSupervisee: Ist kein Ansprechpartner für irgendjemand
 ProfileSupervisee n@Int m@Int: Ist Ansprechpartner für #{n} #{pluralDE n "Person" "Personen"}#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")}
 ProfileSuperviseeRemark n@Int m@Int: Dieser Nutzer ist Ansprechpartner für #{n} #{pluralDE n "Person" "Personen"}#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")}

messages/uniworx/categories/settings/personal_settings/en-eu.msg

@@ -29,7 +29,7 @@ Remarks: Remark:
 
 ProfileNoSupervisor: Is not supervised by anynone
 ProfileSupervisor n m: #{pluralENsN n "supervisor"} #{noneMoreEN m "" ("with " <> tshow m <> " active notification rerouting")}
-ProfileSupervisorRemark n@Int m@Int l@Int: #{m}/#{n} #{pluralENs m "supervisor"} with active notification rerouting#{noneMoreEN l "" (", and " <> tshow l <> "of these prefer postal notifications")}
+ProfileSupervisorRemark n@Int m@Int l@Int: #{m} of #{n} #{pluralENs m "supervisor"} with active notification rerouting#{noneMoreEN l "" (", and " <> tshow l <> "of these prefer postal notifications")}
 ProfileNoSupervisee: Does not supervise anynone
 ProfileSupervisee n m: Supervises  #{pluralENsN n "person"} #{noneMoreEN m "" ("with " <> tshow m <> " active notification rerouting")}
 ProfileSuperviseeRemark n m: This person supervises #{pluralENsN n "person"}#{noneMoreEN m "" (" with " <> tshow m <> " having active notifications rerouting to this user")}

src/Handler/Profile.hs

@@ -35,6 +35,7 @@ import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E
 import qualified Database.Esqueleto.Legacy as EL (on,from)
 import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.PostgreSQL as E
 
 import qualified Data.Text as Text
 import Data.List (inits)
@@ -605,6 +606,7 @@ tableWidget :: TableHasData -> Widget
 tableWidget  = snd
 -}
 
+-- | Given a header message, a bool and widget; display widget and header only if the boolean is true
 maybeTable :: (RenderMessage UniWorX a)
            => a -> (Bool, Widget) -> Widget
 maybeTable m = maybeTable' m Nothing Nothing
@@ -675,14 +677,24 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
   qualificationsTable  <- mkQualificationsTable  now  uid -- Tabelle mit allen Qualifikationen
   supervisorsTable     <- mkSupervisorsTable          uid -- Tabelle mit allen Supervisors
   superviseesTable     <- mkSuperviseesTable actualPrefersPostal uid -- Tabelle mit allen Supervisees
-  let supervisorsWgt :: Widget =
+  countUnderlings <- E.select $ do
-        let ((getSum -> nrSupers, getSum -> nrReroute, getSum -> nrLetter), tWgt) = supervisorsTable
+    spr <- E.from $ E.table @UserSupervisor
-        in  maybeTable' (MsgProfileSupervisor nrSupers nrReroute) (Just MsgProfileNoSupervisor)
+    E.where_ $ spr E.^. UserSupervisorSupervisor E.==. E.val uid
-                        (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSupervisorRemark nrSupers nrReroute nrLetter) (nrSupers > 0, tWgt)
+    return (E.countRows, E.count (spr E.^. UserSupervisorId) `E.filterWhere` (spr E.^. UserSupervisorRerouteNotifications))
+  countSupervisors <- E.select $ do
+    spr <- E.from $ E.table @UserSupervisor
+    E.where_ $ spr E.^. UserSupervisorUser E.==. E.val uid
+    return (E.countRows, E.count (spr E.^. UserSupervisorId) `E.filterWhere` (spr E.^. UserSupervisorRerouteNotifications))
+  let errorCount ((E.Value x, E.Value y):_) = (x,y)
+      errorCount _ = (-1,-1)
+      supervisorsWgt :: Widget =
+        let (nrSupers, nrSupersReroute) = errorCount countSupervisors
+        in  maybeTable' (MsgProfileSupervisor nrSupers nrSupersReroute) (Just MsgProfileNoSupervisor)
+                        (toMaybe (nrSupersReroute > 0) $ msg2widget $ MsgProfileSupervisorRemark nrSupers nrSupersReroute 0) (nrSupers > 0, supervisorsTable)
       superviseesWgt :: Widget =
-        let ((getSum -> nrSubs, getSum -> nrReroute), tWgt) = superviseesTable
+        let (nrUnderlings, nrUndersReroute) = errorCount countUnderlings
-        in  maybeTable' (MsgProfileSupervisee nrSubs nrReroute) (Just MsgProfileNoSupervisee)
+        in maybeTable' (MsgProfileSupervisee nrUnderlings nrUndersReroute) (Just MsgProfileNoSupervisee)
-                        (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSuperviseeRemark nrSubs nrReroute) (nrSubs > 0, tWgt)
+                       (toMaybe (nrUndersReroute > 0) $ msg2widget $ MsgProfileSuperviseeRemark nrUnderlings nrUndersReroute) (nrUnderlings > 0, superviseesTable)
   -- let examTable, ownTutorialTable, tutorialTable :: Widget
   --     examTable        = i18n MsgPersonalInfoExamAchievementsWip
   --     ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip
@@ -1093,10 +1105,10 @@ instance HasUser TblSupervisorData where
   hasUser = _dbrOutput . _1 . _entityVal
 
 -- | Table listing all supervisor of the given user
-mkSupervisorsTable :: UserId -> DB ((Sum Int, Sum Int, Sum Int), Widget)
+mkSupervisorsTable :: UserId -> DB Widget
-mkSupervisorsTable uid = dbTableWidget validator DBTable{..}
+mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
   where
-    dbtIdent = "userSupervisedBy" :: Text
+    dbtIdent = "supervisors" :: Text
     dbtStyle = def
 
     dbtSQLQuery (usr `E.InnerJoin` spr) = do
@@ -1114,8 +1126,7 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..}
         , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
             let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
                 isLetter  = row ^. resultUser . _userPrefersPostal
-            in  tellCell (Sum 1, Sum $ fromEnum isReroute, Sum $ fromEnum $ isReroute && isLetter) $
+            in  if isReroute
-                if isReroute
                   then iconCell IconReroute <> spacerCell <> iconFixedCell (iconLetterOrEmail isLetter)
                   else mempty
         , sortable (Just "cshort")      (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
@@ -1146,10 +1157,10 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..}
 
 
 -- | Table listing all persons supervised by the given user
-mkSuperviseesTable ::Bool -> UserId -> DB ((Sum Int, Sum Int), Widget)
+mkSuperviseesTable ::Bool -> UserId -> DB Widget
-mkSuperviseesTable userPrefersPostal uid = dbTableWidget validator DBTable{..}
+mkSuperviseesTable userPrefersPostal uid = dbTableWidget' validator DBTable{..}
   where
-    dbtIdent = "userSupervisedBy" :: Text
+    dbtIdent = "supervisees" :: Text
     dbtStyle = def
 
     dbtSQLQuery (usr `E.InnerJoin` spr) = do
@@ -1167,7 +1178,7 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget validator DBTable{..}
         -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
         , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
             let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
-            in  tellCell (Sum 1, Sum $ fromEnum isReroute) $ boolCell isReroute $ iconCell IconReroute <> iconCellLetterOrEmail
+            in  boolCell isReroute $ iconCell IconReroute <> iconCellLetterOrEmail
         , sortable (Just "cshort")      (i18nCell MsgTableCompany)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
         , sortable (Just "reason")      (i18nCell MsgTableReason)   $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
         ]

src/Handler/Utils/Table/Cells.hs

@@ -32,6 +32,7 @@ spacerCell = cell [whamlet| |]
 semicolonCell :: IsDBTable m a => DBCell m a
 semicolonCell = cell [whamlet|; |]
 
+-- | Contribute to DBResult. BEWARE: only shown cells are executed; pagination makes tellCell useless for rowcounts; instead use dbtProj for computations on all rows regardless of pagination
 tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
 tellCell = flip mappend . writerCell . tell