fix(firm): improve supervisor filter by caching
This commit is contained in:
parent
dd5d283f88
commit
88f24fe6f1
@ -227,8 +227,13 @@ explicitUnsafeCoerceSqlExprValue typ (E.ERaw _m1 f1) = E.ERaw E.noMeta $ \_nPare
|
||||
)
|
||||
|
||||
and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
|
||||
and = F.foldl' (E.&&.) true -- we can use foldl' since Postgresql reorders conditions anyway
|
||||
or = F.foldl' (E.||.) false
|
||||
-- and = F.foldl' (E.&&.) true -- we can use foldl' since PostgreSQL reorders conditions anyway
|
||||
-- or = F.foldl' (E.||.) false
|
||||
-- Maybe this help the PostgreSQL query optimizer, though I doubt it?
|
||||
and f | F.null f = true
|
||||
| otherwise = F.foldl1 (E.&&.) f
|
||||
or f | F.null f = false
|
||||
| otherwise = F.foldl1 (E.||.) f
|
||||
|
||||
-- | Given a test and a set of values, check whether anyone succeeds the test
|
||||
-- WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
|
||||
|
||||
@ -468,7 +468,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
-- , cmpy & firmCountActiveReroutes' -- 10
|
||||
)
|
||||
dbtRowKey = (E.^. CompanyId)
|
||||
dbtProj = dbtProjId
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
|
||||
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
|
||||
@ -518,7 +518,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
)
|
||||
)
|
||||
-- THIS WAS WAY TOO SLOW:
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
|
||||
-- (usr :& usrCmp) <- E.from $ E.table @User
|
||||
-- `E.leftJoin` E.table @UserCompany
|
||||
-- `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser)
|
||||
@ -537,45 +537,90 @@ mkFirmAllTable isAdmin uid = do
|
||||
-- )
|
||||
-- )
|
||||
-- )
|
||||
, single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
usr <- E.from $ E.table @User
|
||||
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.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.==. queryAllCompany row 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.==. queryAllCompany row E.^. CompanyId
|
||||
)
|
||||
)
|
||||
)
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
|
||||
-- usr <- E.from $ E.table @User
|
||||
-- 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.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.==. queryAllCompany row 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.==. queryAllCompany row E.^. CompanyId
|
||||
-- )
|
||||
-- )
|
||||
-- )
|
||||
-- )
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
|
||||
-- usr <- E.from $ E.table @User
|
||||
-- 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.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", 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-supervisor2" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
usr <- E.from $ E.table @User
|
||||
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.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 ->
|
||||
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
|
||||
(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
|
||||
))
|
||||
))
|
||||
)
|
||||
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
|
||||
)
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
-- , single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do -- too slow
|
||||
-- (usr :& usrCmp) <- E.from $ E.table @User
|
||||
-- `E.leftJoin` E.table @UserCompany
|
||||
-- `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser)
|
||||
@ -636,8 +681,8 @@ 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-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 "is-supervisor2") 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)
|
||||
]
|
||||
|
||||
@ -769,7 +769,7 @@ dbtProjFilteredPostId :: forall fs r r'.
|
||||
=> ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r'
|
||||
dbtProjFilteredPostId = withFilteredPost dbtProjId'
|
||||
|
||||
-- | Kombination aus `dbtProjFilteredPostId` und `dbtProjSimple`, d.h. Ergeniszeilen in Haskell transformieren und filtern
|
||||
-- | Kombination aus `dbtProjFilteredPostId` und `dbtProjSimple`, d.h. Ergebniszeilen in Haskell transformieren und filtern
|
||||
dbtProjFilteredPostSimple :: forall fs r r' r''.
|
||||
( fs ~ DBTProjFilterPost r', DBRow r'' ~ r' )
|
||||
=> (r -> DB r'')
|
||||
|
||||
Loading…
Reference in New Issue
Block a user