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

fix(firm): fix #175 by separating superiors in firm tables and selections

Browse Source
This commit is contained in:
Steffen Jost 2024-08-28 17:50:44 +02:00
parent 81721b0794
commit 8397c468a0
4 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/categories/admin/de-de-formal.msg
View File

@ -132,8 +132,8 @@ AdminProblemsReopened n@Int: #{pluralDEeN n "Admin Problem"} erneut eröffnet
AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen AdminProblemNewCompany: Neue Firma über AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen
AdminProblemSupervisorNewCompany b@Bool: Standardansprechpartner #{boolText mempty "mit Standardumleitung" b} wechselte zu neuer Firma AdminProblemSupervisorNewCompany b@Bool: Standardansprechpartner #{boolText mempty "mit Standardumleitung" b} wechselte zu neuer Firma
AdminProblemSupervisorLeftCompany b@Bool: Einziger Standardansprechpartner #{boolText mempty "mit Standardumleitung" b} dieses Fahrers wechselte zu neuer Firma AdminProblemSupervisorLeftCompany b@Bool: Einziger Standardansprechpartner #{boolText mempty "mit Standardumleitung" b} dieses Fahrers wechselte zu neuer Firma
AdminProblemCompanySuperiorChange: Neuer firmenweiter Vorgesetzer. AdminProblemCompanySuperiorChange: Neuer firmenweiter Vorgesetzter.
AdminProblemCompanySuperiorPrevious: Ehemaliger Vorgesetzer: AdminProblemCompanySuperiorPrevious: Ehemaliger Vorgesetzter:
AdminProblemNewlyUnsupervised: Fahrer hat keinen Firmenansprechpartner mehr nach AVS Firmenwechsel zu Firma AdminProblemNewlyUnsupervised: Fahrer hat keinen Firmenansprechpartner mehr nach AVS Firmenwechsel zu Firma
AdminProblemUser: Betroffener AdminProblemUser: Betroffener
ProblemTableMarkSolved: Als erledigt markieren ProblemTableMarkSolved: Als erledigt markieren

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

@ -60,6 +60,7 @@ FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
NoCompanySelected: Bitte wählen Sie mindestens eine Firma aus. NoCompanySelected: Bitte wählen Sie mindestens eine Firma aus.
TableIsDefaultSupervisor: Standardansprechpartner TableIsDefaultSupervisor: Standardansprechpartner
TableSuperior: Vorgesetzter
TableIsDefaultReroute: Standardumleitung TableIsDefaultReroute: Standardumleitung
FormFieldPostal: Benachrichtigungseinstellung FormFieldPostal: Benachrichtigungseinstellung
FormFieldPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner FormFieldPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner

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

@ -60,6 +60,7 @@ FirmSupervisorIndependent: Independent supervisors
FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
NoCompanySelected: Select at least one company, please. NoCompanySelected: Select at least one company, please.
TableIsDefaultSupervisor: Default supervisor TableIsDefaultSupervisor: Default supervisor
TableSuperior: Superior
TableIsDefaultReroute: Default reroute TableIsDefaultReroute: Default reroute
FormFieldPostal: Notification type FormFieldPostal: Notification type
FormFieldPostalTip: Affects all notifications to this person, not just reroutes to this supervisor FormFieldPostalTip: Affects all notifications to this person, not just reroutes to this supervisor

35
src/Handler/Firm.hs
View File

