chore(firm): sorting by employee and supervisor numbers
This commit is contained in:
parent
92e83475a9
commit
4cdf39a1fd
@ -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
|
||||
[
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user