diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index f938dbaa9..c7a92efb3 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -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. diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 747900397..043312a20 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -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. diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index eaa02c0fa..3fcd6ffe6 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -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"} diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index 5b6b15f5b..ed8bda4db 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -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"} diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index c6d77abc1..fabb20538 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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