From bb7b7cf3dcf3602f25d2ced7ad1c483bec51200b Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 31 Oct 2023 17:06:56 +0100 Subject: [PATCH] chore(firm): add filters for firm postal address and foreign supervisors --- .../uniworx/categories/firm/de-de-formal.msg | 6 ++ messages/uniworx/categories/firm/en-eu.msg | 8 ++- models/company.model | 3 +- src/Handler/Firm.hs | 52 ++++++++++++---- templates/firm-users.hamlet | 60 +++++++++++++++++++ test/Database/Fill.hs | 2 +- 6 files changed, 116 insertions(+), 15 deletions(-) create mode 100644 templates/firm-users.hamlet diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 57f5ddecf..9bef83c31 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -2,6 +2,10 @@ # # SPDX-License-Identifier: AGPL-3.0-or-later +FirmAssociates: Firmenangehörige, ohne externe Ansprechpartner +FirmEmail: Allgemeine Email +FirmAddress: Postanschrift +FirmDefaultPostalPreferenceInfo: Hinweis: Dies ist lediglich die Voreinstellung für neue Firmenangehörige FirmAllActNotify: Mitteilung versenden FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen FirmUserActNotify: Mitteilung versenden @@ -9,3 +13,5 @@ FirmUserActMkSuper: Zum Firmenansprechpartner ernennen FilterSupervisor: Hat aktiven Ansprechpartner FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört +FilterForeignSupervisor: Hat firmenfremde Ansprechpartner +FilterFirmPostalAddress: Postalische Firmenadresse vorhanden \ No newline at end of file diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 9cabba5e9..71652d37e 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -2,10 +2,16 @@ # # SPDX-License-Identifier: AGPL-3.0-or-later +FirmAssociates: Company associated users, excluding foreign supervisors +FirmEmail: General company email +FirmAddress: Postal address +FirmDefaultPostalPreferenceInfo: Note that this is only the default setting for new company associates FirmAllActNotify: Send message FirmAllActResetSupervision: Reset supervisors for all company associates FirmUserActNotify: Send message FirmUserActMkSuper: Mark as company supervisor FilterSupervisor: Has active supervisor FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} -FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} \ No newline at end of file +FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} +FilterForeignSupervisor: Has company-external supervisors +FilterFirmPostalAddress: Postal company addresse known \ No newline at end of file diff --git a/models/company.model b/models/company.model index 5443b64b0..c022ad5f1 100644 --- a/models/company.model +++ b/models/company.model @@ -9,7 +9,8 @@ Company shorthand CompanyShorthand -- == (CI Text) and CompanyKey :: CompanyShorthand -> CompanyId FUTURE TODO: a shorthand will become available through the AVS interface in the future avsId Int default=0 -- primary key from avs prefersPostal Bool default=false -- new company users prefers letters by post instead of email - postAddress StoredMarkup Maybe -- default company postal address + postAddress StoredMarkup Maybe -- default company postal address + email UserEmail Maybe -- Case-insensitive generic company eMail address UniqueCompanyName name UniqueCompanyShorthand shorthand -- UniqueCompanyAvsId avsId -- should be the case, unclear if enforcing works here, since we cannot query avs by company id diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index bf24fedb1..d910c4ea9 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -304,11 +304,31 @@ mkFirmAllTable isAdmin uid = do E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion) ) ) + , single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) -> + let checkSuper = do + usrSpr <- E.from $ E.table @UserSupervisor + E.where_ $ E.notExists (do + spr <- E.from $ E.table @UserCompany + E.where_ $ spr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId + E.&&. spr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorSupervisor + ) E.&&. E.exists (do + usr <- E.from $ E.table @UserCompany + E.where_ $ usr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId + E.&&. usr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser + ) + in case criterion of + Nothing -> E.true + Just True -> E.exists checkSuper + Just False -> E.notExists checkSuper + ) + , single ("company-postal", FilterColumn $ E.mkExactFilterLast $ views (to queryAllCompany) (E.isJust . (E.^. CompanyPostAddress))) ] dbtFilterUI mPrev = mconcat [ fltrCompanyNameUI mPrev - , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) - , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) + , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) + , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) + , prismAForm (singletonFilter "foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterForeignSupervisor) + , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmPostalAddress) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map FirmAllAction (AForm Handler FirmAllActionData) @@ -541,18 +561,26 @@ postFirmUsersR fsh = do siteLayout (citext2widget companyName) $ do setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")" [whamlet| -
-

