fix(firm): supervisor secondary did not work as intended
also, adding company link to secondary supervisors
This commit is contained in:
parent
45bc5ca9f5
commit
d4f3ce7bf3
@ -325,34 +325,33 @@ addDefaultSupervisorsAll mutualSupervision cids = do
|
||||
------------------------------
|
||||
-- repeatedly useful queries
|
||||
|
||||
usrSuperiorCompanies :: E.SqlExpr (Entity Company) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery ()
|
||||
-- usrSuperiorCompanies :: E.SqlExpr (E.Value CompanyId) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery (Entity UserCompany) -- possible alternative
|
||||
usrSuperiorCompanies cmp usr = do
|
||||
othr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
|
||||
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
|
||||
E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving
|
||||
-- return othr
|
||||
|
||||
fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery ()
|
||||
fromUserCompany mbFltr cmpy = do
|
||||
usrCmpy <- E.from $ E.table @UserCompany
|
||||
let basecond = usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
|
||||
E.where_ $ maybe basecond ((basecond E.&&.).($ usrCmpy)) mbFltr
|
||||
|
||||
firmCountUsers :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsers = E.subSelectCount . fromUserCompany Nothing
|
||||
firmCountUsers :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsers = E.subSelectCount . fromUserCompany Nothing
|
||||
|
||||
firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
|
||||
firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
|
||||
where
|
||||
primFltr usr = E.notExists (do
|
||||
othr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
|
||||
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
|
||||
E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving
|
||||
)
|
||||
primFltr = E.notExists . usrSuperiorCompanies cmp
|
||||
|
||||
firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUsersSecondary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
|
||||
where
|
||||
primFltr usr = E.exists (do
|
||||
othr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
|
||||
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
|
||||
E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving
|
||||
)
|
||||
primFltr = E.exists . usrSuperiorCompanies cmp
|
||||
|
||||
firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
|
||||
|
||||
@ -40,16 +40,16 @@ wgtCompanies = \uid -> do
|
||||
^{c}
|
||||
$forall c <- otherCmp
|
||||
<p>
|
||||
#{c}
|
||||
^{c}
|
||||
|]
|
||||
return $ toMaybe (notNull topCmp) resWgt
|
||||
where
|
||||
procCmp _ [] = (0, [],[])
|
||||
procCmp _ [] = (0, [], [])
|
||||
procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
|
||||
let cmpWgt = companyWidget (cmpSh, cmpName, cmpSpr)
|
||||
isTop = cmpPrio >= maxPri
|
||||
let isTop = cmpPrio >= maxPri
|
||||
cmpWgt = companyWidget isTop (cmpSh, cmpName, cmpSpr)
|
||||
(accPri,accTop,accRem) = procCmp maxPri cs
|
||||
in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpName : accRem) accRem isTop) -- lazy evaluation after repmin example
|
||||
in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpWgt : accRem) accRem isTop) -- lazy evaluation after repmin example, don't factor out the bool!
|
||||
|
||||
-- TODO: use this function in company view Handler.Firm #157
|
||||
-- | add all company supervisors for a given users
|
||||
|
||||
@ -141,15 +141,20 @@ modalAccess wdgtNo wdgtYes writeAccess route = do
|
||||
else wdgtNo
|
||||
|
||||
-- also see Handler.Utils.Table.Cells.companyCell
|
||||
companyWidget :: (CompanyShorthand, CompanyName, Bool) -> Widget
|
||||
companyWidget (csh, cname, isSupervisor) = simpleLink (toWgt name) curl
|
||||
companyWidget :: Bool -> (CompanyShorthand, CompanyName, Bool) -> Widget
|
||||
companyWidget isPrimary (csh, cname, isSupervisor)
|
||||
| isPrimary, isSupervisor = simpleLink (toWgt $ name <> iconSupervisor) curl
|
||||
| isPrimary = simpleLink (toWgt name ) curl
|
||||
| isSupervisor = toWgt name <> simpleLink (toWgt iconSupervisor) curl
|
||||
| otherwise = toWgt name
|
||||
where
|
||||
curl = FirmUsersR csh
|
||||
corg = ciOriginal cname
|
||||
name
|
||||
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||
| isSupervisor = text2markup (corg <> " ")
|
||||
| otherwise = text2markup corg
|
||||
|
||||
|
||||
----------
|
||||
-- HEAT --
|
||||
----------
|
||||
|
||||
@ -108,7 +108,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<dt .deflist__dt>
|
||||
_{MsgCompanyPersonalNumber} ^{usrAutomatic CU_UA_UserCompanyPersonalNumber}
|
||||
<dd .deflist__dd>
|
||||
#{companyPersonalNumber}
|
||||
#{companyPersonalNumber}
|
||||
$maybe compWgt <- companies
|
||||
<dt .deflist__dt>
|
||||
_{MsgCompany}
|
||||
|
||||
@ -656,12 +656,18 @@ fillDb = do
|
||||
, let rcShort = CI.mk $ "RC" <> tshow n
|
||||
]
|
||||
void . insert' $ UserCompany jost fraportAg True True 0 False
|
||||
void . insert' $ UserCompany svaupel nice True False 0 False
|
||||
void . insert' $ UserCompany svaupel nice True False 2 False
|
||||
void . insert' $ UserCompany svaupel ffacil False False 1 False
|
||||
void . insert' $ UserCompany svaupel bpol True False 2 False
|
||||
void . insert' $ UserCompany svaupel fraGround True False 1 False
|
||||
void . insert' $ UserCompany gkleen nice False False 1 True
|
||||
void . insert' $ UserCompany gkleen fraGround False True 2 False
|
||||
void . insert' $ UserCompany gkleen bpol False True 1 False
|
||||
void . insert' $ UserCompany fhamann bpol False False 1 True
|
||||
void . insert' $ UserCompany fhamann ffacil True True 2 True
|
||||
void . insert' $ UserCompany fhamann nice False False 3 False
|
||||
void . insert' $ UserCompany sbarth nice False False 3 False
|
||||
void . insert' $ UserCompany sbarth bpol True True 1 True
|
||||
-- need more tests
|
||||
insertMany_ [UserCompany uid fraGround False False 0 True | Entity uid User{userFirstName = "John"} <- matUsers]
|
||||
insertMany_ [UserCompany uid bpol False False 0 False | Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user