refactor(firm); supervisor table sorting and company column

src/Handler/Firm.hs

@@ -597,7 +597,7 @@ type SuperCompanyTableExpr = E.SqlExpr (Entity User)
 querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
 querySuperUser = id
 
-type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64)
+type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64, [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)])
 
 resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
 resultSuperUser = _dbrOutput . _1 
@@ -608,12 +608,27 @@ resultSuperCompanySupervised = _dbrOutput . _2 . _unValue
 resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64
 resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue
 
+resultSuperCompanies :: Lens' SuperCompanyTableData [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
+resultSuperCompanies = _dbrOutput . _4
+
+
 instance HasEntity SuperCompanyTableData User where 
   hasEntity = resultSuperUser
 
 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
@@ -622,33 +637,30 @@ mkFirmSuperTable isAdmin cid = do
     resultDBTable = DBTable{..}
       where
         dbtSQLQuery = \usr -> do          
-          -- refactor this
+          E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
-          let subs = do 
+          return ( usr
-                      (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor 
+                 , usr & firmCountForSupervisor cid Nothing
-                                        `E.innerJoin` E.table @UserCompany 
+                 , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
-                                        `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
+                 )
-                      E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-                          E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
-              subs' = do 
-                      (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor 
-                                        `E.innerJoin` E.table @UserCompany 
-                                        `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
-                      E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-                          E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
-                          E.&&.  usrSpr E.^. UserSupervisorRerouteNotifications
-          E.where_ $ E.exists subs
-          return (usr, E.subSelectCount subs, E.subSelectCount subs')
         dbtRowKey = querySuperUser >>> (E.^. UserId)
-        dbtProj = dbtProjId
+        dbtProj = dbtProjSimple $ \(usr, supervised, rerouted) -> 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)
         dbtColonnade = formColonnade $ mconcat
           [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
           , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
           , sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view   resultSuperUser                         -> entUsr) -> cellHasMatrikelnummerLinked entUsr
+          , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultSuperCompanies -> cmps) ->
+              intercalate semicolonCell [companyCell cmpShort cmpName isSuper | (E.Value cmpName, E.Value cmpShort, E.Value isSuper) <- cmps]
           , 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 Nothing (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
-          , sortable Nothing (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "rerouted")   (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
           ]
         dbtSorting = mconcat
           [ single $ sortUserNameLink querySuperUser
@@ -656,6 +668,14 @@ mkFirmSuperTable isAdmin cid = do
           , singletonMap "matriculation"    $ SortColumn $ querySuperUser        >>> (E.^. UserMatrikelnummer)
           , singletonMap "personal-number"  $ SortColumn $ querySuperUser        >>> (E.^. UserCompanyPersonalNumber)
           , singletonMap "postal-pref"      $ SortColumn $ querySuperUser        >>> (E.^. UserPrefersPostal)
+          , singletonMap "supervised"       $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid Nothing
+          , singletonMap "rerouted"         $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
+          , singletonMap "user-company"     $ SortColumn (\row -> E.subSelect $ 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.==. querySuperUser row E.^. UserId
+              E.orderBy [E.asc $ cmp E.^. CompanyName]
+              return (cmp E.^. CompanyName)
+            )
           ]
         dbtFilter = mconcat
           [ single $ fltrUserNameEmail querySuperUser

src/Handler/Utils/Table/Cells.hs

@@ -29,6 +29,9 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit
 spacerCell :: IsDBTable m a => DBCell m a
 spacerCell = cell [whamlet| |]
 
+semicolonCell :: IsDBTable m a => DBCell m a
+semicolonCell = cell [whamlet|; |]
+
 tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
 tellCell = flip mappend . writerCell . tell
 

templates/firm-users.hamlet

@@ -23,8 +23,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <tr .table__row .table__row--head>
           <th .table__th>_{MsgTableCompanyNrSupersDefault}
           <th .table__th>_{MsgTableCompanyNrRerouteDefault}
-          <th .table__th>_{MsgPrefersPostal}
+          <th .table__th colspan=2>_{MsgPrefersPostal}           
-          <th .table__th>          
         <tr .table__row>         
           <td .table__td>#{nrCompanySupervisors}
           <td .table__td>#{nrCompanyDefaultReroutes}