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): various contributions towards #157

Browse Source
This commit is contained in:
Steffen Jost 2024-06-27 17:42:13 +02:00
parent 3dfc7f8c8b
commit 45bc5ca9f5
7 changed files with 49 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,7 +7,6 @@ FirmSuperForeign: Firmenfremde Ansprechpartner
FirmSuperIrregular: Irreguläre Ansprechpartner FirmSuperIrregular: Irreguläre Ansprechpartner
FirmAssociates: Firmenangehörige FirmAssociates: Firmenangehörige
FirmContact: Firmenkontakt FirmContact: Firmenkontakt
FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt.
FirmEmail: Allgemeine Email FirmEmail: Allgemeine Email
FirmAddress: Postanschrift FirmAddress: Postanschrift
FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige

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

@ -7,7 +7,6 @@ FirmSuperForeign: External supervisor
FirmSuperIrregular: Irregular supervisor FirmSuperIrregular: Irregular supervisor
FirmAssociates: Company associated users FirmAssociates: Company associated users
FirmContact: Company Contact FirmContact: Company Contact
FirmNoContact: No general contact information known.
FirmEmail: General company email FirmEmail: General company email
FirmAddress: Postal address FirmAddress: Postal address
FirmDefaultPreferenceInfo: Default setting for new company associates only FirmDefaultPreferenceInfo: Default setting for new company associates only

1
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -83,6 +83,7 @@ TableCompanyNo: Firmennummer
TableCompanyNos: Firmennummern TableCompanyNos: Firmennummern
TableCompanyUser: Firmenangehöriger TableCompanyUser: Firmenangehöriger
TableCompanyNrUsers: Firmenangehörige TableCompanyNrUsers: Firmenangehörige
TableCompanyNrSecondaryUsers: Sekundäre Firmenangehörige
TableCompanyNrSupers: Ansprechpartner TableCompanyNrSupers: Ansprechpartner
TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner
TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung

1
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -83,6 +83,7 @@ TableCompanyNo: Company number
TableCompanyNos: Company numbers TableCompanyNos: Company numbers
TableCompanyUser: Associate TableCompanyUser: Associate
TableCompanyNrUsers: Associates TableCompanyNrUsers: Associates
TableCompanyNrSecondaryUsers: Secondary Associates
TableCompanyNrSupers: Supervisors TableCompanyNrSupers: Supervisors
TableCompanyNrEmpSupervised: Supervised employees TableCompanyNrEmpSupervised: Supervised employees
TableCompanyNrEmpRerouted: Employees having reroute TableCompanyNrEmpRerouted: Employees having reroute

57
src/Handler/Firm.hs
View File

