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

chore(firm): provide more filters for supervisors

Browse Source 
also fix build #175
This commit is contained in:
Steffen Jost 2024-08-29 14:34:37 +02:00
parent 8397c468a0
commit 64ff002ffb
4 changed files with 36 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/firm/de-de-formal.msg
View File

@ -51,6 +51,7 @@ FilterSupervisor: Hat aktiven Ansprechpartner
FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört
FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
FilterForeignSupervisor: Hat firmenfremde Ansprechpartner FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
FilterIsForeignSupervisee: Ist Ansprechpartner für Firmenfremde
FilterFirmExtern: Externe Firma FilterFirmExtern: Externe Firma
FilterFirmExternTooltip: Hat die Firma eine Postanschrift im AVS? FilterFirmExternTooltip: Hat die Firma eine Postanschrift im AVS?
FilterFirmPrimary: Ist primäre Firma in FRADrive FilterFirmPrimary: Ist primäre Firma in FRADrive

1
messages/uniworx/categories/firm/en-eu.msg
View File

@ -51,6 +51,7 @@ FilterSupervisor: Has active supervisor
FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
FilterForeignSupervisor: Has company-external supervisors FilterForeignSupervisor: Has company-external supervisors
FilterIsForeignSupervisee: Supervisor for company external users
FilterFirmExtern: External company FilterFirmExtern: External company
FilterFirmExternTooltip: i.e. is a postal address registered within AVS? FilterFirmExternTooltip: i.e. is a postal address registered within AVS?
FilterFirmPrimary: Is primary company in FRADrive FilterFirmPrimary: Is primary company in FRADrive

42
src/Handler/Firm.hs
View File

@ -1204,21 +1204,22 @@ 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 reasonSuperior = tshow SupervisorReasonAvsSuperior
-- fsh = unCompanyKey cid -- fsh = unCompanyKey cid
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
dbtSQLQuery = \(usr `E.LeftOuterJoin` usrCmp) -> do dbtSQLQuery = \(usr `E.LeftOuterJoin` usrCmp) -> do
EL.on $ usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.?=. E.val cid EL.on $ usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.?=. E.val cid
E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) -- let uc_reason = E.joinV (usrCmp E.?. UserCompanyReason)
return ( usr return ( usr
, usr & firmCountForSupervisor cid Nothing , usr & firmCountForSupervisor cid Nothing
, usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications)) , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
, usrCmp E.?. UserCompanySupervisor , usrCmp E.?. UserCompanySupervisor
, usrCmp E.?. UserCompanySupervisorReroute , usrCmp E.?. UserCompanySupervisorReroute
, (usrCmp E.?. UserCompanyReason E.?=. E.val reasonSuperior) E.||. -- , (E.isJust uc_reason E.&&. uc_reason E.==. E.justVal reasonSuperior) -- NOTE: this is problematic, as obvious approaches caused errors such as: Failed to parse Haskell type bool, received PersistNull, since the SQL comparison with NULL returns NULL
E.exists (firmQuerySupervisedBy cid (Just (\usrSpr -> usrSpr E.^. UserSupervisorReason E.==. E.val reasonSuperior)) usr) , (E.coalesceDefault [E.joinV (usrCmp E.?. UserCompanyReason)] (E.val mempty) E.==. E.val reasonSuperior) -- works as well
E.||. E.exists (firmQuerySupervisedBy cid (Just (\usrSpr -> usrSpr E.^. UserSupervisorReason E.==. E.justVal reasonSuperior)) usr)
) )
dbtRowKey = querySuperUser >>> (E.^. UserId) dbtRowKey = querySuperUser >>> (E.^. UserId)
dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute, isSuperior) -> do dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute, isSuperior) -> do
@ -1239,18 +1240,11 @@ 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 >>> \case , sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ view resultSuperCompanyDefaultSuper >>> \case
Nothing -> iconCell IconSupervisorForeign Nothing -> iconCell IconSupervisorForeign
(Just True ) -> iconCell IconSupervisor (Just True ) -> iconCell IconSupervisor
(Just False) -> iconSpacerCell (Just False) -> iconSpacerCell
, sortable Nothing (i18nCell MsgTableSuperior) $ \row -> , sortable Nothing (i18nCell MsgTableSuperior) $ view resultSuperCompanySuperior >>> flip ifIconCell IconSuperior
let mb = row ^. resultSuperCompanyDefaultSuper
sp = row ^. resultSuperCompanySuperior
in case (mb,sp) of
(_ , False) -> iconSpacerCell
(Nothing , True ) -> iconCell IconSuperior <> iconCell IconSupervisorForeign
(Just _ , True ) -> iconCell IconSuperior
, 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
] ]
@ -1273,9 +1267,29 @@ mkFirmSuperTable isAdmin cid = do
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameEmail querySuperUser [ single $ fltrUserNameEmail querySuperUser
, singletonMap "is-foreign-supervisor" $ FilterColumn $ \(querySuperUserCompany -> suc) (getLast -> criterion) ->
case criterion of
Nothing -> E.true
Just True -> E.isNothing $ suc E.?. UserCompanyUser
Just False -> E.isJust $ suc E.?. UserCompanyUser
, singletonMap "super-relation-foreign" $ FilterColumn $ \row (getLast -> criterion) ->
let checkSuper = do
usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. querySuperUser row E.^. UserId
E.&&. E.exists (do
usr <- E.from $ E.table @UserCompany
E.where_ $ usr E.^. UserCompanyCompany E.!=. E.val cid
E.&&. usr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
)
in case criterion of
Nothing -> E.true
Just True -> E.exists checkSuper
Just False -> E.notExists checkSuper
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev [ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev
, prismAForm (singletonFilter "is-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmSuperForeign)
, prismAForm (singletonFilter "super-relation-foreign" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterIsForeignSupervisee)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData) acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData)
@ -1362,7 +1376,7 @@ postFirmSupersR fsh = do
formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupervisors, FirmActResetSupervision, FirmActChangeContactFirm] formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupervisors, FirmActResetSupervision, FirmActChangeContactFirm]
siteLayout (citext2widget fsh) $ do siteLayout (citext2widget companyName) $ do
setTitle $ citext2Html $ fsh <> " Supers" setTitle $ citext2Html $ fsh <> " Supers"
let firmContactInfo = $(widgetFile "firm-contact-info") let firmContactInfo = $(widgetFile "firm-contact-info")
$(i18nWidgetFile "firm-supervisors") $(i18nWidgetFile "firm-supervisors")

