diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index d5d092777..d6d4c28e2 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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)) diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index 84bcf76e3..d82adf69f 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -40,16 +40,16 @@ wgtCompanies = \uid -> do ^{c} $forall c <- otherCmp

- #{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 diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs index 6861e6e32..ef9366550 100644 --- a/src/Handler/Utils/Widgets.hs +++ b/src/Handler/Utils/Widgets.hs @@ -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 -- ---------- diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index b12eab167..e926c4dcb 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -108,7 +108,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

_{MsgCompanyPersonalNumber} ^{usrAutomatic CU_UA_UserCompanyPersonalNumber}
- #{companyPersonalNumber} + #{companyPersonalNumber} $maybe compWgt <- companies
_{MsgCompany} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index a0b3602e3..25e7baf98 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -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]