diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 024efc05f..4fb1d392d 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -10,6 +10,9 @@ FirmAllActNotify: Mitteilung versenden FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen FirmUserActNotify: Mitteilung versenden FirmUserActMkSuper: Zum Firmenansprechpartner ernennen +FirmSuperActNotify: Mitteilung versenden +FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen +FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen FilterSupervisor: Hat aktiven Ansprechpartner FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 869cc617a..a4df65482 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -10,6 +10,9 @@ FirmAllActNotify: Send message FirmAllActResetSupervision: Reset supervisors for all company associates FirmUserActNotify: Send message FirmUserActMkSuper: Mark as company supervisor +FirmSuperActNotify: Send message +FirmSuperActRMSuperDef: Remove as default supervisor +FirmSuperActRMSuperAll: Remove all active supervisions for this company FilterSupervisor: Has active supervisor FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 39c1840bd..3f6d46207 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -578,10 +578,160 @@ postFirmUsersR fsh = do ----------------------------- -- Firm Supervisors Table +data FirmSuperAction = FirmSuperActNotify + | FirmSuperActRMSuperDef + | FirmSuperActRMSuperAll + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''FirmSuperAction $ camelToPathPiece' 3 +embedRenderMessage ''UniWorX ''FirmSuperAction id + +data FirmSuperActionData = FirmSuperActNotifyData + | FirmSuperActRMSuperDefData + | FirmSuperActRMSuperAllData + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + +type SuperCompanyTableExpr = E.SqlExpr (Entity User) + +querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User) +querySuperUser = id + +type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64) + +resultSuperUser :: Lens' SuperCompanyTableData (Entity User) +resultSuperUser = _dbrOutput . _1 + +resultSuperCompanySupervised :: Lens' SuperCompanyTableData Word64 +resultSuperCompanySupervised = _dbrOutput . _2 . _unValue + +resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64 +resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue + +instance HasEntity SuperCompanyTableData User where + hasEntity = resultSuperUser + +instance HasUser SuperCompanyTableData where + hasUser = resultSuperUser . _entityVal + + +mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget) +mkFirmSuperTable isAdmin cid = do + let + -- fsh = unCompanyKey cid + resultDBTable = DBTable{..} + where + dbtSQLQuery = \usr -> do + -- refactor this + let subs = do + (usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor + `E.innerJoin` E.table @UserCompany + `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser) + E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId + E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid + subs' = do + (usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor + `E.innerJoin` E.table @UserCompany + `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser) + E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId + E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid + E.&&. usrSpr E.^. UserSupervisorRerouteNotifications + E.where_ $ E.exists subs + return (usr, E.subSelectCount subs, E.subSelectCount subs') + dbtRowKey = querySuperUser >>> (E.^. UserId) + dbtProj = dbtProjId + dbtColonnade = formColonnade $ mconcat + [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey)) + , colUserNameModalHdr MsgTableSupervisor ForProfileDataR + , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \(view resultSuperUser -> entUsr) -> cellHasMatrikelnummerLinked entUsr + , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t + , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultSuperUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b + , colUserEmail + , sortable Nothing (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr + , sortable Nothing (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr + ] + dbtSorting = mconcat + [ single $ sortUserNameLink querySuperUser + , single $ sortUserEmail querySuperUser + , singletonMap "matriculation" $ SortColumn $ querySuperUser >>> (E.^. UserMatrikelnummer) + , singletonMap "personal-number" $ SortColumn $ querySuperUser >>> (E.^. UserCompanyPersonalNumber) + , singletonMap "postal-pref" $ SortColumn $ querySuperUser >>> (E.^. UserPrefersPostal) + ] + dbtFilter = mconcat + [ single $ fltrUserNameEmail querySuperUser + ] + dbtFilterUI mPrev = mconcat + [ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev + ] + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } + acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData) + acts = mconcat + [ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData + , singletonMap FirmSuperActRMSuperDef $ pure FirmSuperActRMSuperDefData + , singletonMap FirmSuperActRMSuperAll $ pure FirmSuperActRMSuperAllData + ] + dbtParams = DBParamsForm + { dbParamsFormMethod = POST + , dbParamsFormAction = Nothing + , dbParamsFormAttrs = [] + , dbParamsFormSubmit = FormSubmit + , dbParamsFormAdditional + = renderAForm FormStandard $ (, mempty) . First . Just + <$> multiActionA acts (fslI MsgTableAction) Nothing + , dbParamsFormEvaluate = liftHandler . runFormPost + , dbParamsFormResult = id + , dbParamsFormIdent = def + } + dbtIdent :: Text + dbtIdent = "firm-supervisors" + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing + dbtExtraReps = [] + + postprocess :: FormResult (First FirmSuperActionData, DBFormResult UserId Bool SuperCompanyTableData) + -> FormResult ( FirmSuperActionData, Set UserId) + postprocess inp = do + (First (Just act), m) <- inp + let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m + return (act, s) + + resultDBTableValidator = def + & defaultSorting [SortAscBy "user-name"] + over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable + + getFirmSupersR, postFirmSupersR :: CompanyShorthand -> Handler Html getFirmSupersR = postFirmSupersR postFirmSupersR fsh = do - let _fshId = CompanyKey fsh + isAdmin <- hasReadAccessTo AdminR + let fshId = CompanyKey fsh + (Company{..},(fsprRes,fsprTable)) <- runDB $ (,) + <$> get404 fshId + <*> mkFirmSuperTable isAdmin fshId + + formResult fsprRes $ \case + (FirmSuperActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " supervisors. TODO" + (FirmSuperActRMSuperDefData, fids) -> addMessage Info $ text2Html $ "Remove " <> tshow (length fids) <> " default supervisors. TODO" + (FirmSuperActRMSuperAllData, fids) -> addMessage Info $ text2Html $ "Make " <> tshow (length fids) <> " default and active supervisors. TODO" + siteLayout (citext2widget fsh) $ do setTitle $ citext2Html fsh - [whamlet|!!!STUB!!!TO DO!!!|] + -- TODO: factor out company info section hamlet here and from user table + [whamlet| +
+

!!!STUB!!!TO DO!!! +
+
+ $maybe fem <- companyEmail +
+ _{MsgFirmEmail} #{iconLetterOrEmail False} +
+ #{mailtoHtml fem} + $maybe addr <- companyPostAddress +
+ _{MsgFirmAddress} #{iconLetterOrEmail True} +
+ #{addr} +
+ ^{fsprTable} + |] diff --git a/templates/firm-users.hamlet b/templates/firm-users.hamlet index f9224bd3a..0da59383f 100644 --- a/templates/firm-users.hamlet +++ b/templates/firm-users.hamlet @@ -32,12 +32,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later _{MsgFirmDefaultPreferenceInfo} _{MsgTableCompanyNrUsers} - _{MsgTableCompanyNrForeignSupers} + _{MsgTableCompanyNrForeignSupers} #{nrCompanyUsers} #{nrCompanyForeignSupers} - - Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel. + + Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel. _{MsgTableCompanyNrEmpSupervised} @@ -51,12 +51,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later #{nrCompanyActiveReroutes} - Anzahl Firmenangehörige, für die derzeit mindestens ein Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! + Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! - Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! + Mindestens ein Ansprechpartner mit Umleitung. - Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist, welcher den Versand per Briefpost bevorzugt. # - Ob ein Ansprechpartner Email oder Briefpost wünscht ist eine individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner. + Email oder Brief ist individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner. Gesamtzahl aller aktiven Benachrichtigungsumleitungen. #