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