- #{companyPostAddress} -

- Benachrichtigungs-Voreinstellung für neue Firmangehörige: # - $if companyPrefersPostal - #{icon IconLetter} Briefversand - $else - #{icon IconAt} Email +

+
+
+ _{MsgPrefersPostal} +
+ #{iconLetterOrEmail companyPrefersPostal} # + _{MsgFirmDefaultPostalPreferenceInfo} + $maybe fem <- companyEmail +
+ #{iconLetterOrEmail False} _{MsgFirmEmail} +
+ #{mailToHtml fem} + $maybe addr <- companyPostAddress +
+ #{iconLetterOrEmail True} _{MsgFirmEmail} +
+ #{addr}

- Company associated users, excluding foreign supervisors + _{MsgFirmAssociates}

^{fusrTable} |] diff --git a/templates/firm-users.hamlet b/templates/firm-users.hamlet new file mode 100644 index 000000000..60ffd4d92 --- /dev/null +++ b/templates/firm-users.hamlet @@ -0,0 +1,60 @@ +$newline never + +$# SPDX-FileCopyrightText: 2022 Steffen Jost +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +

+

+ _{MsgProblemsHeadingDrivers} + +
+
^{flagError driversHaveAvsIds} +
^{simpleLinkI MsgProblemsDriversHaveAvsIds ProblemWithoutAvsId} + + $case diffLics + $of Left err +
^{flagError False} +
^{modal (i18n MsgProblemsAvsProblem) (Right err)} + + $of Right (ok0,ok1up,ok1down,ok2) +
^{flagNonZero ok2} +
^{simpleLinkI MsgProblemsDriverSynch2 ProblemAvsSynchR} + +
^{flagNonZero ok1down} +
^{simpleLinkI MsgProblemsDriverSynch1down ProblemAvsSynchR} + +
^{flagNonZero ok1up} +
^{simpleLinkI MsgProblemsDriverSynch1up ProblemAvsSynchR} + +
^{flagNonZero ok0} +
^{simpleLinkI MsgProblemsDriverSynch0 ProblemAvsSynchR} + +
^{flagWarning rDriversHaveFs} +
^{simpleLinkI MsgProblemsRDriversHaveFs ProblemFbutNoR} + + +
+

+ _{MsgProblemsHeadingNotifications} + +
+
^{flagError usersAreReachable} +
^{simpleLinkI MsgProblemsUsersAreReachable ProblemUnreachableR} + +
^{flagError noStalePrintJobs} +
^{simpleLinkI (MsgProblemsNoStalePrintJobs cutOffPrintDays) PrintCenterR} + +
^{flagError noBadAPCids} +
_{MsgProblemsNoBadAPCIds} + + $maybe reroute <- rerouteMail +
^{flagWarning False} +
_{MsgMailRerouteTo reroute} + +
+

+ _{MsgProblemsHeadingMisc} +
+
^{flagError noAvsSynchProblems} +
^{simpleLinkI MsgProblemsNoAvsSynchProblems ProblemAvsErrorR} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 2343751ff..850074cea 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -660,7 +660,7 @@ fillDb = do , UserSupervisor gkleen gkleen True , UserSupervisor tinaTester tinaTester False ] - ++ take 333 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers ] + ++ take 333 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers, uid /= jost] ++ take 111 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 300 matUsers ] ++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 401 matUsers ] upsertManyWhere supvs [] [] []