@ -236,7 +236,7 @@ runFirmActionFormPost cid route isAdmin acts = do
deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64 deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64
deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany
where 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 -- reset supervisors given employees of a company to default company supervision, deleting all previous company-related supervisors
resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64 resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
@ -260,9 +260,9 @@ addDefaultSupervisors cid employees = do
E.<&> E.justVal cid E.<&> E.justVal cid
E.<&> E.nothing E.<&> E.nothing
) )
(\_old new -> (\_old new ->
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
, UserSupervisorCompany E.=. E.justVal cid , UserSupervisorCompany E.=. E.justVal cid
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reason -- , 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.just (spr E.^. UserCompanyCompany)
E.<&> E.nothing E.<&> E.nothing
) )
(\_old new -> (\_old new ->
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
, UserSupervisorCompany E.=. new E.^. UserSupervisorCompany , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon -- , 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.just (spr E.^. UserCompanyCompany)
E.<&> E.nothing E.<&> E.nothing
) )
(\_old new -> (\_old new ->
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
, UserSupervisorCompany E.=. new E.^. UserSupervisorCompany , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon -- , 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.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountUsers = E.subSelectCount . fromUserCompany Nothing 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.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor)) firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
-- firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) -- 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 :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
queryAllCompany = id 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 :: Lens' AllCompanyTableData (Entity Company)
resultAllCompanyEntity = _dbrOutput . _1 resultAllCompanyEntity = _dbrOutput . _1
@ -461,6 +481,8 @@ resultAllCompanySupervisors = _dbrOutput . _3 . _unValue
resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool
resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue
resultAllCompanyUsersSecondary :: Lens' AllCompanyTableData Word64
resultAllCompanyUsersSecondary = _dbrOutput . _5 . _unValue
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget) mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do mkFirmAllTable isAdmin uid = do
@ -483,12 +505,13 @@ mkFirmAllTable isAdmin uid = do
, cmpy & firmCountUsers -- 2 , cmpy & firmCountUsers -- 2
, cmpy & firmHasSupervisors -- 3 , cmpy & firmHasSupervisors -- 3
, cmpy & firmHasDefaultReroutes -- 4 , cmpy & firmHasDefaultReroutes -- 4
-- , cmpy & firmCountEmployeeSupervised -- 4 , cmpy & firmCountUsersSecondary -- 5
-- , cmpy & firmCountEmployeeRerouted -- 5 -- , cmpy & firmCountEmployeeSupervised
-- , cmpy & firmCountEmployeeRerPost -- 6 -- , cmpy & firmCountEmployeeRerouted
-- , cmpy & firmCountForeignSupervisors -- 7 -- , cmpy & firmCountEmployeeRerPost
-- , cmpy & firmCountActiveReroutes -- 9 -- , cmpy & firmCountForeignSupervisors
-- , cmpy & firmCountActiveReroutes' -- 10 -- , cmpy & firmCountActiveReroutes
-- , cmpy & firmCountActiveReroutes'
) )
dbtRowKey = (E.^. CompanyId) dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjFilteredPostId
@ -501,6 +524,7 @@ mkFirmAllTable isAdmin uid = do
in anchorCell (FirmSupersR fsh) $ toWgt fsh in anchorCell (FirmSupersR fsh) $ toWgt fsh
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> numCell $ companyAvsId firm , sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> numCell $ companyAvsId firm
, sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr , 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 -> , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row ->
anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors
, sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> ok) -> tickmarkCell ok , 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 "avsnr" $ SortColumn (E.^. CompanyAvsId)
, singletonMap "postal-pref" $ SortColumn (E.^. CompanyPrefersPostal) , singletonMap "postal-pref" $ SortColumn (E.^. CompanyPrefersPostal)
, singletonMap "users" $ SortColumn firmCountUsers , singletonMap "users" $ SortColumn firmCountUsers
, singletonMap "secondary" $ SortColumn firmCountUsersSecondary
, singletonMap "supervisors" $ SortColumn firmHasSupervisors , singletonMap "supervisors" $ SortColumn firmHasSupervisors
-- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised -- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
-- , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted -- , 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 -- case criterion of
-- Nothing -> E.true -- Nothing -> E.true
-- (Just (crit::Text)) -> E.exists $ do -- (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 case criterion of
Nothing -> return True :: DB Bool Nothing -> return True :: DB Bool
(Just (crit::Text)) -> do (Just (crit::Text)) -> do
@ -851,7 +876,7 @@ mkFirmUserTable isAdmin cid = do
(usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany (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.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.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) return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor)
let let
-- supervisorField :: Field Handler UserId -- supervisorField :: Field Handler UserId
@ -950,7 +975,7 @@ mkFirmUserTable isAdmin cid = do
let checkPrimary = do let checkPrimary = do
other <- E.from $ E.table @UserCompany other <- E.from $ E.table @UserCompany
E.where_ $ other E.^. UserCompanyUser E.==. queryUserUserCompany row E.^. UserCompanyUser 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 in case criterion of
Nothing -> E.true Nothing -> E.true
Just False -> E.exists checkPrimary Just False -> E.exists checkPrimary

2
src/Handler/Utils.hs
View File

@ -192,7 +192,7 @@ msgAdminProblem AdminProblemSupervisorNewCompany{adminProblemCompany=comp, admin
msgAdminProblem AdminProblemSupervisorLeftCompany{adminProblemCompany=comp, adminProblemSupervisorReroute=rer} = return $ msgAdminProblem AdminProblemSupervisorLeftCompany{adminProblemCompany=comp, adminProblemSupervisorReroute=rer} = return $
SomeMessages [SomeMessage $ MsgAdminProblemSupervisorLeftCompany rer, text2message ": ", company2msg comp] SomeMessages [SomeMessage $ MsgAdminProblemSupervisorLeftCompany rer, text2message ": ", company2msg comp]
msgAdminProblem AdminProblemCompanySuperiorChange{adminProblemCompany=comp} = return $ msgAdminProblem AdminProblemCompanySuperiorChange{adminProblemCompany=comp} = return $
SomeMessages [SomeMessage $ MsgAdminProblemCompanySuperiorChange, text2message ": ", company2msg comp] SomeMessages [SomeMessage MsgAdminProblemCompanySuperiorChange, text2message ": ", company2msg comp]
msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, adminProblemCompanyNew=newComp} = return $ msgAdminProblem AdminProblemNewlyUnsupervised{adminProblemCompanyOld=comp, adminProblemCompanyNew=newComp} = return $
SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp] SomeMessages [SomeMessage MsgAdminProblemNewlyUnsupervised, text2message ": ", maybe (text2message "???") company2msg comp, text2message " -> ", company2msg newComp]
msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $ msgAdminProblem AdminProblemUnknown{adminProblemText=err} = return $

10
templates/firm-contact-info.hamlet
View File

@ -17,11 +17,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe addr <- companyPostAddress $maybe addr <- companyPostAddress
<dt .deflist__dt> <dt .deflist__dt>
_{MsgFirmAddress} _{MsgFirmAddress}
$if companyPrefersPostal $if companyPrefersPostal
&nbsp; #{iconLetterOrEmail True} &nbsp; #{iconLetterOrEmail True}
<dd .deflist__dd> <dd .deflist__dd>
#{addr} #{addr}
$nothing <dt .deflist__dt>
$maybe _ <- companyEmail _{MsgTableCompanyNo}
$nothing <dd .deflist__dd>
_{MsgFirmNoContact} #{companyAvsId}