From 45bc5ca9f511d6c354f246d1cd8656eeeaf850a7 Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 27 Jun 2024 17:42:13 +0200 Subject: [PATCH] chore(firm): various contributions towards #157 --- .../uniworx/categories/firm/de-de-formal.msg | 1 - messages/uniworx/categories/firm/en-eu.msg | 1 - .../utils/table_column/de-de-formal.msg | 1 + messages/uniworx/utils/table_column/en-eu.msg | 1 + src/Handler/Firm.hs | 57 +++++++++++++------ src/Handler/Utils.hs | 2 +- templates/firm-contact-info.hamlet | 10 ++-- 7 files changed, 49 insertions(+), 24 deletions(-) diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 1caf455ef..53ba2d4fc 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -7,7 +7,6 @@ FirmSuperForeign: Firmenfremde Ansprechpartner FirmSuperIrregular: Irreguläre Ansprechpartner FirmAssociates: Firmenangehörige FirmContact: Firmenkontakt -FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt. FirmEmail: Allgemeine Email FirmAddress: Postanschrift FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 0af0ef403..9c26677f2 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -7,7 +7,6 @@ FirmSuperForeign: External supervisor FirmSuperIrregular: Irregular supervisor FirmAssociates: Company associated users FirmContact: Company Contact -FirmNoContact: No general contact information known. FirmEmail: General company email FirmAddress: Postal address FirmDefaultPreferenceInfo: Default setting for new company associates only diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index 5d59fd304..c35e70c20 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -83,6 +83,7 @@ TableCompanyNo: Firmennummer TableCompanyNos: Firmennummern TableCompanyUser: Firmenangehöriger TableCompanyNrUsers: Firmenangehörige +TableCompanyNrSecondaryUsers: Sekundäre Firmenangehörige TableCompanyNrSupers: Ansprechpartner TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index c4260b07d..45947c414 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -83,6 +83,7 @@ TableCompanyNo: Company number TableCompanyNos: Company numbers TableCompanyUser: Associate TableCompanyNrUsers: Associates +TableCompanyNrSecondaryUsers: Secondary Associates TableCompanyNrSupers: Supervisors TableCompanyNrEmpSupervised: Supervised employees TableCompanyNrEmpRerouted: Employees having reroute diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 23d5acc21..d5d092777 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -236,7 +236,7 @@ runFirmActionFormPost cid route isAdmin acts = do deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64 deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany where - restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)] + restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)] -- reset supervisors given employees of a company to default company supervision, deleting all previous company-related supervisors resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64 @@ -260,9 +260,9 @@ addDefaultSupervisors cid employees = do E.<&> E.justVal cid E.<&> E.nothing ) - (\_old new -> + (\_old new -> [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications - , UserSupervisorCompany E.=. E.justVal cid + , UserSupervisorCompany E.=. E.justVal cid -- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reason ]) @@ -290,7 +290,7 @@ addDefaultSupervisorsFor mbSuperId mutualSupervision cids = do E.<&> E.just (spr E.^. UserCompanyCompany) E.<&> E.nothing ) - (\_old new -> + (\_old new -> [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany -- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon @@ -315,7 +315,7 @@ addDefaultSupervisorsAll mutualSupervision cids = do E.<&> E.just (spr E.^. UserCompanyCompany) E.<&> E.nothing ) - (\_old new -> + (\_old new -> [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany -- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon @@ -334,6 +334,26 @@ fromUserCompany mbFltr cmpy = do firmCountUsers :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountUsers = E.subSelectCount . fromUserCompany Nothing +firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) +firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp + where + primFltr usr = E.notExists (do + othr <- E.from $ E.table @UserCompany + E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority + E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser + E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving + ) + +firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) +firmCountUsersSecondary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp + where + primFltr usr = E.exists (do + othr <- E.from $ E.table @UserCompany + E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority + E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser + E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving + ) + firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor)) -- firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) @@ -445,7 +465,7 @@ type AllCompanyTableExpr = E.SqlExpr (Entity Company) queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company) queryAllCompany = id -type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Bool, E.Value Bool) +type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Bool, E.Value Bool, E.Value Word64) resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company) resultAllCompanyEntity = _dbrOutput . _1 @@ -461,6 +481,8 @@ resultAllCompanySupervisors = _dbrOutput . _3 . _unValue resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue +resultAllCompanyUsersSecondary :: Lens' AllCompanyTableData Word64 +resultAllCompanyUsersSecondary = _dbrOutput . _5 . _unValue mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget) mkFirmAllTable isAdmin uid = do @@ -483,12 +505,13 @@ mkFirmAllTable isAdmin uid = do , cmpy & firmCountUsers -- 2 , cmpy & firmHasSupervisors -- 3 , cmpy & firmHasDefaultReroutes -- 4 - -- , cmpy & firmCountEmployeeSupervised -- 4 - -- , cmpy & firmCountEmployeeRerouted -- 5 - -- , cmpy & firmCountEmployeeRerPost -- 6 - -- , cmpy & firmCountForeignSupervisors -- 7 - -- , cmpy & firmCountActiveReroutes -- 9 - -- , cmpy & firmCountActiveReroutes' -- 10 + , cmpy & firmCountUsersSecondary -- 5 + -- , cmpy & firmCountEmployeeSupervised + -- , cmpy & firmCountEmployeeRerouted + -- , cmpy & firmCountEmployeeRerPost + -- , cmpy & firmCountForeignSupervisors + -- , cmpy & firmCountActiveReroutes + -- , cmpy & firmCountActiveReroutes' ) dbtRowKey = (E.^. CompanyId) dbtProj = dbtProjFilteredPostId @@ -501,6 +524,7 @@ mkFirmAllTable isAdmin uid = do in anchorCell (FirmSupersR fsh) $ toWgt fsh , sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> numCell $ companyAvsId firm , sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr + , sortable (Just "secondary") (i18nCell MsgTableCompanyNrSecondaryUsers) $ \(view resultAllCompanyUsersSecondary -> nr) -> wgtCell $ word2widget nr , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row -> anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors , sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> ok) -> tickmarkCell ok @@ -518,6 +542,7 @@ mkFirmAllTable isAdmin uid = do , singletonMap "avsnr" $ SortColumn (E.^. CompanyAvsId) , singletonMap "postal-pref" $ SortColumn (E.^. CompanyPrefersPostal) , singletonMap "users" $ SortColumn firmCountUsers + , singletonMap "secondary" $ SortColumn firmCountUsersSecondary , singletonMap "supervisors" $ SortColumn firmHasSupervisors -- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised -- , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted @@ -598,7 +623,7 @@ mkFirmAllTable isAdmin uid = do -- )) -- ) -- ) - -- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) -> + -- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) -> -- case criterion of -- Nothing -> E.true -- (Just (crit::Text)) -> E.exists $ do @@ -618,7 +643,7 @@ mkFirmAllTable isAdmin uid = do -- )) -- ) -- ) - , single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> + , single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> case criterion of Nothing -> return True :: DB Bool (Just (crit::Text)) -> do @@ -851,7 +876,7 @@ mkFirmUserTable isAdmin cid = do (usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid) E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) - E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) + E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor) let -- supervisorField :: Field Handler UserId @@ -950,7 +975,7 @@ mkFirmUserTable isAdmin cid = do let checkPrimary = do other <- E.from $ E.table @UserCompany E.where_ $ other E.^. UserCompanyUser E.==. queryUserUserCompany row E.^. UserCompanyUser - E.&&. other E.^. UserCompanyPriority E.>. queryUserUserCompany row E.^. UserCompanyPriority + E.&&. other E.^. UserCompanyPriority E.>. queryUserUserCompany row E.^. UserCompanyPriority in case criterion of Nothing -> E.true Just False -> E.exists checkPrimary diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 4ce6b3714..11a12edc2 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -192,7 +192,7 @@ msgAdminProblem AdminProblemSupervisorNewCompany{adminProblemCompany=comp, admin msgAdminProblem AdminProblemSupervisorLeftCompany{adminProblemCompany=comp, adminProblemSupervisorReroute=rer} = return $ SomeMessages [SomeMessage $ MsgAdminProblemSupervisorLeftCompany rer, text2message ": ", company2msg comp] msgAdminProblem AdminProblemCompanySuperiorChange{adminProblemCompany=comp} = return $ - SomeMessages [SomeMessage $ MsgAdminProblemCompanySuperiorChange, text2message ": ", company2msg comp] + SomeMessages [SomeMessage MsgAdminProblemCompanySuperiorChange, text2message ": ", company2msg comp] msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, adminProblemCompanyNew=newComp} = return $ SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp] msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $ diff --git a/templates/firm-contact-info.hamlet b/templates/firm-contact-info.hamlet index a251650db..2362b2c75 100644 --- a/templates/firm-contact-info.hamlet +++ b/templates/firm-contact-info.hamlet @@ -17,11 +17,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $maybe addr <- companyPostAddress
_{MsgFirmAddress} - $if companyPrefersPostal + $if companyPrefersPostal   #{iconLetterOrEmail True}
#{addr} - $nothing - $maybe _ <- companyEmail - $nothing - _{MsgFirmNoContact} +
+ _{MsgTableCompanyNo} +
+ #{companyAvsId} \ No newline at end of file