chore(mail): view page for receivers working now and polished

This commit is contained in:
Steffen Jost 2025-02-10 17:28:06 +01:00 committed by Sarah Vaupel
parent 0a4ad611c7
commit 5e0df28444
15 changed files with 96 additions and 53 deletions

View File

@ -70,9 +70,9 @@ CourseInvalidInput: Eingaben bitte korrigieren.
CourseEditTitle: Kursart editieren/anlegen
CourseEditOk tid@TermId ssh@SchoolId csh@CourseShorthand: Kursart #{tid}-#{ssh}-#{csh} wurde erfolgreich geändert.
CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kursart #{tid}-#{ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen andere Kursart mit dem selben Kürzel oder Titel in diesem Jahr und Bereich.
CourseEditQualificationFail: Eine Qualifikation konnte uas unbekanntem Grund nicht mit diesem Kurs assoziert werden.
CourseEditQualificationFailRights qsh@QualificationShorthand ssh@SchoolId: Qualifikation #{qsh} konnte nicht mit diesem Kurs assoziert werden, da Ihre Berechtigungen für Bereich #{ssh} dazu nicht ausreichen.
CourseEditQualificationFailExists: Diese Qualifikation ist bereits assoziert
CourseEditQualificationFail: Eine Qualifikation konnte uas unbekanntem Grund nicht mit diesem Kurs assoziiert werden.
CourseEditQualificationFailRights qsh@QualificationShorthand ssh@SchoolId: Qualifikation #{qsh} konnte nicht mit diesem Kurs assoziiert werden, da Ihre Berechtigungen für Bereich #{ssh} dazu nicht ausreichen.
CourseEditQualificationFailExists: Diese Qualifikation ist bereits assoziiert
CourseEditQualificationFailOrder: Diese Sortierpriorität existiert bereits
CourseLecturer: Kursverwalter:in
MailSubjectParticipantInvitation tid@TermId ssh@SchoolId csh@CourseShorthand: [#{tid}-#{ssh}-#{csh}] Einladung zur Kursartteilnahme

View File

@ -223,7 +223,7 @@ ExamRegisteredCountOf num@Int64 count@Int64 !ident-ok: #{num}/#{count}
ExamOccurrences: Termine
ExamOccurrencesCopied num@Int: #{pluralDEeN num "Prüfungstermin"} kopiert
ExamOccurrencesEdited num@Int del@Int: #{pluralENsN num "Prüfungstermin"} geändert #{guardMonoid (del > 0) ("und " <> pluralENsN num "Prüfungstermin" <> " gelöscht")}
ExamOccurrenceCopyNoStartDate: Dieser Kurs hat noch keine eigene Termine um Prüfungstermine zeitlich damit zu assozieren
ExamOccurrenceCopyNoStartDate: Dieser Kurs hat noch keine eigene Termine um Prüfungstermine zeitlich damit zu assoziieren
ExamOccurrenceCopyFail: Keine passenden Prüfungstermine zum Kopieren gefunden
GradingFrom: Ab
ExamNoShow: Nicht erschienen

View File

@ -81,3 +81,5 @@ CompanyUserPriorityTip: Firmenpriorität ist lediglich relativ zu anderen Firmen
CompanyUserUseCompanyAddress: Verwendet Firmenkontaktaddresse
CompanyUserUseCompanyAddressTip: sofern im Benutzer keine Postanschrift hinterlegt ist
CompanyUserUseCompanyPostalError: Postalische Adresse muss leer bleiben, damit die Firmenanschrift genutzt wird!
CompanySupervisorCompanyMissing fsh@CompanyShorthand: Empfänger ist nicht mit Firma #{fsh} aus Ansprechpartnerbeziehung assoziiert
CompanySuperviseeCompanyMissing fsh@CompanyShorthand: Betroffener ist nicht mit Firma #{fsh} aus Ansprechpartnerbeziehung assoziiert

View File

@ -81,3 +81,5 @@ CompanyUserPriorityTip: Company priority is relative to other company associatio
CompanyUserUseCompanyAddress: Use company postal address
CompanyUserUseCompanyAddressTip: if and only if the postal address of the user is empty
CompanyUserUseCompanyPostalError: Individual postal address must left empty for the company address to be used!
CompanySupervisorCompanyMissing fsh: Reciver is not associated with #{fsh} given as reroute reason
CompanySuperviseeCompanyMissing fsh: Supervisee is not associated with #{fsh} detailed as supervisonship reason

View File

@ -36,7 +36,7 @@ ProfileSuperviseeRemark n m: This person supervises #{pluralENsN n "person"}#{no
UserTelephone: Phone
UserMobile: Mobile
Company: Company affilitaion
Company: Company affiliation
CompanyPersonalNumber: Personnel number
CompanyPersonalNumberFraport: Personnel number (Fraport AG only)
CompanyDepartment: Department

View File

@ -117,4 +117,5 @@ UserCompanyReason: Begründung der Firmenassoziation
UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
UserSupervisorReason: Begründung Ansprechpartner
UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
UserSupervisorCompany: Ansprechpartner wegen Firma
AdminUserAllNotifications: Alle Benachrichtigungen and diesen Benutzer

View File

@ -117,4 +117,5 @@ UserCompanyReason: Reason for company association
UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
UserSupervisorReason: Reason for supervision
UserSupervisorReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
UserSupervisorCompany: Supervisor for company
AdminUserAllNotifications: All notification sent to this user

View File

@ -1130,7 +1130,7 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
in if isReroute
then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
else mempty
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc companyIdCell
, sortable (Just "reason") (i18nCell MsgTableReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell
]
validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
@ -1180,7 +1180,7 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget' validator DBTable{..}
, sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
in boolCell isReroute $ iconCell IconReroute <> iconCellLetterOrEmail
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc companyIdCell
, sortable (Just "reason") (i18nCell MsgTableReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell
]
validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
@ -1213,8 +1213,8 @@ instance HasUser TblReceiverData where
hasUser = _dbrOutput . _1 . _entityVal
-- | Table listing all supervisor of the given user
mkReceiversTable :: UserId -> [Entity User] -> DB Widget
mkReceiversTable uid receivers = dbTableDB' validator DBTable{..}
mkReceiversTable :: UserId -> [CompanyShorthand] -> [Entity User] -> DB Widget
mkReceiversTable uid usrCmps receivers = dbTableDB' validator DBTable{..}
where
dbtIdent = "receivers" :: Text
dbtStyle = def
@ -1240,6 +1240,7 @@ mkReceiversTable uid receivers = dbTableDB' validator DBTable{..}
dbtColonnade = mconcat
[ colUserNameModalHdr MsgCommRecipients ForProfileDataR
-- , colUserEmail
-- , colUserLetterEmailPin
, sortable Nothing (i18nCell MsgAddress) $ \(view resultReceiver -> rcvr) -> sqlCell $ -- recall: requires dbTableDB' above!
getPostalPreferenceAndAddress' rcvr >>= \case
(False, _, (Just eml, auto)) -> do -- email
@ -1259,39 +1260,49 @@ mkReceiversTable uid receivers = dbTableDB' validator DBTable{..}
#{postal}
|]
_ -> return $ msg2widget MsgNoContactAddress
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \(view $ resultReceiver . _entityKey -> ruid) -> sqlCell
(maybeMonoid <$> wgtCompanies ruid) -- TODO: user wgtCompanies' to check mismatch in companies
-- , colUserLetterEmailPin
-- , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> indicatorCell <> ifIconCell b IconReroute
-- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
-- , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
-- let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
-- in if isReroute
-- then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
-- else mempty
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorCompany . _Just -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
, sortable (Just "reason") (i18nCell MsgTableReason) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorReason . _Just -> mr) -> maybeCell mr textCell
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \row -> sqlCell $ do
let ruid = row ^. resultReceiver . _entityKey
rcmp = row ^? resultReceiverSupervisor . _entityVal . _userSupervisorCompany . _Just . to unCompanyKey
errWgt fsh = let emsg = MsgCompanySupervisorCompanyMissing fsh
in [whamlet|^{messageTooltip =<< messageI Error emsg} _{emsg}|]
cmps <- wgtCompanies' ruid
return $ case (cmps, rcmp) of
(Just (cwgt, cmpsData), Just svcsh)
| svcsh `notElem` (cmpsData ^.. traverse . _1) ->
[whamlet|$newline never
<ul .list--iconless>
^{cwgt}
<p>
^{errWgt svcsh}
|]
(Just (cwgt,_),_) -> [whamlet|<ul .list--iconless>^{cwgt}|]
(Nothing, Just svcsh) -> errWgt svcsh
(Nothing, Nothing) -> mempty
, sortable (Just "reason") (i18nCell MsgUserSupervisorReason) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorReason . _Just -> mr) -> maybeCell mr textCell
, sortable (Just "cshort") (i18nCell MsgUserSupervisorCompany) $ \row ->
let mc = row ^? resultReceiverSupervisor . _entityVal . _userSupervisorCompany . _Just
errWgt fsh = let emsg = MsgCompanySuperviseeCompanyMissing fsh
in [whamlet|<p>^{messageTooltip =<< messageI Error emsg} _{emsg}|]
in case mc of
Nothing -> mempty
(Just sfid@(unCompanyKey -> sfsh))
| notNull usrCmps
, sfsh `notElem` usrCmps -> companyIdCell sfid <> wgtCell (errWgt sfsh)
| otherwise -> companyIdCell sfid
]
validator = def -- & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
dbtSorting = Map.fromList
[ sortUserNameLink queryReceiver
-- , sortUserLetterEmailPin queryReceiver
, sortUserEmail queryReceiver
-- , sortUserEmail queryReceiver
, ("user-company" , SortColumn (\row -> E.subSelect $ do
(cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
E.where_ $ usrCmp E.^. UserCompanyUser E.==. queryReceiver row E.^. UserId
E.orderBy [E.asc $ cmp E.^. CompanyName]
return (cmp E.^. CompanyName)
))
-- , singletonMap "postal-pref" $ SortColumn $ queryUser >>> (E.^. UserPrefersPostal)
-- , singletonMap "rerouted" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorRerouteNotifications)
-- -- , singletonMap "reroute" $ SortColumn $ queryUserSupervisor &&& queryUser >>> (\(spr,usr) -> mTuple (spr E.^. UserSupervisorRerouteNotifications) (usr E.^. UserPrefersPostal))
-- , singletonMap "reroute" $ SortColumns $ \row ->
-- [ SomeExprValue $ queryUserSupervisor row E.^. UserSupervisorRerouteNotifications
-- , SomeExprValue $ queryUser row E.^. UserPrefersPostal
-- ]
, ("cshort", SortColumn $ queryReceiverSupervisor >>> (E.?. UserSupervisorCompany))
, ("reason", SortColumn $ queryReceiverSupervisor >>> (E.?. UserSupervisorReason))
, ("cshort", SortColumn $ queryReceiverSupervisor >>> (E.?. UserSupervisorCompany))
]
dbtFilter = mconcat
[ singletonMap & uncurry $ fltrUserNameEmail queryReceiver
@ -1458,16 +1469,18 @@ postLangR = do
getUserRecipientsR :: CryptoUUIDUser -> Handler Html
getUserRecipientsR uuid = do
uid <- decrypt uuid
(usr, receivers, usrReceives) <- updateReceivers uid -- if this is two due to the AVS queries, try Handler.Utils.getReceivers instead
(usr, receivers, usrReceives) <- updateReceivers uid -- use Handler.Utils.getReceivers instead to avoid AVS queries
mrtbl <- case receivers of
[] -> return Nothing -- no receivers
[_] | usrReceives -> return Nothing -- only user receives for themself
_ -> Just <$> runDB (mkReceiversTable uid receivers)
_ -> runDB $ do
usrCmps <- wgtCompanies' uid
let fshs :: [CompanyShorthand] = usrCmps ^.. _Just . _2 . traverse . _1
rtbl <- mkReceiversTable uid fshs receivers
return $ Just (rtbl, fst <$> usrCmps)
let heading = MsgUserRecipientsTitle $ usr ^. _userDisplayName
usrWgt = userWidget usr
hasPwd = isJust $ usr ^. _userPinPassword
usrWgt = userWidget usr
hasPwd = isJust $ usr ^. _userPinPassword
siteLayoutMsg heading $ do
setTitleI heading
$(i18nWidgetFile "user-receivers")

View File

@ -2,6 +2,7 @@
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE BlockArguments #-} -- do starts is own block
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Handler.Utils.Company where
@ -38,38 +39,40 @@ company2msg :: CompanyId -> SomeMessage UniWorX
company2msg = text2message . ciOriginal . unCompanyKey
wgtCompanies :: UserId -> DB (Maybe Widget)
wgtCompanies = (fst <<$>>) . wgtCompanies'
wgtCompanies = (wrapUL . fst <<$>>) . wgtCompanies'
where
wrapUL wgt = [whamlet|<ul .list--iconless>^{wgt}|]
-- | Given a UserId, create widgets showing top-companies (with internal link) and associated companies (unlinked)
wgtCompanies' :: UserId -> DB (Maybe (Widget, [CompanyShorthand]))
-- | Given a UserId, create widget showing top-companies (with internal link) and associated companies (unlinked)
-- NOTE: The widget must be wrapped with <ul>
wgtCompanies' :: UserId -> DB (Maybe (Widget, [(CompanyShorthand,CompanyName,Bool,Int)]))
wgtCompanies' uid = do
companies <- E.select $ do
companies <- $(E.unValueN 4) <<$>> E.select do
(usrComp :& comp) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @Company
`E.on` (\(usrComp :& comp) -> usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId)
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor, usrComp E.^. UserCompanyPriority)
let (mPri, topCmp, otherCmp, topIds) = procCmp mPri companies
let (mPri, topCmp, otherCmp) = procCmp mPri companies
resWgt =
[whamlet|
$forall c <- topCmp
<p>
<li>
^{c}
$forall c <- otherCmp
<p>
<li>
^{c}
|]
return $ toMaybe (notNull topCmp) (resWgt, topIds)
return $ toMaybe (notNull companies) (resWgt, companies)
where
procCmp _ [] = (0, [], [], [])
procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
procCmp _ [] = (0, [], [])
procCmp maxPri ((cmpSh, cmpName, cmpSpr, cmpPrio) : cs) =
let isTop = cmpPrio >= maxPri
cmpWgt = companyWidget isTop (cmpSh, cmpName, cmpSpr)
(accPri,accTop,accRem,accTopId) = procCmp maxPri cs
(accPri,accTop,accRem) = procCmp maxPri cs
in ( max cmpPrio accPri
, bool accTop (cmpWgt : accTop) isTop -- lazy evaluation after repmin example, don't factor out the bool!
, bool (cmpWgt : accRem) accRem isTop
, bool accTopId (cmpSh : accTopId) isTop
)
type AnySuperReason = Either SupervisorReason (Maybe Text)

