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

fix(firm): group multi select field supervisor

Browse Source 
However, grouped multi select does not work for some reason.
This commit is contained in:
Steffen Jost 2023-12-05 18:39:59 +01:00
parent 9878956716
commit fc0ca7b854
5 changed files with 33 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,6 +2,9 @@
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # SPDX-License-Identifier: AGPL-3.0-or-later
FirmSuperDefault: Standardansprechpartner
FirmSuperForeign: Firmenfremde Ansprechpartner
FirmSuperIrregular: Irreguläre Ansprechpartner
FirmAssociates: Firmenangehörige FirmAssociates: Firmenangehörige
FirmContact: Firmenkontakt FirmContact: Firmenkontakt
FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt. FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt.

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

@ -2,6 +2,9 @@
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # SPDX-License-Identifier: AGPL-3.0-or-later
FirmSuperDefault: Default supervisor
FirmSuperForeign: External supervisor
FirmSuperIrregular: Irregular supervisor
FirmAssociates: Company associated users FirmAssociates: Company associated users
FirmContact: Company Contact FirmContact: Company Contact
FirmNoContact: No general contact information known. FirmNoContact: No general contact information known.

2
messages/uniworx/misc/de-de-formal.msg
View File

@ -10,7 +10,7 @@ BoolIrrelevant !ident-ok: —
FieldPrimary: Hauptfach FieldPrimary: Hauptfach
FieldSecondary: Nebenfach FieldSecondary: Nebenfach
MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich
MultiSelectTip: Mehrfachauswahl mit Strg-Klick MultiSelectTip: Mehrfachauswahl und Abwählen mit Strg-Klick
WeekDay: Wochentag WeekDay: Wochentag
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"} Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}

2
messages/uniworx/misc/en-eu.msg
View File

@ -10,7 +10,7 @@ BoolIrrelevant: —
FieldPrimary: Major FieldPrimary: Major
FieldSecondary: Minor FieldSecondary: Minor
MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated) MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
MultiSelectTip: Multiple selection via Ctrl-Click MultiSelectTip: Multiple selection and desection via Ctrl-Click
WeekDay: Day of the week WeekDay: Day of the week
LdapIdentificationOrEmail: Fraport AG-Kennung / email address LdapIdentificationOrEmail: Fraport AG-Kennung / email address
Months num: #{num} #{pluralEN num "Month" "Months"} Months num: #{num} #{pluralEN num "Month" "Months"}

38
src/Handler/Firm.hs
View File

@ -380,14 +380,14 @@ firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do
-- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) -- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do -- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do
-- usrSuper <- E.from $ E.table @UserSupervisor -- usrSuper <- E.from $ E.table @UserSupervisor
-- E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy) -- E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy)
-- E.&&. usrSuper E.^. UserSupervisorRerouteNotifications -- E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
-- pure $ usrSuper E.^. UserSupervisorSupervisor -- pure $ usrSuper E.^. UserSupervisorSupervisor
firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountActiveReroutes cmpy = E.subSelectCount $ do firmCountActiveReroutes cmpy = E.subSelectCount $ do
usrSuper <- E.from $ E.table @UserSupervisor usrSuper <- E.from $ E.table @UserSupervisor
E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy) E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy)
E.&&. usrSuper E.^. UserSupervisorRerouteNotifications E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery () firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
@ -682,20 +682,32 @@ instance HasUser UserCompanyTableData where
mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set UserId), Widget) mkFirmUserTable :: Bool -> CompanyId -> DB (FormResult (FirmUserActionData, Set UserId), Widget)
mkFirmUserTable isAdmin cid = do mkFirmUserTable isAdmin cid = do
mr <- getMessageRender
let let
mkSprOption (E.Value uid, E.Value udn) = do mkSprOption (E.Value uid, E.Value udn, E.Value mbSpr) = do
uuid <- toPathPiece <$> encryptUser uid uuid <- toPathPiece <$> encryptUser uid
return Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid } return (Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }, mbSpr)
procOptions = fmap mkOptionList . traverse mkSprOption
procOptions rawSupers = do
procSupers <- traverse mkSprOption rawSupers
return $ mkOptionListGrouped $ filter (notNull . snd)
[ (mr MsgFirmSuperDefault , [opt | (opt, Just True ) <- procSupers])
, (mr MsgFirmSuperIrregular, [opt | (opt, Just False) <- procSupers])
, (mr MsgFirmSuperForeign , [opt | (opt, Nothing ) <- procSupers])
]
rawSupers <- E.select $ do rawSupers <- E.select $ do
usr <- E.from $ E.table @User (usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany
E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid)
return (usr E.^. UserId, usr E.^. UserDisplayName) E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor)
let let
-- supervisorField :: Field Handler UserId -- supervisorField :: Field Handler UserId
-- supervisorField = selectField $ procOptions rawSupers supervisorField = selectField $ procOptions rawSupers
supervisorsField = multiSelectField $ procOptions rawSupers -- TODO: Markieren Alien/Standard/Irregulär
-- supervisorsField = multiSelectField $ procOptions rawSupers
-- supervisorsField = convertField pure head supervisorField
fsh = unCompanyKey cid fsh = unCompanyKey cid
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
@ -784,8 +796,8 @@ mkFirmUserTable isAdmin cid = do
-- superField = selectField $ ???? -- superField = selectField $ ????
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
-- , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor)
, prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip ) -- , prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip )
, prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
, prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh) , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
, prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh) , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
@ -799,7 +811,7 @@ mkFirmUserTable isAdmin cid = do
-- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) -- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
, singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
<$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <$> aopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
<*> aopt supervisorsField (fslI MsgFirmSetSupervisor) Nothing <*> fmap (fmap pure) (aopt supervisorField (fslI MsgFirmSetSupervisor) Nothing)
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False) <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
<*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False) <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False)
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData