From a926cc07746afa2e72034c4eec869585990d9623 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 30 Nov 2022 18:42:40 +0100 Subject: [PATCH] chore(profile): show company, supervisors and supervisees --- .../personal_settings/de-de-formal.msg | 4 ++++ .../settings/personal_settings/en-eu.msg | 4 ++++ src/Handler/Profile.hs | 21 +++++++++++++++++++ src/Handler/Utils/Widgets.hs | 5 +++++ src/Utils.hs | 3 +++ src/Utils/Icon.hs | 2 ++ templates/profileData.hamlet | 13 ++++++++++++ test/Database/Fill.hs | 17 ++++++++++++--- 8 files changed, 66 insertions(+), 3 deletions(-) diff --git a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg index 06b915786..147d89ded 100644 --- a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg @@ -27,7 +27,11 @@ ProfileCorrectorRemark: Die oberhalb angezeigte Tabelle zeigt nur prinzipielle E ProfileCorrections: Auflistung aller zugewiesenen Korrekturen Remarks: Hinweise +ProfileSupervisor: Übergeordnete Ansprechpartner +ProfileSupervisee: Ist Ansprechpartner für + UserTelephone: Telefon UserMobile: Mobiltelefon +Company: Firmenzugehörigkeit CompanyPersonalNumber: Personalnummer (nur Fraport AG) CompanyDepartment: Abteilung \ No newline at end of file diff --git a/messages/uniworx/categories/settings/personal_settings/en-eu.msg b/messages/uniworx/categories/settings/personal_settings/en-eu.msg index e39556769..cc3c63c19 100644 --- a/messages/uniworx/categories/settings/personal_settings/en-eu.msg +++ b/messages/uniworx/categories/settings/personal_settings/en-eu.msg @@ -27,7 +27,11 @@ ProfileCorrectorRemark: The table above only shows registration as a corrector i ProfileCorrections: List of all assigned corrections Remarks: Remarks +ProfileSupervisor: Supervised by +ProfileSupervisee: Supervises + UserTelephone: Phone UserMobile: Mobile +Company: Company affilitaion CompanyPersonalNumber: Personnel number (Fraport AG only) CompanyDepartment: Department \ No newline at end of file diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 7c8660ee2..a7e60b53c 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -664,6 +664,27 @@ makeProfileData (Entity uid User{..}) = do E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId return (studyfeat, studydegree, studyterms) + companies' <- E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do + E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid + E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId + return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor) + let companies = intersperse (text2markup ", ") $ + (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies' + icnSuper = text2markup " " <> icon IconSupervisor + supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do + E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid + E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId + return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications) + let supervisors = intersperse (text2widget ", ") $ + (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisors' + icnReroute = text2widget " " <> toWgt (icon IconLetter) + supervisees' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do + E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid + E.on $ spvr E.^. UserSupervisorUser E.==. usrSpvr E.^. UserId + return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications) + let supervisees = intersperse (text2widget ", ") $ + (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisees' + -- icnReroute = text2widget " " <> toWgt (icon IconLetter) --Tables (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid -- Tabelle mit eigenen Kursen enrolledCoursesTable <- mkEnrolledCoursesTable uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs index 9e375da20..52d205d30 100644 --- a/src/Handler/Utils/Widgets.hs +++ b/src/Handler/Utils/Widgets.hs @@ -59,6 +59,11 @@ nameWidget displayName surname = toWidget $ nameHtml displayName surname userWidget :: HasUser c => c -> Widget userWidget x = nameWidget (x ^. _userDisplayName) (x ^._userSurname) +linkUserWidget :: HasRoute UniWorX url => (CryptoUUIDUser -> url) -> Entity User -> Widget +linkUserWidget lnk (Entity uid usr) = do + uuid <- encrypt uid + simpleLink (userWidget usr) (lnk uuid) + -- | toWidget-Version of @nameEmailHtml@, for convenience nameEmailWidget :: UserEmail -- ^ userEmail -> Text -- ^ userDisplayName diff --git a/src/Utils.hs b/src/Utils.hs index 7d023a4b3..e8eedbadb 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -363,6 +363,9 @@ toWgt :: ToMarkup a toWgt = toWidget . toHtml -- Convenience Functions to avoid type signatures: +text2markup :: Text -> Markup +text2markup t = [shamlet|#{t}|] + text2widget :: Text -> WidgetFor site () text2widget t = [whamlet|#{t}|] diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index 948afe9de..8dd017bb8 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -112,6 +112,7 @@ data Icon | IconPrintCenter | IconLetter | IconAt + | IconSupervisor deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) @@ -203,6 +204,7 @@ iconText = \case IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk" IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well IconAt -> "at" + IconSupervisor -> "head-side" -- must be notably different to user nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 1255bb71e..17d4f05fc 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -68,6 +68,19 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later _{MsgCompanyPersonalNumber}
#{companyPersonalNumber} + $if not $ null companies +
+ _{MsgCompany} +
+ ^{toWgt (mconcat companies)} + $if not $ null supervisors +
_{MsgProfileSupervisor} +
+ ^{mconcat supervisors} + $if not $ null supervisees +
_{MsgProfileSupervisee} +
+ ^{mconcat supervisees} $if showAdminInfo
_{MsgUserCreated} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index eb636861d..6f7a305a5 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -478,11 +478,22 @@ fillDb = do I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course. |] } - _fraportAg <- insert' $ Company "Fraport AG" "Fraport" + fraportAg <- insert' $ Company "Fraport AG" "Fraport" _fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" - _nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" + nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" _ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" - _bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" + bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" + void . insert' $ UserCompany jost fraportAg True + void . insert' $ UserCompany svaupel nice True + void . insert' $ UserCompany gkleen nice False + void . insert' $ UserCompany fhamann bpol False + void . insert' $ UserSupervisor jost gkleen True + void . insert' $ UserSupervisor jost svaupel False + void . insert' $ UserSupervisor jost sbarth False + void . insert' $ UserSupervisor jost tinaTester True + void . insert' $ UserSupervisor svaupel gkleen False + void . insert' $ UserSupervisor svaupel fhamann True + void . insert' $ UserSupervisor sbarth tinaTester True ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True