View File

@ -229,7 +229,7 @@ cellMailPrefPin usr =
rwgt = do
uuid <- liftHandler $ encrypt uid
modal (widgetMailPrefPin userEntity) (Left $ SomeRoute $ UserRecipientsR uuid)
in cell rwgt -- addIconFixedWidth
in cell rwgt
-- cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
-- cellMailPrefPin usr =

View File

@ -172,7 +172,7 @@ companyWidget isPrimary (csh, cname, isSupervisor)
| isSupervisor = text2markup (corg <> " ")
| otherwise = text2markup corg
widgetMailPrefPin :: HasUser u => u -> Widget -- TODO: move to appropriate module
widgetMailPrefPin :: HasUser u => u -> Widget
widgetMailPrefPin usr = if not prefPost && hasPin
then [whamlet|^{modWgt} ^{pinWgt}|]
else modWgt

View File

@ -862,6 +862,11 @@ listBracket b@(s,e) (h:t)
| e == h1 = Just $ reverse l1
| otherwise = listUntil (h1:l1) t1
-- Test whether two lists are disjoint. Not efficient due to lack of Ord instance.
-- disjoint :: Eq a => [a] -> [a] -> Bool
-- disjoint [] _ = True
-- disjoint (x:xs) ys = x `notElem` ys && disjoint xs ys
----------
-- Sets --

