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

chore(firm): add more useful supervisor counts

Browse Source
This commit is contained in:
Steffen Jost 2023-10-26 10:30:27 +00:00
parent 47166094e7
commit a29d8f3698
4 changed files with 87 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -82,6 +82,9 @@ TableCompanyNo: Firmennummer
TableCompanyNos: Firmennummern TableCompanyNos: Firmennummern
TableCompanyNrUsers: Firmenangehörige TableCompanyNrUsers: Firmenangehörige
TableCompanyNrSupers: Ansprechpartner TableCompanyNrSupers: Ansprechpartner
TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner
TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung
TableCompanyNrEmpRerPost: Firmenangehörige mit postalischer Umleitung
TableCompanyNrSupersActive: Mitarbeiter mit Ansprechpartner TableCompanyNrSupersActive: Mitarbeiter mit Ansprechpartner
TableCompanyNrSupersDefault: Standard Ansprechpartner TableCompanyNrSupersDefault: Standard Ansprechpartner
TableCompanyNrForeignSupers: Firmenfremde Ansprechpartner TableCompanyNrForeignSupers: Firmenfremde Ansprechpartner

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

@ -82,6 +82,9 @@ TableCompanyNo: Company number
TableCompanyNos: Company numbers TableCompanyNos: Company numbers
TableCompanyNrUsers: Associates TableCompanyNrUsers: Associates
TableCompanyNrSupers: Supervisors TableCompanyNrSupers: Supervisors
TableCompanyNrEmpSupervised: Supervsied employees
TableCompanyNrEmpRerouted: Employees having reroute
TableCompanyNrEmpRerPost: Employees having postal reroute
TableCompanyNrSupersActive: Associates having supervisors TableCompanyNrSupersActive: Associates having supervisors
TableCompanyNrSupersDefault: Default supervisors TableCompanyNrSupersDefault: Default supervisors
TableCompanyNrForeignSupers: External Supervisors TableCompanyNrForeignSupers: External Supervisors

110
src/Handler/Firm.hs
View File

