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

chore(firm): towards #169 distinct icon for avs firm superior (user-tie)

Browse Source
This commit is contained in:
Steffen Jost 2024-07-04 14:38:31 +02:00
parent f869a829d2
commit 3a66bed173
2 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/Firm.hs
View File

@ -325,9 +325,9 @@ addDefaultSupervisorsAll mutualSupervision cids = do
------------------------------ ------------------------------
-- repeatedly useful queries -- repeatedly useful queries
usrSuperiorCompanies :: E.SqlExpr (Entity Company) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery () usrPrimaryCompanies :: E.SqlExpr (Entity Company) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery ()
-- usrSuperiorCompanies :: E.SqlExpr (E.Value CompanyId) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery (Entity UserCompany) -- possible alternative -- usrPrimaryCompanies :: E.SqlExpr (E.Value CompanyId) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery (Entity UserCompany) -- possible alternative
usrSuperiorCompanies cmp usr = do usrPrimaryCompanies cmp usr = do
othr <- E.from $ E.table @UserCompany othr <- E.from $ E.table @UserCompany
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
@ -346,12 +346,12 @@ firmCountUsers = E.subSelectCount . fromUserCompany Nothing
firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
where where
primFltr = E.notExists . usrSuperiorCompanies cmp primFltr = E.notExists . usrPrimaryCompanies cmp
firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountUsersSecondary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp firmCountUsersSecondary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
where where
primFltr = E.exists . usrSuperiorCompanies cmp primFltr = E.exists . usrPrimaryCompanies cmp
firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor)) firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
@ -1164,6 +1164,7 @@ querySuperUserCompany = $(sqlLOJproj 2 2)
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)] , [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
, E.Value (Maybe Bool), E.Value (Maybe Bool) -- Maybe (Entity UserCompany) , E.Value (Maybe Bool), E.Value (Maybe Bool) -- Maybe (Entity UserCompany)
, E.Value Bool
) )
resultSuperUser :: Lens' SuperCompanyTableData (Entity User) resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
@ -1184,6 +1185,9 @@ resultSuperCompanyDefaultSuper = _dbrOutput . _5 . _unValue
resultSuperCompanyDefaultReroute :: Lens' SuperCompanyTableData (Maybe Bool) resultSuperCompanyDefaultReroute :: Lens' SuperCompanyTableData (Maybe Bool)
resultSuperCompanyDefaultReroute = _dbrOutput . _6 . _unValue resultSuperCompanyDefaultReroute = _dbrOutput . _6 . _unValue
resultSuperCompanySuperior :: Lens' SuperCompanyTableData Bool
resultSuperCompanySuperior = _dbrOutput . _7 . _unValue
instance HasEntity SuperCompanyTableData User where instance HasEntity SuperCompanyTableData User where
hasEntity = resultSuperUser hasEntity = resultSuperUser
@ -1195,6 +1199,7 @@ mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Se
mkFirmSuperTable isAdmin cid = do mkFirmSuperTable isAdmin cid = do
msgSupervisorUnchanged <- messageI Info MsgFirmSuperActSwitchSuperInfo msgSupervisorUnchanged <- messageI Info MsgFirmSuperActSwitchSuperInfo
let let
reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
-- fsh = unCompanyKey cid -- fsh = unCompanyKey cid
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
@ -1207,15 +1212,16 @@ mkFirmSuperTable isAdmin cid = do
, usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications)) , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
, usrCmp E.?. UserCompanySupervisor , usrCmp E.?. UserCompanySupervisor
, usrCmp E.?. UserCompanySupervisorReroute , usrCmp E.?. UserCompanySupervisorReroute
, E.exists (firmQuerySupervisedBy cid (Just (\usrSpr -> usrSpr E.^. UserSupervisorReason E.==. E.val reasonSuperior)) usr)
) )
dbtRowKey = querySuperUser >>> (E.^. UserId) dbtRowKey = querySuperUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute) -> do dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute, isSuperior) -> do
cmps <- E.select $ 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) (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.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val (entityKey usr)
E.orderBy [E.asc $ cmp E.^. CompanyName] E.orderBy [E.asc $ cmp E.^. CompanyName]
return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor) return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor)
return (usr, supervised, rerouted, cmps, supervisor, reroute) return (usr, supervised, rerouted, cmps, supervisor, reroute, isSuperior)
dbtColonnade = formColonnade $ mconcat dbtColonnade = formColonnade $ mconcat
[ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey)) [ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
, colUserNameModalHdr MsgTableSupervisor ForProfileDataR , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
@ -1227,7 +1233,15 @@ mkFirmSuperTable isAdmin cid = do
, colUserEmail , colUserEmail
, sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr , sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
, sortable (Just "rerouted") (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr , sortable (Just "rerouted") (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr
, sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell } -- , sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell }
, sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ \row ->
let mb = row ^. resultSuperCompanyDefaultSuper
sp = row ^. resultSuperCompanySuperior
in case (mb,sp) of
(_ , True) -> iconCell IconSuperior
(Nothing ,_) -> iconCell IconSupervisorForeign
(Just True ,_) -> iconCell IconSupervisor
(Just False,_) -> iconSpacerCell
, sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute) $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True) , sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute) $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True)
, sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultSuperUser -> entUsr) -> cellEditUserModal entUsr , sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultSuperUser -> entUsr) -> cellEditUserModal entUsr
] ]

2
test/Database/Fill.hs
View File

@ -701,7 +701,7 @@ fillDb = do
] ]
++ take 444 [ UserSupervisor fhamann uid True Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <- matUsers, uid /= jost] ++ take 444 [ UserSupervisor fhamann uid True Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <- matUsers, uid /= jost]
++ take 123 [ UserSupervisor gkleen uid True Nothing Nothing | Entity uid _ <- drop 369 matUsers ] ++ take 123 [ UserSupervisor gkleen uid True Nothing Nothing | Entity uid _ <- drop 369 matUsers ]
++ take 11 [ UserSupervisor jost uid False Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <- drop 501 matUsers ] ++ take 11 [ UserSupervisor jost uid False Nothing (Just $ tshow SupervisorReasonAvsSuperior) | Entity uid _ <- drop 501 matUsers ]
upsertManyWhere supvs [] [] [] upsertManyWhere supvs [] [] []
-- insertMany_ supvs -- NOTE: multiple calls like this throw a runtime error! -- insertMany_ supvs -- NOTE: multiple calls like this throw a runtime error!
-- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok