diff --git a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg index 9512318eb..827732551 100644 --- a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg +++ b/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")} diff --git a/messages/uniworx/categories/settings/personal_settings/en-eu.msg b/messages/uniworx/categories/settings/personal_settings/en-eu.msg index 3bbb8cec4..db67e3940 100644 --- a/messages/uniworx/categories/settings/personal_settings/en-eu.msg +++ b/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")} diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 69ee99847..a538160af 100644 --- a/src/Handler/Profile.hs +++ b/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 = - let ((getSum -> nrSupers, getSum -> nrReroute, getSum -> nrLetter), tWgt) = supervisorsTable - in maybeTable' (MsgProfileSupervisor nrSupers nrReroute) (Just MsgProfileNoSupervisor) - (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSupervisorRemark nrSupers nrReroute nrLetter) (nrSupers > 0, tWgt) + countUnderlings <- E.select $ do + spr <- E.from $ E.table @UserSupervisor + E.where_ $ spr E.^. UserSupervisorSupervisor E.==. E.val uid + 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 - in maybeTable' (MsgProfileSupervisee nrSubs nrReroute) (Just MsgProfileNoSupervisee) - (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSuperviseeRemark nrSubs nrReroute) (nrSubs > 0, tWgt) + let (nrUnderlings, nrUndersReroute) = errorCount countUnderlings + in maybeTable' (MsgProfileSupervisee nrUnderlings nrUndersReroute) (Just MsgProfileNoSupervisee) + (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 uid = dbTableWidget validator DBTable{..} +mkSupervisorsTable :: UserId -> DB Widget +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) $ - if isReroute + in 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 userPrefersPostal uid = dbTableWidget validator DBTable{..} +mkSuperviseesTable ::Bool -> UserId -> DB Widget +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 ] diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 62d147f4b..02ccc8857 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/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