fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 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) -> -- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) ->
case criterion of -- case criterion of
Nothing -> E.true -- Nothing -> E.true
(Just (crit::Text)) -> E.exists $ do -- (Just (crit::Text)) -> E.exists $ do
usr <- E.from $ E.table @User -- usr <- E.from $ E.table @User
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.&&. E.exists (do -- ) E.&&. E.exists (do
usrCmp <- E.from $ E.table @UserCompany -- usrCmp <- E.from $ E.table @UserCompany
E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId -- E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
E.&&. (( usrCmp E.^. UserCompanySupervisor -- E.&&. (( usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId -- E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId
) E.||. E.exists (do -- ) E.||. E.exists (do
usrSpr <- E.from $ E.table @UserSupervisor -- usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser -- E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId -- E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
)) -- ))
) -- )
) -- )
, single ("is-supervisor0", mkFilterProjectedPost $ \(getLast -> criterion) dbr -> , single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
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 $ 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 (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_ $ usrCmp E.^. UserCompanyCompany E.==. cmp E.^. CompanyId E.where_ $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
E.&&. (( usrCmp E.^. UserCompanySupervisor E.&&. usrCmp E.^. UserCompanySupervisor
E.&&. usrCmp E.^. UserCompanyUser E.==. usr E.^. UserId 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_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser E.where_ $ usr E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
E.&&. 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.==. 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)
@ -680,9 +683,9 @@ 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-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-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
, prismAForm (singletonFilter "is-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault) , 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 "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)
] ]