chore(firm): improve efficiency of foreign supervisor filter
This commit is contained in:
parent
ce45d26a21
commit
f36f234c42
@ -248,7 +248,7 @@ addDefaultSupervisors cid employees = do
|
||||
(spr :& usr) <- E.from $ E.table @UserCompany `E.crossJoin` E.toValues employees
|
||||
E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. spr E.^. UserCompanySupervisor
|
||||
return $ UserSupervisor
|
||||
E.distinct $ return $ UserSupervisor
|
||||
E.<# (spr E.^. UserCompanyUser)
|
||||
E.<&> usr
|
||||
E.<&> (spr E.^. UserCompanySupervisorReroute)
|
||||
@ -272,7 +272,7 @@ addDefaultSupervisorsFor mbSuperId mutualSupervision cids = do
|
||||
, spr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
, usr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
]
|
||||
return $ UserSupervisor
|
||||
E.distinct $ return $ UserSupervisor
|
||||
E.<# (spr E.^. UserCompanyUser)
|
||||
E.<&> (usr E.^. UserCompanyUser)
|
||||
E.<&> (spr E.^. UserCompanySupervisorReroute)
|
||||
@ -291,7 +291,7 @@ addDefaultSupervisorsAll mutualSupervision cids = do
|
||||
, spr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
, usr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
]
|
||||
return $ UserSupervisor
|
||||
E.distinct $ return $ UserSupervisor
|
||||
E.<# (spr E.^. UserCompanyUser)
|
||||
E.<&> (usr E.^. UserCompanyUser)
|
||||
E.<&> (spr E.^. UserCompanySupervisorReroute)
|
||||
@ -541,7 +541,7 @@ mkFirmAllTable isAdmin uid = 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.||. (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
|
||||
@ -549,7 +549,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
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.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
|
||||
@ -559,20 +559,37 @@ mkFirmAllTable isAdmin uid = do
|
||||
)
|
||||
)
|
||||
, single ("is-supervisor2" , 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)
|
||||
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.isTrue (usrCmp E.?. UserCompanySupervisor) E.&&. usrCmp E.?. UserCompanyCompany E.?=. queryAllCompany row E.^. CompanyId)
|
||||
E.||. E.exists (do
|
||||
(usrSpr :& usrSub) <- E.from $ E.table @UserSupervisor `E.innerJoin` E.table @UserCompany `E.on` (\(usrSpr :& usrSub) -> usrSpr E.^. UserSupervisorUser E.==. usrSub E.^. UserCompanyUser)
|
||||
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
|
||||
E.&&. usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
|
||||
)
|
||||
-- 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 . 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 :& usrSub) <- E.from $ E.table @UserSupervisor `E.innerJoin` E.table @UserCompany `E.on` (\(usrSpr :& usrSub) -> usrSpr E.^. UserSupervisorUser E.==. usrSub E.^. UserCompanyUser)
|
||||
-- E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
|
||||
-- E.&&. usrSub E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
|
||||
-- )
|
||||
-- )
|
||||
-- )
|
||||
, single ("is-default-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
(usr :& usrCmp) <- E.from $ E.table @User
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
@ -618,9 +635,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-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
|
||||
, prismAForm (singletonFilter "is-supervisor2") mPrev $ aopt textField (fslI MsgTableSupervisor) -- TODO: remove either one variant which works worse
|
||||
, prismAForm (singletonFilter "is-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault)
|
||||
, 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)
|
||||
]
|
||||
|
||||
@ -137,7 +137,7 @@ cacheStudyFeatureRelevance fFilter = do
|
||||
E.on E.true
|
||||
E.where_ $ fFilter studyFeatures
|
||||
E.where_ $ isRelevantStudyFeature (E.val now) TermId term studyFeatures
|
||||
return $ RelevantStudyFeatures E.<# (term E.^. TermId) E.<&> (studyFeatures E.^. StudyFeaturesId)
|
||||
E.distinct $ return $ RelevantStudyFeatures E.<# (term E.^. TermId) E.<&> (studyFeatures E.^. StudyFeaturesId)
|
||||
)
|
||||
( \_current _excluded -> [] )
|
||||
|
||||
|
||||
@ -11,8 +11,9 @@ import "uniworx" Import hiding (Option(..), currentYear)
|
||||
import qualified Data.Text.Encoding as TEnc
|
||||
import qualified Yesod.Auth.Util.PasswordStore as PWStore
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.List as List
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Utils.Holidays
|
||||
|
||||
@ -494,6 +495,15 @@ fillDb = do
|
||||
, "Mark", "Paul", "Steven", "Andrew"
|
||||
, "Kenneth", "Joshua", "George", "Kevin"
|
||||
, "Brian", "Edward", "Susan", "Ronald"
|
||||
, "Nico", "Pascal", "Danielle", "Brendon"
|
||||
, "Winston", "Luke", "Jeff", "Ben"
|
||||
, "Asis", "Janika", "Claudio", "Frank"
|
||||
, "Anna", "Ivo", "Merlin", "Fabienne"
|
||||
, "Angela", "Alissa", "Fredrik", "Sharlee"
|
||||
, "René", "Tuval", "Dom", "Fabian"
|
||||
, "Steve", "Bruce", "Adrian", "Nicko"
|
||||
, "Joakim", "Ylva", "Mats", "Emil"
|
||||
, "Angus", "Seeb", "Thalia", "Manu"
|
||||
]
|
||||
surnames = [ "Smith", "Johnson", "Williams", "Brown"
|
||||
, "Jones", "Miller", "Davis", "Garcia"
|
||||
@ -503,15 +513,17 @@ fillDb = do
|
||||
, "Lopez", "Lee", "Gonzalez", "Harris"
|
||||
, "Clark", "Lewis", "Robinson", "Walker"
|
||||
, "Perez", "Hall", "Young", "Allen"
|
||||
, "Loomis", "Amott", "Gluz", "Erlandsson"
|
||||
, "Glanzmann", "Murphy", "Henzi", "Sutter"
|
||||
, "Nasseri", "Wolf", "Quarta", "Fuhrmann"
|
||||
, "McCall", "Kilpatrick", "Ling", "Gordon"
|
||||
, "Sallach", "Ratajczak", "Friedrich", "Schillo"
|
||||
, "Völkl", "Dahn", "Berthiaume", "Crey"
|
||||
, "Murray", "Dickinson", "McBrain", "Gers"
|
||||
, "Nilsson", "Eriksson", "Fehrm", "Grahn"
|
||||
, "Winkler", "Levermann", "Bellazecca", "Lotter"
|
||||
]
|
||||
middlenames = [ Nothing, Just "Jamesson" ]
|
||||
toMatrikel :: [Int] -> [Text]
|
||||
toMatrikel ns
|
||||
| (cs, rest) <- splitAt 8 ns
|
||||
, length cs == 8
|
||||
= foldMap tshow cs : toMatrikel rest
|
||||
| otherwise
|
||||
= []
|
||||
middlenames = [ Nothing, Just "Jamesson", Just "Theresa", Just "Ally", Just "Tiberius", Just "Maria" ]
|
||||
manyUser (firstName, middleName, userSurname) userMatrikelnummer' = User
|
||||
{ userIdent
|
||||
, userAuthentication = AuthLDAP
|
||||
@ -571,8 +583,16 @@ fillDb = do
|
||||
"Clark" -> "E" <> userMatrikelnummer' <> "@fraport.de"
|
||||
"Jackson" -> ""
|
||||
_ -> userIdent
|
||||
|
||||
matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
|
||||
-- toMatrikel :: [Int] -> [Text]
|
||||
-- toMatrikel ns
|
||||
-- | (cs, rest) <- splitAt 10 ns
|
||||
-- , length cs == 10
|
||||
-- = foldMap tshow cs : toMatrikel rest
|
||||
-- | otherwise
|
||||
-- = []
|
||||
-- matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
|
||||
baseMatrikel <- getRandomR (10000 :: Int, 999999 :: Int)
|
||||
let matrikel = tshow <$> [baseMatrikel..] List.\\ [6969, 669966, 996699]
|
||||
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
|
||||
matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
|
||||
insertMany_ [UserAvs (AvsPersonId n) uid n now Nothing | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
|
||||
@ -630,6 +650,11 @@ fillDb = do
|
||||
ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing $ Just "gcs@gcs.com"
|
||||
bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing Nothing
|
||||
_noone <- insert' $ Company "Vollautomaten GmbH" "NoOne" 3 True Nothing Nothing
|
||||
randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing | n <- [1001..2002]
|
||||
, let neven = even n
|
||||
, let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
|
||||
, let rcShort = CI.mk $ "RC" <> tshow n
|
||||
]
|
||||
void . insert' $ UserCompany jost fraportAg True True
|
||||
void . insert' $ UserCompany svaupel nice True False
|
||||
void . insert' $ UserCompany gkleen nice False False
|
||||
@ -642,6 +667,13 @@ fillDb = do
|
||||
insertMany_ [UserCompany uid bpol False False| Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
|
||||
insertMany_ [UserCompany uid bpol True True| Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
|
||||
insertMany_ [UserCompany uid ffacil False False| Entity uid User{userSurname = "Walker"} <- matUsers]
|
||||
insertMany_ [UserCompany uid rckey issuper False
|
||||
| rckey <- randComps
|
||||
, Just n <- [readMay $ drop 2 $ unpack $ CI.original $ unCompanyKey rckey]
|
||||
, Entity uid User{userSurname = uSurname} <- take (n `div` 20) $ drop (2*n) matUsers
|
||||
, uSurname /= "Jackson", uSurname /= "Lee"
|
||||
, let issuper = uSurname == "Wolf"
|
||||
]
|
||||
-- void . insert' $ UserSupervisor jost gkleen True
|
||||
-- void . insert' $ UserSupervisor jost svaupel False
|
||||
-- void . insert' $ UserSupervisor jost sbarth False
|
||||
@ -661,9 +693,9 @@ fillDb = do
|
||||
, UserSupervisor gkleen gkleen True
|
||||
, UserSupervisor tinaTester tinaTester False
|
||||
]
|
||||
++ take 333 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers, uid /= jost]
|
||||
++ take 111 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 300 matUsers ]
|
||||
++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 401 matUsers ]
|
||||
++ take 444 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers, uid /= jost]
|
||||
++ take 123 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 369 matUsers ]
|
||||
++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 501 matUsers ]
|
||||
upsertManyWhere supvs [] [] []
|
||||
-- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok
|
||||
-- insertMany_ supvs -- NOTE: multiple calls like this throw an error!
|
||||
|
||||
Reference in New Issue
Block a user