@ -97,7 +97,7 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
<$> aopt boolField' (fslI MsgFirmActResetSuperKeep) (Just $ Just False) <$> aopt boolField' (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
<*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
mkAct _ FirmActAddSupervisors = singletonMap FirmActAddSupervisors $ FirmActAddSupervisorsData mkAct _ FirmActAddSupervisors = singletonMap FirmActAddSupervisors $ FirmActAddSupervisorsData
<$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <$> areq (textField & cfAnySeparatedSet) (fslI MsgFirmSuperDefault & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute) (Just True) <*> areq checkBoxField (fslI MsgTableIsDefaultReroute) (Just True)
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing <*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
<*> aopt (textField & cfStrip & addDatalist ucdefSuperReasons) <*> aopt (textField & cfStrip & addDatalist ucdefSuperReasons)
@ -804,24 +804,27 @@ mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set
mkFirmUserTable isAdmin cid = do mkFirmUserTable isAdmin cid = do
mr <- getMessageRender mr <- getMessageRender
let let
mkSprOption (E.Value uid, E.Value udn, E.Value mbSpr) = do reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
mkSprOption (E.Value uid, E.Value udn, E.Value mbSpr, E.Value mbmbReason) = do
uuid <- toPathPiece <$> encryptUser uid uuid <- toPathPiece <$> encryptUser uid
return (Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }, mbSpr) return (Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }, mbSpr, mbmbReason == Just reasonSuperior)
procOptions rawSupers = do procOptions rawSupers = do
procSupers <- traverse mkSprOption rawSupers procSupers <- traverse mkSprOption rawSupers
return $ mkOptionListGrouped $ filter (notNull . snd) return $ mkOptionListGrouped $ filter (notNull . snd)
[ (mr MsgFirmSuperDefault , [opt | (opt, Just True ) <- procSupers]) [ (mr MsgTableSuperior , [opt | (opt, _ , True ) <- procSupers])
, (mr MsgFirmSuperIrregular, [opt | (opt, Just False) <- procSupers]) , (mr MsgFirmSuperDefault , [opt | (opt, Just True , False) <- procSupers])
, (mr MsgFirmSuperForeign , [opt | (opt, Nothing ) <- procSupers]) , (mr MsgFirmSuperIrregular, [opt | (opt, Just False, False) <- procSupers])
, (mr MsgFirmSuperForeign , [opt | (opt, Nothing , False) <- procSupers])
] ]
rawSupers <- E.select $ do rawSupers <- E.select $ do
(usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany (usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid) `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid)
E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
E.||. (usrCmp E.?. UserCompanyReason E.?=. E.val reasonSuperior)
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor) return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor, usrCmp E.?. UserCompanyReason)
let let
-- supervisorField :: Field Handler UserId -- supervisorField :: Field Handler UserId
-- supervisorField = selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers -- supervisorField = selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers
@ -1214,7 +1217,8 @@ 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) , (usrCmp E.?. UserCompanyReason E.?=. E.val reasonSuperior) E.||.
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, isSuperior) -> do dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute, isSuperior) -> do
@ -1236,14 +1240,17 @@ mkFirmSuperTable isAdmin cid = do
, 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 -> , sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ view resultSuperCompanyDefaultSuper >>> \case
Nothing -> iconCell IconSupervisorForeign
(Just True ) -> iconCell IconSupervisor
(Just False) -> iconSpacerCell
, sortable Nothing (i18nCell MsgTableSuperior) $ \row ->
let mb = row ^. resultSuperCompanyDefaultSuper let mb = row ^. resultSuperCompanyDefaultSuper
sp = row ^. resultSuperCompanySuperior sp = row ^. resultSuperCompanySuperior
in case (mb,sp) of in case (mb,sp) of
(_ , True) -> iconCell IconSuperior (_ , False) -> iconSpacerCell
(Nothing ,_) -> iconCell IconSupervisorForeign (Nothing , True ) -> iconCell IconSuperior <> iconCell IconSupervisorForeign
(Just True ,_) -> iconCell IconSupervisor (Just _ , True ) -> iconCell IconSuperior
(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
] ]
@ -1275,7 +1282,7 @@ mkFirmSuperTable isAdmin cid = do
acts = mconcat acts = mconcat
[ guardMonoid isAdmin $ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData [ guardMonoid isAdmin $ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData
, singletonMap FirmSuperActSwitchSuper $ FirmSuperActSwitchSuperData , singletonMap FirmSuperActSwitchSuper $ FirmSuperActSwitchSuperData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultSupervisor) (Just $ Just True) <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmSuperDefault) (Just $ Just True)
<*> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultReroute) Nothing <*> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgTableIsDefaultReroute) Nothing
<* aformMessage msgSupervisorUnchanged <* aformMessage msgSupervisorUnchanged
, singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData , singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData