chore(profile): towards #169

-  profile supervison streamlined (WIP)

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.

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.

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)
+noneMoreDE :: (Eq a, Num a)
---             =>    a -- ^ Count
+            =>    a -- ^ Count
---             -> Text -- ^ None
+            -> Text -- ^ None
---             -> Text -- ^ Some
+            -> Text -- ^ Some
---             -> Text
+            -> Text
--- noneMoreDE num noneText someText
+noneMoreDE num noneText someText
---   | num == 0  = noneText
+  | num == 0  = noneText
---   | otherwise = someText
+  | 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)
+noneMoreEN :: (Eq a, Num a)
---             =>    a -- ^ Count
+            =>    a -- ^ Count
---             -> Text -- ^ None
+            -> Text -- ^ None
---             -> Text -- ^ Some
+            -> Text -- ^ Some
---             -> Text
+            -> Text
--- noneMoreEN num noneText someText
+noneMoreEN num noneText someText
---   | num == 0  = noneText
+  | num == 0  = noneText
---   | otherwise = someText
+  | 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 <> ">"

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))
+            [ ("demo-both",     SortColumns $ queryCourse &&& queryExam >>> (\(course,exam)-> [SomeExprValue $ course E.^. CourseShorthand, SomeExprValue $ exam E.^. ExamName]))
-            , ("term",          SortColumn $ queryCourse >>> (E.^. CourseTerm      ))
+            , ("term",          SortColumn  $ queryCourse >>> (E.^. CourseTerm      ))
-            , ("school",        SortColumn $ queryCourse >>> (E.^. CourseSchool    ))
+            , ("school",        SortColumn  $ queryCourse >>> (E.^. CourseSchool    ))
-            , ("course",        SortColumn $ queryCourse >>> (E.^. CourseShorthand ))
+            , ("course",        SortColumn  $ queryCourse >>> (E.^. CourseShorthand ))
-            , ("name",          SortColumn $ queryExam >>> (E.^. ExamName ))
+            , ("name",          SortColumn  $ queryExam >>> (E.^. ExamName ))
-            , ("time",          SortColumn $ queryExam >>> (E.^. ExamStart ))
+            , ("time",          SortColumn  $ queryExam >>> (E.^. ExamStart ))
-            , ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom ))
+            , ("register-from", SortColumn  $ queryExam >>> (E.^. ExamRegisterFrom ))
-            , ("register-to",   SortColumn $ queryExam >>> (E.^. ExamRegisterTo ))
+            , ("register-to",   SortColumn  $ queryExam >>> (E.^. ExamRegisterTo ))
-            , ("visible",       SortColumn $ queryExam >>> (E.^. ExamVisibleFrom ))
+            , ("visible",       SortColumn  $ queryExam >>> (E.^. ExamVisibleFrom ))
-            , ("registered",    SortColumn $ queryExam >>> (\exam ->
+            , ("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

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' _   Nothing       _ (False, _ ) = mempty
--- maybeTable' _   (Just nodata) _ (False, _ ) =
+maybeTable' _   (Just nodata) _ (False, _ ) =
---   [whamlet|
+  [whamlet|
---     <div .container>
+    <div .container>
---       _{nodata}
+      _{nodata}
---   |]
+  |]
--- maybeTable' hdr _ mbRemark      (True ,tbl) =
+maybeTable' hdr _ mbRemark      (True ,tbl) =
-maybeTable' hdr _ mbRemark      (_ ,tbl) =
   [whamlet|
     <div .container>
       <h2> _{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 :: UserId -> DB ((Sum Int, Sum Int, Sum Int), Widget)
-mkSupervisorsTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..}
+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 "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 "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

templates/profileData.hamlet

@@ -186,7 +186,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
                     ^{formatTimeW SelFormatDateTime studyFeaturesLastObserved}
 <section>
 
-  ^{maybeTable' MsgProfileSupervisor (Just MsgProfileNoSupervisor) Nothing supervisorsTable}
+  ^{supervisorsWgt}
   
   ^{maybeTable' MsgProfileSupervisee (Just MsgProfileNoSupervisee) (Just (msg2widget MsgProfileSuperviseeReroute <> toWgt (iconLetterOrEmail userPrefersPostal))) superviseesTable}