diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 2e97195e8..1e8ecfe7e 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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) diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 8b8911df4..53819d2e4 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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) ] diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 3b8888837..0bca321ac 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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'')