fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(firm): sorting by employee and supervisor numbers

Browse Source
This commit is contained in:
Steffen Jost 2023-10-19 16:42:37 +00:00
parent 92e83475a9
commit 4cdf39a1fd
3 changed files with 55 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
src/Handler/Firm.hs
View File

@ -2,6 +2,7 @@
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- 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 {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
@ -39,9 +40,28 @@ import Database.Esqueleto.Utils.TH
getFirmR, postFirmR :: CompanyShorthand -> Handler Html getFirmR, postFirmR :: CompanyShorthand -> Handler Html
getFirmR = postFirmR getFirmR = postFirmR
postFirmR fsh = do 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 siteLayoutMsg MsgMenuFirms $ do
setTitleI MsgMenuFirms 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 getFirmAllR :: Handler Html
@ -71,6 +91,24 @@ resultAllCompanyUsers = _dbrOutput . _3 . _unValue
resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64 resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64
resultAllCompanyForeignSupers = _dbrOutput . _4 . _unValue 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 :: Bool -> UserId -> DB (Any, Widget)
mkFirmAllTable isAdmin uid = do mkFirmAllTable isAdmin uid = do
@ -79,46 +117,33 @@ mkFirmAllTable isAdmin uid = do
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
dbtSQLQuery cmpy = do 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 unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
usrCmpy <- E.from $ E.table @UserCompany usrCmpy <- E.from $ E.table @UserCompany
E.where_ $ filterCmpy usrCmpy E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
return (cmpy, csupers, cusers, cforeign) E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
return (cmpy, firmCountForeignSupervisors cmpy, firmCountUsers cmpy, firmCountSupervisors cmpy)
dbtRowKey = (E.^. CompanyShorthand) dbtRowKey = (E.^. CompanyShorthand)
dbtProj = dbtProjId dbtProj = dbtProjId
dbtColonnade = dbColonnade $ mconcat dbtColonnade = dbColonnade $ mconcat
[ -- if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultAllCompany . _companyShorthand)) [ -- 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 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 let fsh = companyShorthand firm
in anchorCell (FirmR fsh) $ toWgt fsh 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 anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
, sortable Nothing (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr , sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
, sortable Nothing (i18nCell MsgTableCompanyNrSupers) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupers) $ \(view resultAllCompanySupervisors -> nr) -> wgtCell $ word2widget nr
, sortable Nothing (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr , sortable (Just "foreigners") (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ singletonMap "name" $ SortColumn (E.^. CompanyName) [ singletonMap "name" $ SortColumn (E.^. CompanyName)
, singletonMap "short" $ SortColumn (E.^. CompanyShorthand) , singletonMap "short" $ SortColumn (E.^. CompanyShorthand)
, singletonMap "nr" $ SortColumn (E.^. CompanyAvsId) , singletonMap "avsnr" $ SortColumn (E.^. CompanyAvsId)
, singletonMap "users" $ SortColumn firmCountUsers
, singletonMap "supervisors" $ SortColumn firmCountSupervisors
, singletonMap "foreigners" $ SortColumn firmCountForeignSupervisors
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ [

1
src/Handler/LMS.hs
View File

@ -3,7 +3,6 @@
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Handler.LMS module Handler.LMS

1
test/Database/Fill.hs
View File

@ -636,6 +636,7 @@ fillDb = do
void . insert' $ UserCompany fhamann bpol False False void . insert' $ UserCompany fhamann bpol False False
void . insert' $ UserCompany fhamann ffacil True True void . insert' $ UserCompany fhamann ffacil True True
void . insert' $ UserCompany fhamann nice False False 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 gkleen True
-- void . insert' $ UserSupervisor jost svaupel False -- void . insert' $ UserSupervisor jost svaupel False
-- void . insert' $ UserSupervisor jost sbarth False -- void . insert' $ UserSupervisor jost sbarth False