View File

@ -19,9 +19,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
gehen tatsächlich nur an die unten aufgeführten Personen:
$nothing
werden momentan an niemanden zugestellt!
$maybe tbl <- mrtbl
$maybe (tbl, mbUsrCmps) <- mrtbl
<p>
^{tbl}
<p>
$maybe usrCmps <- mbUsrCmps
<h4>
_{MsgCompany} ^{usrWgt}:
<ul .list--inline .list--comma-separated>
^{usrCmps}
$nothing
Für ^{usrWgt} ist momentan keine Firmenzugehörigkeit bekannt.
<p>
<h4>
Hinweis:

View File

@ -18,9 +18,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
are only sent to the following persons instead:
$nothing
are currently not delivered to anyone!
$maybe tbl <- mrtbl
$maybe (tbl, mbUsrCmps) <- mrtbl
<p>
^{tbl}
<p>
$maybe usrCmps <- mbUsrCmps
<h4>
_{MsgCompany} ^{usrWgt}:
<ul .list--inline .list--comma-separated>
^{usrCmps}
$nothing
^{usrWgt} is currently not affiliated with any company.
<p>
<h4>
Note:

View File

@ -695,7 +695,7 @@ fillDb = do
, UserSupervisor jost jost True (Just fraportAg) (Just "Staff")
, UserSupervisor svaupel gkleen False (Just nice) (Just "Staff")
, UserSupervisor svaupel fhamann True (Just nice) (Just "Staff")
, UserSupervisor sbarth tinaTester True (Just nice) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor sbarth tinaTester True (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor gkleen fhamann False (Just fraGround) (Just "Staff")
, UserSupervisor gkleen gkleen True (Just fraGround) (Just "Staff")
, UserSupervisor tinaTester tinaTester False Nothing (Just "Staff")