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

fix(firm): improve supervisor filter yet once more

Browse Source
This commit is contained in:
Steffen Jost 2023-12-20 09:02:10 +01:00
parent 88f24fe6f1
commit c7b5a3c6cb
1 changed files with 37 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
src/Handler/Firm.hs
View File

@ -575,43 +575,46 @@ mkFirmAllTable isAdmin uid = do
-- ))
-- )
-- )
, single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) ->
case criterion of
Nothing -> E.true
(Just (crit::Text)) -> E.exists $ do
usr <- E.from $ E.table @User
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.&&. E.exists (do
usrCmp <- E.from $ E.table @UserCompany
E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
E.&&. (( usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId
) E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
))
)
)
, single ("is-supervisor0", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
-- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) ->
-- case criterion of
-- Nothing -> E.true
-- (Just (crit::Text)) -> E.exists $ do
-- usr <- E.from $ E.table @User
-- 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.&&. E.exists (do
-- usrCmp <- E.from $ E.table @UserCompany
-- E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
-- E.&&. (( usrCmp E.^. UserCompanySupervisor
-- E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId
-- ) E.||. E.exists (do
-- usrSpr <- E.from $ E.table @UserSupervisor
-- E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
-- E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-- ))
-- )
-- )
, single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
case criterion of
Nothing -> return True :: DB Bool
(Just (crit::Text)) -> do
critFirms <- memcachedBy (Just . Right $ 15 * diffMinute) ("svr:"<>crit) $ fmap (Set.fromAscList . fmap E.unValue) $ E.select $ E.distinct $ do
critFirms <- memcachedBy (Just . Right $ 5 * diffMinute) ("svr:"<>crit) $ fmap (Set.fromAscList . 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_ $ usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId
E.&&. (( usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId
) E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
))
))
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)
@ -680,9 +683,9 @@ mkFirmAllTable isAdmin uid = do
[ fltrCompanyNameUI mPrev
, 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-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault)
, prismAForm (singletonFilter "is-supervisor0") mPrev $ aopt textField (fslI MsgTableSupervisor)
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
, 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)
]