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 e263e10e3..31d8305d1 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,7 @@ ProfileCorrectorRemark: Die oberhalb angezeigte Tabelle zeigt nur prinzipielle E ProfileCorrections: Auflistung aller zugewiesenen Korrekturen Remarks: Hinweise -ProfileSupervisor: Übergeordnete Ansprechpartner +ProfileSupervisor n@Int m@Int: #{n} #{pluralDE n "übergeordneter" "übergeordnete"} Ansprechpartner#{noneMoreDE m "" ", davon " <> tshow m <> " mit Benachrichtigungsumleitung"} ProfileNoSupervisor: Keine übergeordneten Ansprechpartner vorhanden. ProfileSupervisee: Ist Ansprechpartner für ProfileNoSupervisee: Ist kein Ansprechpartner für irgendjemand. diff --git a/messages/uniworx/categories/settings/personal_settings/en-eu.msg b/messages/uniworx/categories/settings/personal_settings/en-eu.msg index 5e72539b9..9c0947c41 100644 --- a/messages/uniworx/categories/settings/personal_settings/en-eu.msg +++ b/messages/uniworx/categories/settings/personal_settings/en-eu.msg @@ -27,7 +27,7 @@ ProfileCorrectorRemark: The table above only shows registration as a corrector i ProfileCorrections: List of all assigned corrections Remarks: Remarks -ProfileSupervisor: Supervised by +ProfileSupervisor n m: #{pluralENsN n "Supervisor"}#{noneMoreEN m "" " with " <> tshow m <> " active notification rerouting"} ProfileNoSupervisor: Is not supervised by anynone. ProfileSupervisee: Supervises ProfileNoSupervisee: Does not supervise anynone. diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index b1ac4ce01..9eab3e2da 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -39,7 +39,7 @@ module Foundation.I18n , StudyDegreeTerm(..) , ShortStudyFieldType(..) , StudyDegreeTermType(..) - , ErrorResponseTitle(..) + , ErrorResponseTitle(..) , UniWorXMessages(..) , uniworxMessages , unRenderMessage, unRenderMessage', unRenderMessageLenient @@ -88,15 +88,14 @@ pluralDE num singularForm pluralForm | otherwise = pluralForm pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text --- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ pluralDEx c n t = pluralDE n t $ t `snoc` c --- | like `pluralDEe` but also prefixes with the number +-- | like `pluralDEx` but also prefixes with the number pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t) pluralDEe :: (Eq a, Num a) => a -> Text -> Text --- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ +-- ^ @pluralDEe n "Monat" = pluralDEe n "Monat" "Monate"@ pluralDEe = pluralDEx 'e' -- | like `pluralDEe` but also prefixes with the number @@ -105,7 +104,7 @@ pluralDEeN = pluralDExN 'e' -- | postfix plural with an 'n' pluralDEn :: (Eq a, Num a) => a -> Text -> Text --- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ +-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ pluralDEn = pluralDEx 'n' -- | like `pluralDEn` but also prefixes with the number @@ -124,14 +123,14 @@ noneOneMoreDE num noneText singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm --- noneMoreDE :: (Eq a, Num a) --- => a -- ^ Count --- -> Text -- ^ None --- -> Text -- ^ Some --- -> Text --- noneMoreDE num noneText someText --- | num == 0 = noneText --- | otherwise = someText +noneMoreDE :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Some + -> Text +noneMoreDE num noneText someText + | num == 0 = noneText + | otherwise = someText pluralEN :: (Eq a, Num a) => a -- ^ Count @@ -146,7 +145,7 @@ pluralENs :: (Eq a, Num a) => a -- ^ Count -> Text -- ^ Singular -> Text --- ^ @pluralENs n "foo" = pluralEN n "foo" "foos"@ +-- ^ @pluralENs n "foo" = pluralEN n "foo" "foos"@ pluralENs n t = pluralEN n t $ t `snoc` 's' -- | like `pluralENs` but also prefixes with the number @@ -164,14 +163,14 @@ noneOneMoreEN num noneText singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm --- noneMoreEN :: (Eq a, Num a) --- => a -- ^ Count --- -> Text -- ^ None --- -> Text -- ^ Some --- -> Text --- noneMoreEN num noneText someText --- | num == 0 = noneText --- | otherwise = someText +noneMoreEN :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Some + -> Text +noneMoreEN num noneText someText + | num == 0 = noneText + | otherwise = someText _ordinalEN :: ToMessage a => a @@ -191,20 +190,20 @@ notEN :: Bool -> Text notEN = bool "not" "" {- -- TODO: use this is message eventually --- Commonly used plurals +-- Commonly used plurals data Thing = Person | Examinee deriving (Eq) -thingDE :: Int -> Thing -> Text +thingDE :: Int -> Thing -> Text thingDE num = (tshow num <>) . Text.cons ' ' . thing - where + where thing :: Thing -> Text thing Person = pluralDE num "Person" "Personen" thing Examinee = pluralDE num "Prüfling" "Prüflinge" - -thingEN :: Int -> Thing -> Text + +thingEN :: Int -> Thing -> Text thingEN num t = tshow num <> Text.cons ' ' (thing t) - where + where thing :: Thing -> Text thing Person = pluralENs num "person" thing Examinee = pluralENs num "examinee" @@ -282,7 +281,7 @@ mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-forma embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) -newtype SomeMessages master = SomeMessages [SomeMessage master] +newtype SomeMessages master = SomeMessages [SomeMessage master] deriving newtype (Semigroup, Monoid) instance master ~ master' => RenderMessage master (SomeMessages master') where @@ -621,6 +620,6 @@ unRenderMessageLenient = unRenderMessage' cmp instance Default DateTimeFormatter where def = mkDateTimeFormatter (getTimeLocale' []) def appTZ -instance RenderMessage UniWorX Address where +instance RenderMessage UniWorX Address where renderMessage s l a@Address{addressName = Just aname} = aname <> cons ' ' (renderMessage s l a{addressName=Nothing}) renderMessage _ _ Address{addressEmail = mail} = "<" <> mail <> ">" diff --git a/src/Handler/News.hs b/src/Handler/News.hs index 0399d98c3..2ac689c39 100644 --- a/src/Handler/News.hs +++ b/src/Handler/News.hs @@ -13,7 +13,7 @@ import Handler.SystemMessage import qualified Data.Map.Strict as Map import qualified Data.Set as Set - + import Database.Esqueleto.Utils.TH import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E @@ -315,16 +315,16 @@ newsUpcomingExams uid = do | otherwise -> mempty ] dbtSorting = Map.fromList - [ ("demo-both", SortColumn $ queryCourse &&& queryExam >>> (\(_course,exam)-> exam E.^. ExamName)) - , ("term", SortColumn $ queryCourse >>> (E.^. CourseTerm )) - , ("school", SortColumn $ queryCourse >>> (E.^. CourseSchool )) - , ("course", SortColumn $ queryCourse >>> (E.^. CourseShorthand )) - , ("name", SortColumn $ queryExam >>> (E.^. ExamName )) - , ("time", SortColumn $ queryExam >>> (E.^. ExamStart )) - , ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom )) - , ("register-to", SortColumn $ queryExam >>> (E.^. ExamRegisterTo )) - , ("visible", SortColumn $ queryExam >>> (E.^. ExamVisibleFrom )) - , ("registered", SortColumn $ queryExam >>> (\exam -> + [ ("demo-both", SortColumns $ queryCourse &&& queryExam >>> (\(course,exam)-> [SomeExprValue $ course E.^. CourseShorthand, SomeExprValue $ exam E.^. ExamName])) + , ("term", SortColumn $ queryCourse >>> (E.^. CourseTerm )) + , ("school", SortColumn $ queryCourse >>> (E.^. CourseSchool )) + , ("course", SortColumn $ queryCourse >>> (E.^. CourseShorthand )) + , ("name", SortColumn $ queryExam >>> (E.^. ExamName )) + , ("time", SortColumn $ queryExam >>> (E.^. ExamStart )) + , ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom )) + , ("register-to", SortColumn $ queryExam >>> (E.^. ExamRegisterTo )) + , ("visible", SortColumn $ queryExam >>> (E.^. ExamVisibleFrom )) + , ("registered", SortColumn $ queryExam >>> (\exam -> E.exists $ E.from $ \registration -> do E.where_ $ registration E.^. ExamRegistrationUser E.==. E.val uid E.where_ $ registration E.^. ExamRegistrationExam E.==. exam E.^. ExamId diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 31beadcf6..c39eb30e4 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -602,14 +602,13 @@ maybeTable m = maybeTable' m Nothing Nothing maybeTable' :: (RenderMessage UniWorX a) => a -> Maybe a -> Maybe Widget -> (Bool, Widget) -> Widget --- maybeTable' _ Nothing _ (False, _ ) = mempty --- maybeTable' _ (Just nodata) _ (False, _ ) = --- [whamlet| ---
--- _{nodata} --- |] --- maybeTable' hdr _ mbRemark (True ,tbl) = -maybeTable' hdr _ mbRemark (_ ,tbl) = +maybeTable' _ Nothing _ (False, _ ) = mempty +maybeTable' _ (Just nodata) _ (False, _ ) = + [whamlet| +
+ _{nodata} + |] +maybeTable' hdr _ mbRemark (True ,tbl) = [whamlet|

