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

chore(firm): filter firm users by primary company

Browse Source 
towards #157
This commit is contained in:
Steffen Jost 2024-06-11 12:04:26 +02:00
parent e6c57035f9
commit ac3271242d
3 changed files with 23 additions and 4 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

@ -48,6 +48,7 @@ FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh
FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
FilterFirmExtern: Externe Firma
FilterFirmPrimary: Ist primäre Firma in FRADrive
FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}

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

@ -48,6 +48,7 @@ FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
FilterForeignSupervisor: Has company-external supervisors
FilterFirmExtern: External company
FilterFirmPrimary: Is primary company in FRADrive
FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
FirmSupervisorIndependent: Independent supervisors
FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users

25
src/Handler/Firm.hs
View File

@ -796,7 +796,7 @@ queryUserUser = $(sqlIJproj 2 1)
queryUserUserCompany :: UserCompanyTableExpr -> E.SqlExpr (Entity UserCompany)
queryUserUserCompany = $(sqlIJproj 2 2)
type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64)
type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64) -- , E.Value Bool)
resultUserUser :: Lens' UserCompanyTableData (Entity User)
resultUserUser = _dbrOutput . _1
@ -810,6 +810,9 @@ resultUserCompanySupervisors = _dbrOutput . _3 . _unValue
resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64
resultUserCompanyReroutes = _dbrOutput . _4 . _unValue
-- resultUserCompanyPrimary :: Lens' UserCompanyTableData Bool
-- resultUserCompanyPrimary = _dbrOutput . _5 . _unValue
instance HasEntity UserCompanyTableData User where
hasEntity = resultUserUser
@ -837,20 +840,24 @@ 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
-- supervisorField = selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers
supervisorsField = multiSelectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers
fsh = unCompanyKey cid
resultDBTable = DBTable{..}
where
dbtSQLQuery = \(usr `E.InnerJoin` usrCmp) -> do
EL.on $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
E.where_ $ usrCmp E.^. UserCompanyCompany E.==. E.val cid
-- let isPrimary = E.notExists (do
-- other <- E.from $ E.table @UserCompany
-- E.where_ $ other E.^. UserCompanyUser E.==. usrCmp E.^. UserCompanyUser
-- E.&&. other E.^. UserCompanyPriority E.>. usrCmp E.^. UserCompanyPriority
-- )
return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp)
dbtRowKey = queryUserUser >>> (E.^. UserId)
dbtProj = dbtProjId
@ -928,15 +935,25 @@ mkFirmUserTable isAdmin cid = do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
E.&&. usrSpr E.^. UserSupervisorSupervisor `E.in_` E.vals criteria
, singletonMap "is-primary-company" $ FilterColumn $ \row (getLast -> criterion) ->
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
in case criterion of
Nothing -> E.true
Just False -> E.exists checkPrimary
Just True -> E.notExists checkPrimary
]
-- superField = selectField $ ????
dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
-- , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor)
, prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip)
, prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
, prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
, prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
, prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
, prismAForm (singletonFilter "is-primary-company" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmPrimary)
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmUserAction (AForm Handler FirmUserActionData)