chore(firm): add columns and filters and refactor some

messages/uniworx/categories/firm/de-de-formal.msg

@@ -28,4 +28,6 @@ FilterFirmExtern: Externe Firma
 FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
 FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
 FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
-NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
+NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
+TableIsDefaultSupervisor: Standardansprechpartner
+TableIsDefaultReroute: Standardumleitung

messages/uniworx/categories/firm/en-eu.msg

@@ -28,4 +28,6 @@ FilterFirmExtern: External company
 FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
 FirmSupervisorIndependent: Independent supervisors
 FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
-NoCompanySelected: Select at least one company, please.
+NoCompanySelected: Select at least one company, please.
+TableIsDefaultSupervisor: Default supervisor
+TableIsDefaultReroute: Default reroute

src/Handler/Firm.hs

@@ -41,6 +41,11 @@ import Database.Esqueleto.Utils.TH
 single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
+decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
+decryptUser = decrypt 
+
+encryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m CryptoUUIDUser
+encryptUser = encrypt 
 
 ---------------------------
 -- Firm specific utilities
@@ -90,6 +95,120 @@ addDefaultSupervisorsAll mutualSupervision cids = do
     (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
 
 
+------------------------------
+-- repeatedly useful queries
+
+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
+
+firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountSupervisors  = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
+-- firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+-- firmCountSupervisors cmpy = E.subSelectCount $ E.distinct $ do
+--   usrCmpy <- E.from $ E.table @UserCompany
+--   E.where_ $ (usrCmpy E.^. UserCompanyCompany    E.==. cmpy E.^. CompanyId)
+--       E.&&.  (usrCmpy E.^. UserCompanySupervisor E.==. E.true)
+--   return $ usrCmpy E.^. UserCompanyUser
+
+firmHasSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
+firmHasSupervisors  = E.exists . fromUserCompany (Just (E.^. UserCompanySupervisor))
+
+
+firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))
+
+firmHasDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
+firmHasDefaultReroutes = E.exists . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))
+
+firmCountEmployeeSupervised :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany (Just fltr)
+  where
+    fltr :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)
+    fltr usrc = E.exists $ do
+      usrSuper <- E.from $ E.table @UserSupervisor
+      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
+
+firmCountEmployeeRerouted :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany (Just fltr)
+  where   
+    fltr usrc = E.exists $ do
+      usrSuper <- E.from $ E.table @UserSupervisor
+      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
+        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications
+
+firmCountEmployeeRerPost :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountEmployeeRerPost = E.subSelectCount . fromUserCompany (Just fltr)
+  where 
+    fltr usrc = E.exists $ do
+      (usrSuper :& usr) <-
+        E.from $ E.table @UserSupervisor
+        `E.innerJoin` E.table @User
+        `E.on` (\(usrSuper :& usr) -> usrSuper E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
+      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
+        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications
+        E.&&.              usr E.^. UserPrefersPostal
+        E.&&.    E.isJust (usr E.^. UserPostAddress)
+
+
+-- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+-- firmCountForeignSupervisors cmpy = E.coalesceDefault
+--   [E.subSelect $ do
+--     usrSuper <- E.from $ E.table @UserSupervisor
+--     E.groupBy (usrSuper E.^. UserSupervisorSupervisor)
+--     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
+--       E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
+--     return E.countRows
+--   ] (E.val 0)
+
+firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do
+    usrSuper <- E.from $ E.table @UserSupervisor
+    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
+      E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
+    pure $ usrSuper E.^. UserSupervisorSupervisor
+
+-- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+-- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do
+--     usrSuper <- E.from $ E.table @UserSupervisor
+--     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
+--       E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
+--     pure $ usrSuper E.^. UserSupervisorSupervisor
+
+firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountActiveReroutes cmpy = E.subSelectCount $ do
+    usrSuper <- E.from $ E.table @UserSupervisor
+    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
+      E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
+
+firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
+firmQuerySupervisedBy cid mbFltr usr = do
+    (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor
+                      `E.innerJoin` E.table @UserCompany
+                      `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
+    let basecond = usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
+            E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
+    E.where_ $ maybe basecond ((basecond E.&&.).($ usrSpr)) mbFltr
+
+firmCountForSupervisor :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Word64)
+firmCountForSupervisor = ((E.subSelectCount .) .) . firmQuerySupervisedBy
+
+firmCountUserSupervisors :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
+firmCountUserSupervisors usrCmp = E.subSelectCount $ do
+  usrSpr <- E.from $ E.table @UserSupervisor
+  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
+  
+firmCountUserSupervisorsReroute :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
+firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do
+  usrSpr <- E.from $ E.table @UserSupervisor
+  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
+      E.&&.  usrSpr E.^. UserSupervisorRerouteNotifications
+
 
 ------------------
 -- Debug Handler
@@ -190,95 +309,6 @@ resultAllCompanyDefaultReroutes   :: Lens' AllCompanyTableData Bool
 resultAllCompanyDefaultReroutes   = _dbrOutput . _4 . _unValue
 
 
-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
-
-firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountSupervisors  = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
--- firmCountSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
--- firmCountSupervisors cmpy = E.subSelectCount $ E.distinct $ do
---   usrCmpy <- E.from $ E.table @UserCompany
---   E.where_ $ (usrCmpy E.^. UserCompanyCompany    E.==. cmpy E.^. CompanyId)
---       E.&&.  (usrCmpy E.^. UserCompanySupervisor E.==. E.true)
---   return $ usrCmpy E.^. UserCompanyUser
-
-firmHasSupervisors  :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
-firmHasSupervisors  = E.exists . fromUserCompany (Just (E.^. UserCompanySupervisor))
-
-
-firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))
-
-firmHasDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool)
-firmHasDefaultReroutes = E.exists . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute))
-
-firmCountEmployeeSupervised :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany (Just fltr)
-  where
-    fltr :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)
-    fltr usrc = E.exists $ do
-      usrSuper <- E.from $ E.table @UserSupervisor
-      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
-
-firmCountEmployeeRerouted :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany (Just fltr)
-  where   
-    fltr usrc = E.exists $ do
-      usrSuper <- E.from $ E.table @UserSupervisor
-      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
-        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications
-
-firmCountEmployeeRerPost :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountEmployeeRerPost = E.subSelectCount . fromUserCompany (Just fltr)
-  where 
-    fltr usrc = E.exists $ do
-      (usrSuper :& usr) <-
-        E.from $ E.table @UserSupervisor
-        `E.innerJoin` E.table @User
-        `E.on` (\(usrSuper :& usr) -> usrSuper E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
-      E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
-        E.&&.    usrSuper E.^. UserSupervisorRerouteNotifications
-        E.&&.              usr E.^. UserPrefersPostal
-        E.&&.    E.isJust (usr E.^. UserPostAddress)
-
-
--- firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
--- firmCountForeignSupervisors cmpy = E.coalesceDefault
---   [E.subSelect $ do
---     usrSuper <- E.from $ E.table @UserSupervisor
---     E.groupBy (usrSuper E.^. UserSupervisorSupervisor)
---     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
---       E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
---     return E.countRows
---   ] (E.val 0)
-
-firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do
-    usrSuper <- E.from $ E.table @UserSupervisor
-    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
-      E.&&.  E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy)
-    pure $ usrSuper E.^. UserSupervisorSupervisor
-
--- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
--- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do
---     usrSuper <- E.from $ E.table @UserSupervisor
---     E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
---       E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
---     pure $ usrSuper E.^. UserSupervisorSupervisor
-
-firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-firmCountActiveReroutes cmpy = E.subSelectCount $ do
-    usrSuper <- E.from $ E.table @UserSupervisor
-    E.where_ $  E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser)       cmpy)
-      E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
-
-
 mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
 mkFirmAllTable isAdmin uid = do
   -- now <- liftIO getCurrentTime
@@ -438,17 +468,18 @@ postFirmAllR = do
   formResult firmRes $ \case    
     (_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
 
-    (FirmAllActResetSupervisionData{..}, fids) -> runDB $  do
+    (FirmAllActResetSupervisionData{..}, fids) -> do
-      delSupers <- if firmAllActResetKeepOldSupers == Just False
+      runDB $ do
-        then E.deleteCount $ do
+        delSupers <- if firmAllActResetKeepOldSupers == Just False
-              spr <- E.from $ E.table @UserSupervisor
+          then E.deleteCount $ do
-              E.where_ $ E.exists $ do
+                spr <- E.from $ E.table @UserSupervisor
-                usr <- E.from $ E.table @UserCompany
+                E.where_ $ E.exists $ do
-                E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
+                  usr <- E.from $ E.table @UserCompany
-                    E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
+                  E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
-        else return 0 
+                      E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
-      newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids 
+          else return 0 
-      addMessageI Info $ MsgFirmResetSupervision newSupers delSupers
+        newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids 
+        addMessageI Info $ MsgFirmResetSupervision newSupers delSupers
       reloadKeepGetParams FirmAllR -- reload to reflect changes
 
     (FirmAllActNotifyData          , Set.toList -> fids) -> do
@@ -508,20 +539,23 @@ instance HasUser UserCompanyTableData where
   hasUser = resultUserUser . _entityVal
 
 
-firmCountUserSupervisors :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
-firmCountUserSupervisors usrCmp = E.subSelectCount $ do
-  usrSpr <- E.from $ E.table @UserSupervisor
-  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
-  
-firmCountUserSupervisorsReroute :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
-firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do
-  usrSpr <- E.from $ E.table @UserSupervisor
-  E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
-      E.&&.  usrSpr E.^. UserSupervisorRerouteNotifications
-
 mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set UserId), Widget)
 mkFirmUserTable isAdmin cid = do
   let
+    mkSprOption (E.Value uid, E.Value udn) = do
+      uuid <- toPathPiece <$> encryptUser uid
+      return Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }
+    procOptions = fmap mkOptionList . traverse mkSprOption
+
+  rawSupers <- E.select $ do 
+    usr <- E.from $ E.table @User
+    E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
+    return (usr E.^. UserId, usr E.^. UserDisplayName)
+  let
+    -- supervisorField :: Field Handler UserId
+    supervisorField  =      selectField $ procOptions rawSupers
+    supervisorsField = multiSelectField $ procOptions rawSupers
+
     fsh = unCompanyKey cid
     resultDBTable = DBTable{..}
       where
@@ -586,11 +620,30 @@ mkFirmUserTable isAdmin cid = do
                   Nothing     -> E.true
                   Just True   -> E.exists    checkSuper
                   Just False  -> E.notExists checkSuper
+          , singletonMap "supervisor-is" $ FilterColumn $ \row (getLast -> criterion) ->
+              case criterion of 
+                Just uid -> do 
+                  -- uid <- decryptUser uuid
+                  E.exists $ do 
+                    usrSpr <- E.from $ E.table @UserSupervisor
+                    E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
+                        E.&&.  usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid
+                _otherwise -> E.true
+          , singletonMap "supervisors-are" $ FilterColumn $ \row criteria ->
+              case criteria of 
+                _ | Set.null criteria -> E.true
+                  | otherwise -> do
+                      -- uids <- traverse decryptUser criteria
+                      E.exists $ do 
+                        usrSpr <- E.from $ E.table @UserSupervisor
+                        E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
+                            E.&&.  usrSpr E.^. UserSupervisorSupervisor `E.in_` E.vals criteria
           ]
         -- superField = selectField $ ????
         dbtFilterUI mPrev = mconcat
           [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
-          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTableTerm)
+          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField)  (fslI MsgFilterSupervisor)
+          -- , prismAForm (multiFilter     "supervisors-are" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor)
           , prismAForm (singletonFilter "has-supervisor"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
           , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
           , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
@@ -694,12 +747,18 @@ data FirmSuperActionData = FirmSuperActNotifyData
                          | FirmSuperActRMSuperAllData
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
-type SuperCompanyTableExpr = E.SqlExpr (Entity User)
+type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany))
 
 querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
-querySuperUser = id
+querySuperUser = $(sqlLOJproj 2 1)
 
-type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64, [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)])
+querySuperUserCompany :: SuperCompanyTableExpr -> E.SqlExpr (Maybe (Entity UserCompany))
+querySuperUserCompany = $(sqlLOJproj 2 2)
+
+type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64
+                                    , [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
+                                    , E.Value (Maybe Bool), E.Value (Maybe Bool)   -- Maybe (Entity UserCompany)
+                                    )
 
 resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
 resultSuperUser = _dbrOutput . _1 
@@ -713,6 +772,11 @@ resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue
 resultSuperCompanies :: Lens' SuperCompanyTableData [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
 resultSuperCompanies = _dbrOutput . _4
 
+resultSuperCompanyDefaultSuper :: Lens' SuperCompanyTableData (Maybe Bool)
+resultSuperCompanyDefaultSuper = _dbrOutput . _5 . _unValue
+
+resultSuperCompanyDefaultReroute :: Lens' SuperCompanyTableData (Maybe Bool)
+resultSuperCompanyDefaultReroute = _dbrOutput . _6 . _unValue
 
 instance HasEntity SuperCompanyTableData User where 
   hasEntity = resultSuperUser
@@ -720,17 +784,6 @@ instance HasEntity SuperCompanyTableData User where
 instance HasUser SuperCompanyTableData where 
   hasUser = resultSuperUser . _entityVal
 
-firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
-firmQuerySupervisedBy cid mbFltr usr = do
-    (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor
-                      `E.innerJoin` E.table @UserCompany
-                      `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
-    let basecond = usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-            E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
-    E.where_ $ maybe basecond ((basecond E.&&.).($ usrSpr)) mbFltr
-
-firmCountForSupervisor :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Word64)
-firmCountForSupervisor = ((E.subSelectCount .) .) . firmQuerySupervisedBy
 
 mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget)
 mkFirmSuperTable isAdmin cid = do
