fraport/fradrive
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
TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige
TableSupervisor: Ansprechpartner
TableSupervisorActive: Aktiver Ansprechpartner
TableSupervisee: Ansprechpartner für
TableReason: Begründung
TableCreationTime: Erstellungszeit

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

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

69
src/Handler/Firm.hs
View File

@ -440,7 +440,7 @@ mkFirmAllTable isAdmin uid = do
-- , cmpy & firmCountActiveReroutes'
)
dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjFilteredPostId
dbtProj = dbtProjId
dbtColonnade = formColonnade $ mconcat
[ dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
@ -569,34 +569,34 @@ mkFirmAllTable isAdmin uid = do
-- ))
-- )
-- )
, ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
case criterion of
Nothing -> return True :: DB Bool
(Just (crit::Text)) -> 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
`E.on` (\(usr :& cmp) -> E.exists (do
usrCmp <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
E.&&. usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
) E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
E.&&. E.exists (do
usrSub <- E.from $ E.table @UserCompany
E.where_ $ usrSub E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
E.&&. usrSub E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
)
))
E.where_ $ (usr E.^. UserDisplayName `E.hasInfix` E.val crit )
E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit))
E.||. (usr E.^. UserSurname `E.hasInfix` E.val crit )
-- E.orderBy [E.asc $ cmp E.^. CompanyId]
return $ cmp E.^. CompanyId
let cid = dbr ^. resultAllCompanyEntity . _entityKey
return $ Set.member cid critFirms
)
-- , ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> -- did not work as intended
-- case criterion of
-- Nothing -> return True :: DB Bool
-- (Just (crit::Text)) -> 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
-- `E.on` (\(usr :& cmp) -> E.exists (do
-- usrCmp <- E.from $ E.table @UserCompany
-- E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
-- E.&&. usrCmp E.^. UserCompanySupervisor
-- E.&&. usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
-- ) E.||. E.exists (do
-- usrSpr <- E.from $ E.table @UserSupervisor
-- E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
-- E.&&. E.exists (do
-- usrSub <- E.from $ E.table @UserCompany
-- E.where_ $ usrSub E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
-- E.&&. usrSub E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
-- )
-- ))
-- E.where_ $ (usr E.^. UserDisplayName `E.hasInfix` E.val crit )
-- E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk crit))
-- E.||. (usr E.^. UserSurname `E.hasInfix` E.val crit )
-- -- E.orderBy [E.asc $ cmp E.^. CompanyId]
-- return $ cmp E.^. CompanyId
-- let cid = dbr ^. resultAllCompanyEntity . _entityKey
-- return $ Set.member cid critFirms
-- )
-- , ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
-- (usr :& usrCmp) <- E.from $ E.table @User
-- `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
(usr :& usrCmp) <- E.from $ E.table @User
`E.innerJoin` E.table @UserCompany
@ -669,7 +678,7 @@ mkFirmAllTable isAdmin uid = do
, prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo)
, prismAForm (singletonFilter "is-associate") mPrev $ aopt textField (fslI MsgTableCompanyUser)
-- , 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 "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)