_{hdr} @@ -667,6 +666,9 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do qualificationsTable <- mkQualificationsTable now uid -- Tabelle mit allen Qualifikationen supervisorsTable <- mkSupervisorsTable uid -- Tabelle mit allen Supervisors superviseesTable <- mkSuperviseesTable uid -- Tabelle mit allen Supervisees + let supervisorsWgt :: Widget = + let ((getSum -> nrSupers, getSum -> nrReroute, getSum -> _nrLetter), tWgt) = supervisorsTable + in maybeTable' (MsgProfileSupervisor nrSupers nrReroute) (Just MsgProfileNoSupervisor) Nothing (Any $ nrSupers > 0, tWgt) -- let examTable, ownTutorialTable, tutorialTable :: Widget -- examTable = i18n MsgPersonalInfoExamAchievementsWip -- ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip @@ -1059,8 +1061,8 @@ instance HasUser TblSupervisorData where hasUser = _dbrOutput . _1 . _entityVal -- | Table listing all supervisor of the given user -mkSupervisorsTable :: UserId -> DB (Bool, Widget) -mkSupervisorsTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} +mkSupervisorsTable :: UserId -> DB ((Sum Int, Sum Int, Sum Int), Widget) +mkSupervisorsTable uid = dbTableWidget validator DBTable{..} where dbtIdent = "userSupervisedBy" :: Text dbtStyle = def @@ -1075,8 +1077,15 @@ mkSupervisorsTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} dbtColonnade = mconcat [ colUserNameModalHdr MsgTableSupervisor ForProfileDataR , colUserEmail - , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute - , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b + -- , 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 + isLetter = row ^. resultUser . _userPrefersPostal + in tellCell (Sum 1, Sum $ fromEnum isReroute, Sum $ fromEnum $ isReroute && isLetter) $ + ifIconCell isReroute IconReroute + <> spacerCell <> + iconFixedCell (iconLetterOrEmail isLetter) , sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c) , sortable (Just "reason") (i18nCell MsgSupervisorReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell ] @@ -1086,6 +1095,11 @@ mkSupervisorsTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} , singletonMap & uncurry $ sortUserEmail queryUser , 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 + ] , singletonMap "cshort" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorCompany) , singletonMap "reason" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorReason) ] @@ -1114,7 +1128,8 @@ mkSuperviseesTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} dbtProj = dbtProjId dbtColonnade = mconcat - [ colUserNameModalHdr MsgTableSupervisee ForProfileDataR + [ sortable Nothing mempty $ const indicatorCell + , colUserNameModalHdr MsgTableSupervisee ForProfileDataR -- , colUserEmail , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index eaeafb282..d8e27fd7a 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -186,7 +186,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later ^{formatTimeW SelFormatDateTime studyFeaturesLastObserved}
- ^{maybeTable' MsgProfileSupervisor (Just MsgProfileNoSupervisor) Nothing supervisorsTable} + ^{supervisorsWgt} ^{maybeTable' MsgProfileSupervisee (Just MsgProfileNoSupervisee) (Just (msg2widget MsgProfileSuperviseeReroute <> toWgt (iconLetterOrEmail userPrefersPostal))) superviseesTable}