@@ -738,20 +791,23 @@ mkFirmSuperTable isAdmin cid = do
     -- fsh = unCompanyKey cid
     resultDBTable = DBTable{..}
       where
-        dbtSQLQuery = \usr -> do          
+        dbtSQLQuery = \(usr `E.LeftOuterJoin` usrCmp) -> do
+          EL.on $ usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.?=. E.val cid
           E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
           return ( usr
                  , usr & firmCountForSupervisor cid Nothing
                  , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
+                 , usrCmp E.?. UserCompanySupervisor
+                 , usrCmp E.?. UserCompanySupervisorReroute
                  )
         dbtRowKey = querySuperUser >>> (E.^. UserId)
-        dbtProj = dbtProjSimple $ \(usr, supervised, rerouted) -> do
+        dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute) -> do
             cmps <- E.select $ do 
               (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
               E.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val (entityKey usr)
               E.orderBy [E.asc $ cmp E.^. CompanyName]
               return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor)
-            return (usr, supervised, rerouted, cmps)
+            return (usr, supervised, rerouted, cmps, supervisor, reroute)
         dbtColonnade = formColonnade $ mconcat
           [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
           , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
@@ -761,8 +817,10 @@ mkFirmSuperTable isAdmin cid = do
           , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber)        $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t
           , sortable (Just "postal-pref")     (i18nCell MsgPrefersPostal)                $ \(view $ resultSuperUser . _userPrefersPostal         -> b) -> iconFixedCell $ iconLetterOrEmail b
           , colUserEmail
