fix(firm): group multi select field supervisor

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

View File

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

View File

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

View File

@ -10,7 +10,7 @@ BoolIrrelevant !ident-ok: —
FieldPrimary: Hauptfach
FieldSecondary: Nebenfach
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
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}

View File

@ -10,7 +10,7 @@ BoolIrrelevant: —
FieldPrimary: Major
FieldSecondary: Minor
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
LdapIdentificationOrEmail: Fraport AG-Kennung / email address
Months num: #{num} #{pluralEN num "Month" "Months"}

View File

@ -380,14 +380,14 @@ firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do
-- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
-- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do
-- 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
-- pure $ usrSuper E.^. UserSupervisorSupervisor
firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
firmCountActiveReroutes cmpy = E.subSelectCount $ do
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
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 isAdmin cid = do
mr <- getMessageRender
let
mkSprOption (E.Value uid, E.Value udn) = do
mkSprOption (E.Value uid, E.Value udn, E.Value mbSpr) = do
uuid <- toPathPiece <$> encryptUser uid
return Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }
procOptions = fmap mkOptionList . traverse mkSprOption
return (Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }, mbSpr)
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
usr <- E.from $ E.table @User
E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
return (usr E.^. UserId, usr E.^. UserDisplayName)
(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.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor)
let
-- supervisorField :: Field Handler UserId
-- supervisorField = selectField $ procOptions rawSupers
supervisorsField = multiSelectField $ procOptions rawSupers
supervisorField = selectField $ procOptions rawSupers
-- TODO: Markieren Alien/Standard/Irregulär
-- supervisorsField = multiSelectField $ procOptions rawSupers
-- supervisorsField = convertField pure head supervisorField
fsh = unCompanyKey cid
resultDBTable = DBTable{..}
@ -784,8 +796,8 @@ mkFirmUserTable isAdmin cid = do
-- superField = selectField $ ????
dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
-- , 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 (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 (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-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 )
, singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
<$> 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 MsgFirmActResetSuperKeep) (Just False)
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData