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

fix(firm): filtering by active supervisor working

Browse Source
This commit is contained in:
Steffen Jost 2024-09-17 17:59:58 +02:00
parent 78c645cf21
commit 6c9d92475e
3 changed files with 41 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -99,6 +99,7 @@ TableCompanyNrRerouteActive: Aktive Umleitungen
TableRerouteActive: Umleitung TableRerouteActive: Umleitung
TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige
TableSupervisor: Ansprechpartner TableSupervisor: Ansprechpartner
TableSupervisorActive: Aktiver Ansprechpartner
TableSupervisee: Ansprechpartner für TableSupervisee: Ansprechpartner für
TableReason: Begründung TableReason: Begründung
TableCreationTime: Erstellungszeit TableCreationTime: Erstellungszeit

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

@ -99,6 +99,7 @@ TableCompanyNrRerouteActive: Active reroutes
TableRerouteActive: Reroute TableRerouteActive: Reroute
TableCompanyPostalPreference: Default notification preference TableCompanyPostalPreference: Default notification preference
TableSupervisor: Supervisor TableSupervisor: Supervisor
TableSupervisorActive: Active supervisor
TableSupervisee: Supervisor for TableSupervisee: Supervisor for
TableReason: Reason TableReason: Reason
TableCreationTime: Creation TableCreationTime: Creation

69
src/Handler/Firm.hs
View File

@ -440,7 +440,7 @@ mkFirmAllTable isAdmin uid = do
-- , cmpy & firmCountActiveReroutes' -- , cmpy & firmCountActiveReroutes'
) )
dbtRowKey = (E.^. CompanyId) dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjFilteredPostId dbtProj = dbtProjId
dbtColonnade = formColonnade $ mconcat dbtColonnade = formColonnade $ mconcat
[ dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey)) [ dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) -> , sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
@ -569,34 +569,34 @@ mkFirmAllTable isAdmin uid = do
-- )) -- ))
-- ) -- )
-- ) -- )
, ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> -- , ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> -- did not work as intended
case criterion of -- case criterion of
Nothing -> return True :: DB Bool -- Nothing -> return True :: DB Bool
(Just (crit::Text)) -> do -- (Just (crit::Text)) -> do
critFirms <- memcachedBy (Just . Right $ 3 * diffMinute) ("SVR:"<>crit) $ fmap (Set.fromList . fmap E.unValue) $ E.select $ E.distinct $ do -- critFirms <- memcachedBy (Just . Right $ 3 * diffMinute) ("SVR:" <> crit) $ fmap (Set.fromList . fmap E.unValue) $ E.select $ E.distinct $ do
(usr :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @Company -- (usr :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @Company
`E.on` (\(usr :& cmp) -> E.exists (do -- `E.on` (\(usr :& cmp) -> E.exists (do
usrCmp <- E.from $ E.table @UserCompany -- usrCmp <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser -- E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
E.&&. usrCmp E.^. UserCompanySupervisor -- E.&&. usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId -- E.&&. usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
) E.||. E.exists (do -- ) E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor -- usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor -- E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
E.&&. E.exists (do -- E.&&. E.exists (do
usrSub <- E.from $ E.table @UserCompany -- usrSub <- E.from $ E.table @UserCompany
E.where_ $ usrSub E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser -- E.where_ $ usrSub E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
E.&&. usrSub E.^. UserCompanyCompany E.==. cmp E.^. CompanyId -- E.&&. usrSub E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
) -- )
)) -- ))
E.where_ $ (usr E.^. UserDisplayName `E.hasInfix` E.val crit ) -- E.where_ $ (usr E.^. UserDisplayName `E.hasInfix` E.val crit )
E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit)) -- E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit))
E.||. (usr E.^. UserSurname `E.hasInfix` E.val crit ) -- E.||. (usr E.^. UserSurname `E.hasInfix` E.val crit )
-- E.orderBy [E.asc $ cmp E.^. CompanyId] -- -- E.orderBy [E.asc $ cmp E.^. CompanyId]
return $ cmp E.^. CompanyId -- return $ cmp E.^. CompanyId
let cid = dbr ^. resultAllCompanyEntity . _entityKey -- let cid = dbr ^. resultAllCompanyEntity . _entityKey
return $ Set.member cid critFirms -- return $ Set.member cid critFirms
) -- )
-- , ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow -- , ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
-- (usr :& usrCmp) <- E.from $ E.table @User -- (usr :& usrCmp) <- E.from $ E.table @User
-- `E.leftJoin` E.table @UserCompany -- `E.leftJoin` E.table @UserCompany
@ -612,6 +612,15 @@ mkFirmAllTable isAdmin uid = do
-- ) -- )
-- ) -- )
-- ) -- )
, ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
(usr :& _usrSpr :& usrCmp) <- E.from $ E.table @User
`E.innerJoin` E.table @UserSupervisor `E.on` (\(usr :& usrSpr ) -> usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor)
`E.innerJoin` E.table @UserCompany `E.on` (\(_ :& usrSpr :& usrCmp) -> usrCmp E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser)
E.where_ $ ((usr E.^. UserDisplayName `E.hasInfix` E.val criterion)
E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion)
) E.&&. usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
)
, ("is-default-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do , ("is-default-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
(usr :& usrCmp) <- E.from $ E.table @User (usr :& usrCmp) <- E.from $ E.table @User
`E.innerJoin` E.table @UserCompany `E.innerJoin` E.table @UserCompany
@ -669,7 +678,7 @@ mkFirmAllTable isAdmin uid = do
, prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo)
, prismAForm (singletonFilter "is-associate") mPrev $ aopt textField (fslI MsgTableCompanyUser) , prismAForm (singletonFilter "is-associate") mPrev $ aopt textField (fslI MsgTableCompanyUser)
-- , prismAForm (singletonFilter "is-supervisor0") mPrev $ aopt textField (fslI MsgTableSupervisor) -- , prismAForm (singletonFilter "is-supervisor0") mPrev $ aopt textField (fslI MsgTableSupervisor)
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisorActive)
, prismAForm (singletonFilter "is-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault) , prismAForm (singletonFilter "is-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault)
, prismAForm (singletonFilter "foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterForeignSupervisor) , 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 MsgFilterFirmExtern & setTooltip MsgFilterFirmExternTooltip) , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern & setTooltip MsgFilterFirmExternTooltip)