-          , sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "supervised")  (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
-          , sortable (Just "rerouted")   (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "rerouted")    (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "def-super")   (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper   -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell }
+          , sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute)    $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True)
           ]
         dbtSorting = mconcat
           [ single $ sortUserNameLink querySuperUser
@@ -778,6 +836,8 @@ mkFirmSuperTable isAdmin cid = do
               E.orderBy [E.asc $ cmp E.^. CompanyName]
               return (cmp E.^. CompanyName)
             )
+          , singletonMap "def-super"      $ SortColumn $ querySuperUserCompany >>> (E.?. UserCompanySupervisor)
+          , singletonMap "def-reroute"    $ SortColumn $ querySuperUserCompany >>> (E.?. UserCompanySupervisorReroute)
           ]
         dbtFilter = mconcat
           [ single $ fltrUserNameEmail querySuperUser

src/Handler/Utils/Table/Pagination.hs

@@ -37,7 +37,7 @@ module Handler.Utils.Table.Pagination
   , dbtProjFilteredPostId, dbtProjFilteredPostSimple
   , noCsvEncode, simpleCsvEncode, simpleCsvEncodeM
   , withCsvExtraRep
-  , singletonFilter
+  , singletonFilter, multiFilter
   , DBParams(..)
   , cellAttrs, cellContents
   , addCellClass
@@ -647,6 +647,13 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromInner = maybe Map.empty $ Map.singleton key . pure
       fromOuter = Map.lookup key >=> listToMaybe
 
+multiFilter :: Ord k => k -> Prism' (Map k [v]) (Maybe [v])
+-- ^ for use with @prismAForm@
+multiFilter key = prism' fromInner fromOuter
+    where
+      -- prism' :: (Maybe [v] -> (Map k [v])) -> ((Map k [v]) -> Maybe (Maybe [v])) -> Prism' (Map k [v]) (Maybe [v])
+      fromInner = maybe Map.empty (Map.singleton key)
+      fromOuter = Just . Map.lookup key
   
 data DBTCsvEncode r' k' csv = forall exportData filename sheetName.
   ( ToNamedRecord csv, CsvColumnsExplained csv

src/Utils/Icon.hs

@@ -109,12 +109,14 @@ data Icon
   | IconLetter
   | IconAt
   | IconSupervisor
+  | IconSupervisorForeign
   -- | IconWaitingForUser
   | IconExpired
   | IconLocked
   | IconUnlocked
   | IconResetTries -- also see IconReset
   | IconCompany
+  
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
 
@@ -201,12 +203,13 @@ iconText = \case
     IconLetter                  -> "mail-bulk" -- Problem "envelope" already used for email as well
     IconAt                      -> "at"        -- alternative for IconEmail to distinguish from IconLetter
     IconSupervisor              -> "head-side" -- must be notably different to user
+    IconSupervisorForeign       -> "alien"
     -- IconWaitingForUser          -> "user-cog"  -- Waiting on a user to do something
     IconExpired                 -> "hourglass-end"
     IconLocked                  -> "lock"
     IconUnlocked                -> "lock-open-alt"
     IconResetTries              -> "trash-undo"
-    IconCompany                 -> "building"
+    IconCompany                 -> "building"  
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon