fix(firm): supervisor secondary did not work as intended

also, adding company link to secondary supervisors

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.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountUsers        = E.subSelectCount . fromUserCompany Nothing
+firmCountUsers              = E.subSelectCount . fromUserCompany Nothing
 
-firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountUsersPrimary       :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
+firmCountUsersPrimary cmp   = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
   where
-    primFltr usr = E.notExists (do
+    primFltr = E.notExists . usrSuperiorCompanies cmp
-        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
-      )
 
-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
+    primFltr =    E.exists . usrSuperiorCompanies cmp
-        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
-      )
 
 firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
 firmCountSupervisors  = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))

src/Handler/Utils/Company.hs

@@ -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)
+      let isTop  = cmpPrio >= maxPri
-          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

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 :: Bool -> (CompanyShorthand, CompanyName, Bool) -> Widget
-companyWidget (csh, cname, isSupervisor) = simpleLink (toWgt name) curl
+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 --
 ----------

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]