chore(firm): add supervisor table stub
This commit is contained in:
parent
a42e8a88f0
commit
53f54189f9
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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|
|
||||
<section>
|
||||
<h2>!!!STUB!!!TO DO!!!
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe fem <- companyEmail
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmEmail} #{iconLetterOrEmail False}
|
||||
<dd .deflist__dd .email>
|
||||
#{mailtoHtml fem}
|
||||
$maybe addr <- companyPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmAddress} #{iconLetterOrEmail True}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
<section>
|
||||
^{fsprTable}
|
||||
|]
|
||||
|
||||
@ -32,12 +32,12 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<td .table__td>_{MsgFirmDefaultPreferenceInfo}
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgTableCompanyNrUsers}
|
||||
<th .table__th>_{MsgTableCompanyNrForeignSupers}
|
||||
<th .table__th colspan=3>_{MsgTableCompanyNrForeignSupers}
|
||||
<tr .table__row>
|
||||
<td .table__td>#{nrCompanyUsers}
|
||||
<td .table__td>#{nrCompanyForeignSupers}
|
||||
<td .table__td>
|
||||
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.
|
||||
<td .table__td colspan=2>
|
||||
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.
|
||||
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgTableCompanyNrEmpSupervised}
|
||||
@ -51,12 +51,11 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<td .table__td>#{nrCompanyActiveReroutes}
|
||||
<tr .table__row>
|
||||
<td .table__td>
|
||||
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!
|
||||
<td .table__td>
|
||||
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.
|
||||
<td .table__td>
|
||||
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.
|
||||
<td .table__td>
|
||||
Gesamtzahl aller aktiven Benachrichtigungsumleitungen. #
|
||||
<em>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user