From 4cdf39a1fd34720d00ce7c055baa5c2d6188b5a7 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Thu, 19 Oct 2023 16:42:37 +0000
Subject: [PATCH] chore(firm): sorting by employee and supervisor numbers

---
 src/Handler/Firm.hs   | 83 ++++++++++++++++++++++++++++---------------
 src/Handler/LMS.hs    |  1 -
 test/Database/Fill.hs |  1 +
 3 files changed, 55 insertions(+), 30 deletions(-)

diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs
index fe487f78c..de717655f 100644
--- a/src/Handler/Firm.hs
+++ b/src/Handler/Firm.hs
@@ -2,6 +2,7 @@
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
+{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
 {-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
 {-# LANGUAGE TypeApplications #-}
 
@@ -39,9 +40,28 @@ import Database.Esqueleto.Utils.TH
 getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
 getFirmR = postFirmR
 postFirmR fsh = do
+  cusers <- runDB $ do 
+    cusers <- selectList [UserCompanyCompany ==. CompanyKey fsh] []
+    selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName]
+  csuper <- runDB $ do 
+    csuper <- selectList [UserCompanyCompany ==. CompanyKey fsh, UserCompanySupervisor ==. True] []
+    selectList [UserId <-. fmap (userCompanyUser . entityVal) csuper] [Asc UserDisplayName]
   siteLayoutMsg MsgMenuFirms $ do 
     setTitleI MsgMenuFirms
-    [whamlet|STUB FOR #{fsh} TO DO|]
+    [whamlet|STUB HANDLER FOR #{fsh} TO DO
+
+      <h3>Supervisors (non-foreign only)
+      <ul> 
+        $forall u <- csuper
+          <li>^{userWidget u}
+
+      <h3>Employees
+      <ul>
+        $forall u <- cusers
+          <li>^{userWidget u}
+
+      In the end, this needs to be a dbTable, of course!
+    |]
 
 
 getFirmAllR :: Handler Html
@@ -71,6 +91,24 @@ resultAllCompanyUsers = _dbrOutput . _3 . _unValue
 resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64
 resultAllCompanyForeignSupers = _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))      
+
+firmCountForeignSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
+firmCountForeignSupervisors cmpy = E.subSelectCount $ E.distinct $ 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)    
+  return $ usrSuper E.^. UserSupervisorSupervisor
 
 mkFirmAllTable :: Bool -> UserId -> DB (Any, Widget)
 mkFirmAllTable isAdmin uid = do 
@@ -79,46 +117,33 @@ mkFirmAllTable isAdmin uid = do
     resultDBTable = DBTable{..}
       where
         dbtSQLQuery cmpy = do         
-          let filterCmpy usrCmpy = usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
-              cforeign = E.subSelectCount $ E.distinct $ do
-                usrSuper <- E.from $ E.table @UserSupervisor
-                E.where_ $ E.exists (do 
-                    usrCmpy <- E.from $ E.table @UserCompany
-                    E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser
-                  ) E.&&. E.notExists (do 
-                    usrCmpy <- E.from $ E.table @UserCompany
-                    E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor
-                  )
-                return $ usrSuper E.^. UserSupervisorSupervisor
-              cusers  = E.subSelectCount $ do 
-                usrCmpy <- E.from $ E.table @UserCompany
-                E.where_ $ filterCmpy usrCmpy
-              csupers = E.subSelectCount $ do 
-                usrCmpy <- E.from $ E.table @UserCompany
-                E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanySupervisor
           unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
             usrCmpy <- E.from $ E.table @UserCompany
-            E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
-          return (cmpy, csupers, cusers, cforeign)
+            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
+                E.&&.  usrCmpy E.^. UserCompanyUser E.==. E.val uid
+          return (cmpy, firmCountForeignSupervisors cmpy, firmCountUsers cmpy, firmCountSupervisors cmpy)
         dbtRowKey = (E.^. CompanyShorthand)
         dbtProj = dbtProjId
         dbtColonnade = dbColonnade $ mconcat
           [ -- if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultAllCompany . _companyShorthand))
-            sortable (Just "name")      (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) -> 
+            sortable (Just "name")        (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) -> 
               anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
-          , sortable (Just "short")     (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) -> 
+          , sortable (Just "short")       (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) -> 
               let fsh = companyShorthand firm 
               in  anchorCell (FirmR fsh) $ toWgt fsh
-          , sortable (Just "nr")        (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> 
+          , sortable (Just "avsnr")       (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> 
               anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
-          , sortable Nothing (i18nCell MsgTableCompanyNrUsers)          $ \(view resultAllCompanyUsers         -> nr) -> wgtCell $ word2widget nr
-          , sortable Nothing (i18nCell MsgTableCompanyNrSupers)         $ \(view resultAllCompanySupervisors   -> nr) -> wgtCell $ word2widget nr
-          , sortable Nothing (i18nCell MsgTableCompanyNrForeignSupers)  $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "users")       (i18nCell MsgTableCompanyNrUsers)          $ \(view resultAllCompanyUsers         -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupers)         $ \(view resultAllCompanySupervisors   -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "foreigners")  (i18nCell MsgTableCompanyNrForeignSupers)  $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
           ] 
         dbtSorting = mconcat
-          [ singletonMap "name"   $ SortColumn (E.^. CompanyName)
-          , singletonMap "short"  $ SortColumn (E.^. CompanyShorthand)
-          , singletonMap "nr"     $ SortColumn (E.^. CompanyAvsId)
+          [ singletonMap "name"         $ SortColumn (E.^. CompanyName)
+          , singletonMap "short"        $ SortColumn (E.^. CompanyShorthand)
+          , singletonMap "avsnr"        $ SortColumn (E.^. CompanyAvsId)
+          , singletonMap "users"        $ SortColumn firmCountUsers
+          , singletonMap "supervisors"  $ SortColumn firmCountSupervisors
+          , singletonMap "foreigners"   $ SortColumn firmCountForeignSupervisors
           ]
         dbtFilter = mconcat
           [            
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index c927cc8f8..84892c760 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -3,7 +3,6 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
-{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
 {-# LANGUAGE TypeApplications #-}
 
 module Handler.LMS
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index a4d2ab2c4..ce98b437f 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -636,6 +636,7 @@ fillDb = do
   void . insert' $ UserCompany fhamann bpol         False  False 
   void . insert' $ UserCompany fhamann ffacil       True   True 
   void . insert' $ UserCompany fhamann nice         False  False
+  insertMany_ [UserCompany uid fraGround False False| Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
   -- void . insert' $ UserSupervisor jost gkleen       True
   -- void . insert' $ UserSupervisor jost svaupel      False
   -- void . insert' $ UserSupervisor jost sbarth       False