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
+
+
Supervisors (non-foreign only)
+
+ $forall u <- csuper
+ - ^{userWidget u}
+
+
Employees
+
+ $forall u <- cusers
+ - ^{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