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

fix(firm): supervisor filter

Browse Source
This commit is contained in:
Steffen Jost 2023-12-05 11:52:13 +01:00
parent a15862ea72
commit 3acb847915
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Handler/Firm.hs
View File

@ -507,7 +507,7 @@ mkFirmAllTable isAdmin uid = do
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrCompanyNameNr queryAllCompany [ single $ fltrCompanyNameNr queryAllCompany
, single ("company-number", FilterColumn $ E.mkExactFilterWithComma readMay (queryAllCompany >>> (E.^. CompanyAvsId))) , single ("company-number", FilterColumn $ E.mkExactFilterWithComma readMay (queryAllCompany >>> (E.^. CompanyAvsId)))
, single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do , single ("is-associate" , 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
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser) `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)
@ -517,6 +517,25 @@ mkFirmAllTable isAdmin uid = do
E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion) E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion)
) )
) )
, single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> 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.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.&&. ((E.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.? . UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
E.&& E.exists (do
usrSub <- E.from $ E.table @UserCompany
E.where_ $ usrSub E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
E.&&. usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
)
)
)
)
, single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) -> , single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) ->
-- let checkSuper = do -- expensive -- let checkSuper = do -- expensive
-- usrSpr <- E.from $ E.table @UserSupervisor -- usrSpr <- E.from $ E.table @UserSupervisor
@ -552,6 +571,7 @@ mkFirmAllTable isAdmin uid = do
[ fltrCompanyNameUI mPrev [ fltrCompanyNameUI mPrev
, prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo)
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
, prismAForm (singletonFilter "is-associate") mPrev $ aopt textField (fslI MsgTableCompanyUser)
, 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) , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern)
] ]