12
test/Database/Fill.hs
View File

@ -655,14 +655,14 @@ fillDb = do
, let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n) , let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
, let rcShort = CI.mk $ "RC" <> tshow n , let rcShort = CI.mk $ "RC" <> tshow n
] ]
void . insert' $ UserCompany jost fraportAg True True 0 False $ Just "Vorgesetzter" void . insert' $ UserCompany jost fraportAg True True 0 False $ Just $ tshow SupervisorReasonAvsSuperior
void . insert' $ UserCompany svaupel nice True False 2 False $ Just "Vorgesetzter" void . insert' $ UserCompany svaupel nice True False 2 False $ Just $ tshow SupervisorReasonAvsSuperior
void . insert' $ UserCompany svaupel ffacil False False 1 False $ Just "Irgendwas" void . insert' $ UserCompany svaupel ffacil False False 1 False $ Just "Irgendwas"
void . insert' $ UserCompany svaupel bpol True False 2 False $ Just "Irgendwas" void . insert' $ UserCompany svaupel bpol True False 2 False $ Just "Irgendwas"
void . insert' $ UserCompany svaupel fraGround True False 1 False $ Just "Irgendwas" void . insert' $ UserCompany svaupel fraGround True False 1 False $ Just "Irgendwas"
void . insert' $ UserCompany gkleen nice False False 1 True $ Just "Winterdienst" void . insert' $ UserCompany gkleen nice False False 1 True $ Just "Winterdienst"
void . insert' $ UserCompany gkleen fraGround False True 2 False $ Just "Irgendwas" void . insert' $ UserCompany gkleen fraGround False True 2 False $ Just "Irgendwas"
void . insert' $ UserCompany gkleen bpol False True 1 False $ Just "Irgendwas" void . insert' $ UserCompany gkleen bpol False True 1 False $ Just $ tshow SupervisorReasonAvsSuperior
void . insert' $ UserCompany fhamann bpol False False 1 True $ Just "Irgendwas" void . insert' $ UserCompany fhamann bpol False False 1 True $ Just "Irgendwas"
void . insert' $ UserCompany fhamann ffacil True True 2 True $ Just "Irgendwas" void . insert' $ UserCompany fhamann ffacil True True 2 True $ Just "Irgendwas"
void . insert' $ UserCompany fhamann nice False False 3 False $ Just "Winterdienst" void . insert' $ UserCompany fhamann nice False False 3 False $ Just "Winterdienst"
@ -687,14 +687,14 @@ fillDb = do
-- void . insert' $ UserSupervisor svaupel gkleen False -- void . insert' $ UserSupervisor svaupel gkleen False
-- void . insert' $ UserSupervisor svaupel fhamann True -- void . insert' $ UserSupervisor svaupel fhamann True
-- void . insert' $ UserSupervisor sbarth tinaTester True -- void . insert' $ UserSupervisor sbarth tinaTester True
let supvs = [ UserSupervisor jost gkleen True (Just fraportAg) (Just "Staff") let supvs = [ UserSupervisor jost gkleen True (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor jost svaupel False (Just fraportAg) (Just "Staff") , UserSupervisor jost svaupel False (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor jost sbarth False (Just fraportAg) (Just "Staff") , UserSupervisor jost sbarth False (Just fraportAg) (Just "Staff")
, UserSupervisor jost tinaTester True (Just fraportAg) (Just "Staff") , UserSupervisor jost tinaTester True (Just fraportAg) (Just "Staff")
, UserSupervisor jost jost True (Just fraportAg) (Just "Staff") , UserSupervisor jost jost True (Just fraportAg) (Just "Staff")
, UserSupervisor svaupel gkleen False (Just nice) (Just "Staff") , UserSupervisor svaupel gkleen False (Just nice) (Just "Staff")
, UserSupervisor svaupel fhamann True (Just nice) (Just "Staff") , UserSupervisor svaupel fhamann True (Just nice) (Just "Staff")
, UserSupervisor sbarth tinaTester True (Just nice) (Just "Staff") , UserSupervisor sbarth tinaTester True (Just nice) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor gkleen fhamann False (Just fraGround) (Just "Staff") , UserSupervisor gkleen fhamann False (Just fraGround) (Just "Staff")
, UserSupervisor gkleen gkleen True (Just fraGround) (Just "Staff") , UserSupervisor gkleen gkleen True (Just fraGround) (Just "Staff")
, UserSupervisor tinaTester tinaTester False Nothing (Just "Staff") , UserSupervisor tinaTester tinaTester False Nothing (Just "Staff")