fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(firm): add filters for firm postal address and foreign supervisors

Browse Source
This commit is contained in:
Steffen Jost 2023-10-31 17:06:56 +01:00
parent ef0d71e19e
commit bb7b7cf3dc
6 changed files with 116 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
messages/uniworx/categories/firm/de-de-formal.msg
View File

@ -2,6 +2,10 @@
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # 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 FirmAllActNotify: Mitteilung versenden
FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
FirmUserActNotify: Mitteilung versenden FirmUserActNotify: Mitteilung versenden
@ -9,3 +13,5 @@ FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
FilterSupervisor: Hat aktiven Ansprechpartner FilterSupervisor: Hat aktiven Ansprechpartner
FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört
FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
FilterFirmPostalAddress: Postalische Firmenadresse vorhanden

8
messages/uniworx/categories/firm/en-eu.msg
View File

@ -2,10 +2,16 @@
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # 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 FirmAllActNotify: Send message
FirmAllActResetSupervision: Reset supervisors for all company associates FirmAllActResetSupervision: Reset supervisors for all company associates
FirmUserActNotify: Send message FirmUserActNotify: Send message
FirmUserActMkSuper: Mark as company supervisor FirmUserActMkSuper: Mark as company supervisor
FilterSupervisor: Has active supervisor FilterSupervisor: Has active supervisor
FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
FilterForeignSupervisor: Has company-external supervisors
FilterFirmPostalAddress: Postal company addresse known

3
models/company.model
View File

@ -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 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 avsId Int default=0 -- primary key from avs
prefersPostal Bool default=false -- new company users prefers letters by post instead of email 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 UniqueCompanyName name
UniqueCompanyShorthand shorthand UniqueCompanyShorthand shorthand
-- UniqueCompanyAvsId avsId -- should be the case, unclear if enforcing works here, since we cannot query avs by company id -- UniqueCompanyAvsId avsId -- should be the case, unclear if enforcing works here, since we cannot query avs by company id

52
src/Handler/Firm.hs
View File

@ -304,11 +304,31 @@ mkFirmAllTable isAdmin uid = do
E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion) 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 dbtFilterUI mPrev = mconcat
[ fltrCompanyNameUI mPrev [ fltrCompanyNameUI mPrev
, prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo)
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , 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 } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmAllAction (AForm Handler FirmAllActionData) acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
@ -541,18 +561,26 @@ postFirmUsersR fsh = do
siteLayout (citext2widget companyName) $ do siteLayout (citext2widget companyName) $ do
setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")" setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")"
[whamlet| [whamlet|
<section> <section .profile>
<p> <dl .deflist.profile-dl>
#{companyPostAddress} <dt .deflist__dt>
<p> _{MsgPrefersPostal}
Benachrichtigungs-Voreinstellung für neue Firmangehörige: # <dd .deflist__dd>
$if companyPrefersPostal #{iconLetterOrEmail companyPrefersPostal} #
#{icon IconLetter} Briefversand _{MsgFirmDefaultPostalPreferenceInfo}
$else $maybe fem <- companyEmail
#{icon IconAt} Email <dt .deflist__dt>
#{iconLetterOrEmail False} _{MsgFirmEmail}
<dd .deflist__dd .email>
#{mailToHtml fem}
$maybe addr <- companyPostAddress
<dt .deflist__dt>
#{iconLetterOrEmail True} _{MsgFirmEmail}
<dd .deflist__dd .email>
#{addr}
<section> <section>
<h4> <h4>
Company associated users, excluding foreign supervisors _{MsgFirmAssociates}
<p> <p>
^{fusrTable} ^{fusrTable}
|] |]

60
templates/firm-users.hamlet Normal file
View File

@ -0,0 +1,60 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<h2>
_{MsgProblemsHeadingDrivers}
<dl .deflist>
<dt .deflist__dt>^{flagError driversHaveAvsIds}
<dd .deflist__dd>^{simpleLinkI MsgProblemsDriversHaveAvsIds ProblemWithoutAvsId}
$case diffLics
$of Left err
<dt .deflist__dt>^{flagError False}
<dd .deflist__dd>^{modal (i18n MsgProblemsAvsProblem) (Right err)}
$of Right (ok0,ok1up,ok1down,ok2)
<dt .deflist__dt>^{flagNonZero ok2}
<dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch2 ProblemAvsSynchR}
<dt .deflist__dt>^{flagNonZero ok1down}
<dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch1down ProblemAvsSynchR}
<dt .deflist__dt>^{flagNonZero ok1up}
<dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch1up ProblemAvsSynchR}
<dt .deflist__dt>^{flagNonZero ok0}
<dd .deflist__dd>^{simpleLinkI MsgProblemsDriverSynch0 ProblemAvsSynchR}
<dt .deflist__dt>^{flagWarning rDriversHaveFs}
<dd .deflist__dd>^{simpleLinkI MsgProblemsRDriversHaveFs ProblemFbutNoR}
<section>
<h2>
_{MsgProblemsHeadingNotifications}
<dl .deflist>
<dt .deflist__dt>^{flagError usersAreReachable}
<dd .deflist__dd>^{simpleLinkI MsgProblemsUsersAreReachable ProblemUnreachableR}
<dt .deflist__dt>^{flagError noStalePrintJobs}
<dd .deflist__dd>^{simpleLinkI (MsgProblemsNoStalePrintJobs cutOffPrintDays) PrintCenterR}
<dt .deflist__dt>^{flagError noBadAPCids}
<dd .deflist__dd>_{MsgProblemsNoBadAPCIds}
$maybe reroute <- rerouteMail
<dt .deflist__dt>^{flagWarning False}
<dd .deflist__dd>_{MsgMailRerouteTo reroute}
<section>
<h2>
_{MsgProblemsHeadingMisc}
<dl .deflist>
<dt .deflist__dt>^{flagError noAvsSynchProblems}
<dd .deflist__dd>^{simpleLinkI MsgProblemsNoAvsSynchProblems ProblemAvsErrorR}

2
test/Database/Fill.hs
View File

@ -660,7 +660,7 @@ fillDb = do
, UserSupervisor gkleen gkleen True , UserSupervisor gkleen gkleen True
, UserSupervisor tinaTester tinaTester False , 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 111 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 300 matUsers ]
++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 401 matUsers ] ++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 401 matUsers ]
upsertManyWhere supvs [] [] [] upsertManyWhere supvs [] [] []