@ -60,7 +60,7 @@ postFirmR fsh = do
E.groupBy (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany) E.groupBy (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany)
E.orderBy [E.asc $ usr E.^. UserId, E.asc $ usr E.^. UserDisplayName, E.asc $ usr E.^. UserSurname, E.asc $ scmpy E.?. UserCompanyCompany] E.orderBy [E.asc $ usr E.^. UserId, E.asc $ usr E.^. UserDisplayName, E.asc $ usr E.^. UserSurname, E.asc $ scmpy E.?. UserCompanyCompany]
let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
return (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany, countRows') return (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany, countRows', usr E.^. UserPrefersPostal)
siteLayoutMsg (SomeMessage fsh) $ do siteLayoutMsg (SomeMessage fsh) $ do
setTitle $ citext2Html fsh setTitle $ citext2Html fsh
@ -72,8 +72,9 @@ postFirmR fsh = do
<h3>#{length cactSuper} Active Supervisors for Employees <h3>#{length cactSuper} Active Supervisors for Employees
<ul> <ul>
$forall (E.Value _, E.Value dn, E.Value sn, E.Value mbCsh, E.Value nr) <- cactSuper $forall (E.Value _, E.Value dn, E.Value sn, E.Value mbCsh, E.Value nr, E.Value prefPost) <- cactSuper
<li>#{nr} Employees supervised by ^{nameWidget dn sn} <li>#{nr} Employees supervised by ^{nameWidget dn sn} #
#{icon (bool IconAt IconLetter prefPost)} #
$maybe csh <- mbCsh $maybe csh <- mbCsh
$if csh /= fshId $if csh /= fshId
from foreign company #{unCompanyKey csh} from foreign company #{unCompanyKey csh}
@ -111,7 +112,7 @@ type AllCompanyTableExpr = E.SqlExpr (Entity Company)
queryCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company) queryCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
queryCompany = id queryCompany = id
type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64) type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company) resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company)
resultAllCompanyEntity = _dbrOutput . _1 resultAllCompanyEntity = _dbrOutput . _1
@ -124,17 +125,26 @@ resultAllCompanyUsers = _dbrOutput . _2 . _unValue
resultAllCompanySupervisors :: Lens' AllCompanyTableData Word64 resultAllCompanySupervisors :: Lens' AllCompanyTableData Word64
resultAllCompanySupervisors = _dbrOutput . _3 . _unValue resultAllCompanySupervisors = _dbrOutput . _3 . _unValue
resultAllCompanyEmployeeSupervised :: Lens' AllCompanyTableData Word64
resultAllCompanyEmployeeSupervised = _dbrOutput . _4 . _unValue
resultAllCompanyEmployeeRerouted :: Lens' AllCompanyTableData Word64
resultAllCompanyEmployeeRerouted = _dbrOutput . _5 . _unValue
resultAllCompanyEmpRerPost :: Lens' AllCompanyTableData Word64
resultAllCompanyEmpRerPost = _dbrOutput . _6 . _unValue
resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64 resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64
resultAllCompanyForeignSupers = _dbrOutput . _4 . _unValue resultAllCompanyForeignSupers = _dbrOutput . _7 . _unValue
resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Word64 resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Word64
resultAllCompanyDefaultReroutes = _dbrOutput . _5 . _unValue resultAllCompanyDefaultReroutes = _dbrOutput . _8 . _unValue
resultAllCompanyActiveReroutes :: Lens' AllCompanyTableData Word64 resultAllCompanyActiveReroutes :: Lens' AllCompanyTableData Word64
resultAllCompanyActiveReroutes = _dbrOutput . _6 . _unValue resultAllCompanyActiveReroutes = _dbrOutput . _9 . _unValue
resultAllCompanyActiveReroutes' :: Lens' AllCompanyTableData Word64 resultAllCompanyActiveReroutes' :: Lens' AllCompanyTableData Word64
resultAllCompanyActiveReroutes' = _dbrOutput . _7 . _unValue resultAllCompanyActiveReroutes' = _dbrOutput . _10 . _unValue
fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery () fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery ()
fromUserCompany mbFltr cmpy = do fromUserCompany mbFltr cmpy = do
@ -157,6 +167,35 @@ firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompa
firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute)) firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))
firmCountEmployeeSupervised :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany $ Just fltr
where
fltr usrc = E.exists $ do
usrSuper <- E.from $ E.table @UserSupervisor
E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
firmCountEmployeeRerouted :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany $ Just fltr
where
fltr usrc = E.exists $ do
usrSuper <- E.from $ E.table @UserSupervisor
E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
firmCountEmployeeRerPost :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountEmployeeRerPost = E.subSelectCount . fromUserCompany $ Just fltr
where
fltr usrc = E.exists $ do
(usrSuper :& usr) <-
E.from $ E.table @UserSupervisor
`E.innerJoin` E.table @User
`E.on` (\(usrSuper :& usr) -> usrSuper E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
E.&&. usr E.^. UserPrefersPostal
E.&&. E.isJust (usr E.^. UserPostAddress)
-- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) -- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-- firmCountForeignSupervisors cmpy = E.coalesceDefault -- firmCountForeignSupervisors cmpy = E.coalesceDefault
-- [E.subSelect $ do -- [E.subSelect $ do
@ -199,13 +238,16 @@ mkFirmAllTable isAdmin uid = do
usrCmpy <- E.from $ E.table @UserCompany usrCmpy <- E.from $ E.table @UserCompany
E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
return ( cmpy return ( cmpy -- 1
, cmpy & firmCountUsers , cmpy & firmCountUsers -- 2
, cmpy & firmCountSupervisors , cmpy & firmCountSupervisors -- 3
, cmpy & firmCountForeignSupervisors , cmpy & firmCountEmployeeSupervised -- 4
, cmpy & firmCountDefaultReroutes , cmpy & firmCountEmployeeRerouted -- 5
, cmpy & firmCountActiveReroutes , cmpy & firmCountEmployeeRerPost -- 6
, cmpy & firmCountActiveReroutes' , cmpy & firmCountForeignSupervisors -- 7
, cmpy & firmCountDefaultReroutes -- 8
, cmpy & firmCountActiveReroutes -- 9
, cmpy & firmCountActiveReroutes' -- 10
) )
dbtRowKey = (E.^. CompanyId) dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjId dbtProj = dbtProjId
@ -220,23 +262,29 @@ mkFirmAllTable isAdmin uid = do
in anchorCell (FirmR fsh) $ toWgt fsh in anchorCell (FirmR fsh) $ toWgt fsh
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> , sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm anchorCell (FirmR $ companyShorthand firm) $ toWgt $ 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 "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr
, sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> nr) -> wgtCell $ word2widget nr , sortable (Just "emp-supervised")(i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultAllCompanyEmployeeSupervised -> nr) -> wgtCell $ word2widget nr
, sortable (Just "foreigners") (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr , sortable (Just "emp-rerouted") (i18nCell MsgTableCompanyNrEmpRerouted) $ \(view resultAllCompanyEmployeeRerouted -> nr) -> wgtCell $ word2widget nr
, sortable (Just "reroute-act") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes -> nr) -> wgtCell $ word2widget nr , sortable (Just "emp-rer-post") (i18nCell MsgTableCompanyNrEmpRerPost) $ \(view resultAllCompanyEmpRerPost -> nr) -> wgtCell $ word2widget nr
, sortable (Just "reroute-all") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes' -> nr) -> wgtCell $ word2widget nr , sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> nr) -> wgtCell $ word2widget nr
, sortable (Just "foreigners") (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
, sortable (Just "reroute-act") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes -> nr) -> wgtCell $ word2widget nr
, sortable (Just "reroute-all") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes' -> nr) -> wgtCell $ word2widget nr
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ singletonMap "name" $ SortColumn (E.^. CompanyName) [ singletonMap "name" $ SortColumn (E.^. CompanyName)
, singletonMap "short" $ SortColumn (E.^. CompanyShorthand) , singletonMap "short" $ SortColumn (E.^. CompanyShorthand)
, singletonMap "avsnr" $ SortColumn (E.^. CompanyAvsId) , singletonMap "avsnr" $ SortColumn (E.^. CompanyAvsId)
, singletonMap "users" $ SortColumn firmCountUsers , singletonMap "users" $ SortColumn firmCountUsers
, singletonMap "supervisors" $ SortColumn firmCountSupervisors , singletonMap "supervisors" $ SortColumn firmCountSupervisors
, singletonMap "reroute-def" $ SortColumn firmCountDefaultReroutes , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
, singletonMap "foreigners" $ SortColumn firmCountForeignSupervisors , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted
, singletonMap "reroute-act" $ SortColumn firmCountActiveReroutes , singletonMap "emp-rer-post" $ SortColumn firmCountEmployeeRerPost
, singletonMap "reroute-all" $ SortColumn firmCountActiveReroutes' , singletonMap "reroute-def" $ SortColumn firmCountDefaultReroutes
, singletonMap "foreigners" $ SortColumn firmCountForeignSupervisors
, singletonMap "reroute-act" $ SortColumn firmCountActiveReroutes
, singletonMap "reroute-all" $ SortColumn firmCountActiveReroutes'
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrCompanyNameNr queryCompany [ single $ fltrCompanyNameNr queryCompany
@ -255,7 +303,7 @@ mkFirmAllTable isAdmin uid = do
[ fltrCompanyNameNrUI mPrev [ fltrCompanyNameNrUI mPrev
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
] ]
dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmAllAction (AForm Handler FirmAllActionData) acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
acts = mconcat acts = mconcat
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData [ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData

4
src/Utils/Icon.hs
View File

@ -153,7 +153,7 @@ iconText = \case
IconSFTHint -> "life-ring" -- for SheetFileType only IconSFTHint -> "life-ring" -- for SheetFileType only
IconSFTSolution -> "exclamation-circle" -- for SheetFileType only IconSFTSolution -> "exclamation-circle" -- for SheetFileType only
IconSFTMarking -> "check-circle" -- for SheetFileType only IconSFTMarking -> "check-circle" -- for SheetFileType only
IconEmail -> "envelope" -- envelope is no longer unamibuous IconEmail -> "envelope" -- envelope is no longer unamibuous, use IconAt or IconLetter if email and postal need to be distinguished
IconRegisterTemplate -> "file-alt" IconRegisterTemplate -> "file-alt"
IconNoCorrectors -> "user-slash" IconNoCorrectors -> "user-slash"
IconRemoveUser -> "user-slash" IconRemoveUser -> "user-slash"
@ -199,7 +199,7 @@ iconText = \case
IconCertificate -> "badge-check" IconCertificate -> "badge-check"
IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk" IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk"
IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well
IconAt -> "at" IconAt -> "at" -- alternative for IconEmail to distinguish from IconLetter
IconSupervisor -> "head-side" -- must be notably different to user IconSupervisor -> "head-side" -- must be notably different to user
-- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something -- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something
IconExpired -> "hourglass-end" IconExpired -> "hourglass-end"