chore(profile): towards #169

- distinguished reroute icon
- profile cleaned/reordered

messages/uniworx/categories/settings/personal_settings/de-de-formal.msg

@@ -28,7 +28,10 @@ ProfileCorrections: Auflistung aller zugewiesenen Korrekturen
 Remarks: Hinweise
 
 ProfileSupervisor: Übergeordnete Ansprechpartner
+ProfileNoSupervisor: Keine übergeordneten Ansprechpartner vorhanden.
 ProfileSupervisee: Ist Ansprechpartner für
+ProfileNoSupervisee: Ist kein Ansprechpartner für irgendjemand.
+ProfileSuperviseeReroute: Umleitungen erfolgen per 
 
 UserTelephone: Telefon
 UserMobile: Mobiltelefon

messages/uniworx/categories/settings/personal_settings/en-eu.msg

@@ -28,7 +28,10 @@ ProfileCorrections: List of all assigned corrections
 Remarks: Remarks
 
 ProfileSupervisor: Supervised by
+ProfileNoSupervisor: Is not supervised by anynone.
 ProfileSupervisee: Supervises
+ProfileNoSupervisee: Does not supervise anynone.
+ProfileSuperviseeReroute: Reroutes reach this supervisor via 
 
 UserTelephone: Phone
 UserMobile: Mobile

src/Handler/Profile.hs

@@ -7,7 +7,7 @@
 module Handler.Profile
   ( getProfileR, postProfileR
   , getForProfileR, postForProfileR
-  , getProfileDataR, makeProfileData  
+  , getProfileDataR, makeProfileData
   , getForProfileDataR
   , getAuthPredsR, postAuthPredsR
   , getUserNotificationR, postUserNotificationR
@@ -70,11 +70,11 @@ data SettingsForm = SettingsForm
       , stgDownloadFiles        :: Bool
       , stgWarningDays          :: NominalDiffTime
       , stgShowSex              :: Bool
-      
+
       , stgPinPassword          :: Maybe Text
       , stgPrefersPostal        :: Bool
       , stgPostAddress          :: Maybe StoredMarkup
-      
+
       , stgTelephone            :: Maybe Text
       , stgMobile               :: Maybe Text
 
@@ -142,9 +142,9 @@ makeSettingForm template html = do
         <*> aopt  htmlField             (fslI MsgPostAddress      & setTooltip MsgPostAddressTip) (stgPostAddress   <$> template)
 
         <*> aopt  (textField & cfStrip) (fslI MsgUserTelephone) (stgTelephone <$> template)
-        <*> aopt  (textField & cfStrip) (fslI MsgUserMobile   ) (stgMobile    <$> template)      
+        <*> aopt  (textField & cfStrip) (fslI MsgUserMobile   ) (stgMobile    <$> template)
 
-        <*> examOfficeForm (stgExamOfficeSettings <$> template)        
+        <*> examOfficeForm (stgExamOfficeSettings <$> template)
         <*> schoolsForm (stgSchools <$> template)
         <*> notificationForm (stgNotificationSettings <$> template)
     return (result, widget) -- no validation here, done later by validateSettings
@@ -226,7 +226,7 @@ notificationForm template = wFormToAForm $ do
   let
     ntfs nt = fslI nt & case nt of
       _other -> id
-    
+
     nsForm nt
       | maybe False ntHidden $ ntSection nt
       = pure $ notificationAllowed def nt
@@ -297,7 +297,7 @@ examOfficeForm template = wFormToAForm $ do
               | otherwise
               -> FormSuccess $ Map.singleton kStart (Left nLabel)
           return (addRes', $(widgetFile "profile/exam-office-labels/add"))
-        
+
         miCell :: ListPosition
                -> Either ExamOfficeLabelName ExamOfficeLabelId
                -> Maybe EOLabelData
@@ -366,7 +366,7 @@ validateSettings User{..} = do
   userDisplayName' <- use _stgDisplayName
   guardValidation MsgUserDisplayNameInvalid $
     userDisplayName == userDisplayName' ||  -- unchanged or valid (invalid displayNames delivered by LDAP are preserved)
-    validDisplayName userTitle userFirstName userSurname userDisplayName'    
+    validDisplayName userTitle userFirstName userSurname userDisplayName'
 
   userDisplayEmail' <- use _stgDisplayEmail
   guardValidation (MsgInvalidEmailAddressWith $ CI.original userDisplayEmail') $
@@ -412,7 +412,7 @@ nullaryPathPiece ''ProfileAnchor $ camelToPathPiece' 1
 
 getForProfileR , postForProfileR :: CryptoUUIDUser -> Handler Html
 getForProfileR = postForProfileR
-postForProfileR cID = do 
+postForProfileR cID = do
   uid <- decrypt cID
   user <- runDB $ get404 uid
   serveProfileR (uid, user)
@@ -449,7 +449,7 @@ serveProfileR (uid, user@User{..}) = do
         , stgShowSex              = userShowSex
         , stgPinPassword          = userPinPassword
         , stgPostAddress          = userPostAddress
-        , stgPrefersPostal        = userPrefersPostal  
+        , stgPrefersPostal        = userPrefersPostal
         , stgTelephone            = userTelephone
         , stgMobile               = userMobile
         , stgExamOfficeSettings   = ExamOfficeSettings
@@ -580,14 +580,50 @@ getProfileDataR = do
 getForProfileDataR :: CryptoUUIDUser -> Handler Html
 getForProfileDataR cID = do
   uid <- decrypt cID
-  (user,dataWidget) <- runDB $ bind2 (get404 uid) $ makeProfileData . Entity uid    
+  (user,dataWidget) <- runDB $ bind2 (get404 uid) $ makeProfileData . Entity uid
   defaultLayout $ do
     setTitleI $ MsgHeadingForProfileData $ userDisplayName user
     dataWidget
 
+-- data TableHasData = TableHasData{tableHasRows :: Bool, tableWidget :: Widget}
+-- a poor man's record subsitute
+
+{-
+type TableHasData = (Bool, Widget)
+tableHasRows :: TableHasData -> Bool
+tableHasRows = fst
+tableWidget :: TableHasData -> Widget
+tableWidget  = snd
+-}
+
+maybeTable :: (RenderMessage UniWorX a)
+           => a -> (Bool, Widget) -> Widget
+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|
+--     <div .container>
+--       _{nodata}
+--   |]
+-- maybeTable' hdr _ mbRemark      (True ,tbl) =
+maybeTable' hdr _ mbRemark      (_ ,tbl) =
+  [whamlet|
+    <div .container>
+      <h2> _{hdr}
+      <div .container>
+        ^{tbl}
+        $maybe remark <- mbRemark
+          <em>_{MsgProfileRemark}
+          \ ^{remark}
+  |]
+
+
 makeProfileData :: Entity User -> DB Widget
 makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
-  now <- liftIO getCurrentTime 
+  now <- liftIO getCurrentTime
   avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
   let usrAutomatic :: CU_UserAvs_User -> Widget
       usrAutomatic = updateAutomatic . mayUpdate usrVal avsId . mkCheckUpdate
@@ -599,31 +635,31 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
       E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
       E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
       return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
-  studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do      
+  studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
       E.on $ studyfeat E.^. StudyFeaturesField    E.==. studyterms  E.^. StudyTermsId
       E.on $ studyfeat E.^. StudyFeaturesDegree   E.==. studydegree E.^. StudyDegreeId
       E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
       return  (studyfeat, studydegree, studyterms)
   companies <- wgtCompanies uid
-  supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+  -- supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
-      E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
+  --     E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
-      E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid      
+  --     E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
-      E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
+  --     E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
-      return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
+  --     return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
-  let numSupervisors = length supervisors'
+  -- let numSupervisors = length supervisors'
-      supervisors = intersperse (text2widget ", ") $ 
+  --     supervisors = intersperse (text2widget ", ") $
-        (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisors'
+  --       (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisors'
-      icnReroute = text2widget " " <> toWgt (icon IconLetter)
+  --     icnReroute = text2widget " " <> toWgt (icon IconReroute)
-  supervisees' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+  -- supervisees' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
-      E.on $ spvr E.^. UserSupervisorUser E.==. usrSpvr E.^. UserId
+  --     E.on $ spvr E.^. UserSupervisorUser E.==. usrSpvr E.^. UserId
-      E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid      
+  --     E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid
-      return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
+  --     return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
-  let numSupervisees = length supervisees'
+  -- let numSupervisees = length supervisees'
-      supervisees = intersperse (text2widget ", ") $ 
+  --     supervisees = intersperse (text2widget ", ") $
-        (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisees'
+  --       (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisees'
-      -- icnReroute = text2widget " " <> toWgt (icon IconLetter)
+  --     -- icnReroute = text2widget " " <> toWgt (icon IconReroute)
   --Tables
-  (hasRowsOwnedCourses, ownedCoursesTable) <- mkOwnedCoursesTable uid -- Tabelle mit eigenen Kursen
+  ownedCoursesTable    <- mkOwnedCoursesTable         uid -- Tabelle mit eigenen Kursen
   enrolledCoursesTable <- mkEnrolledCoursesTable      uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
   submissionTable      <- mkSubmissionTable           uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
   submissionGroupTable <- mkSubmissionGroupTable      uid -- Tabelle mit allen Abgabegruppen
@@ -631,16 +667,16 @@ 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 examTable, ownTutorialTable, tutorialTable :: Widget
+  -- let examTable, ownTutorialTable, tutorialTable :: Widget
-      examTable        = i18n MsgPersonalInfoExamAchievementsWip
+  --     examTable        = i18n MsgPersonalInfoExamAchievementsWip
-      ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip
+  --     ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip
-      tutorialTable    = i18n MsgPersonalInfoTutorialsWip
+  --     tutorialTable    = i18n MsgPersonalInfoTutorialsWip
 
   cID <- encrypt uid
   mCRoute <- getCurrentRoute
-  showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)  
+  showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID)
   tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId
-  tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress  
+  tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress
   let profileRemarks = $(i18nWidgetFile "profile-remarks")
   return $(widgetFile "profileData")
 
@@ -698,7 +734,7 @@ mkOwnedCoursesTable =
 
 
 -- | Table listing all courses that the given user is enrolled in
-mkEnrolledCoursesTable :: UserId -> DB Widget
+mkEnrolledCoursesTable :: UserId -> DB (Bool, Widget)
 mkEnrolledCoursesTable =
   let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
                -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
@@ -706,7 +742,7 @@ mkEnrolledCoursesTable =
 
       validator = def & defaultSorting [SortDescBy "time"]
 
-  in \uid -> dbTableWidget' validator
+  in \uid -> (_1 %~ getAny) <$> dbTableWidget validator
     DBTable
       { dbtIdent     = "courseMembership" :: Text
       , dbtSQLQuery  = \(course `E.InnerJoin` participant) -> do
@@ -750,7 +786,7 @@ mkEnrolledCoursesTable =
 
 
 -- | Table listing all submissions for the given user
-mkSubmissionTable :: UserId -> DB Widget
+mkSubmissionTable :: UserId -> DB (Bool, Widget)
 mkSubmissionTable =
   let dbtIdent = "submissions" :: Text
       dbtStyle = def
@@ -828,14 +864,10 @@ mkSubmissionTable =
       dbtExtraReps = []
   in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
                   dbtSorting  = dbtSorting'  uid
-              in  dbTableWidget' validator DBTable{..}
+              in   (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
---   in do dbtSQLQuery <- dbtSQLQuery'
---         dbtSorting  <- dbtSorting'
---         return $ dbTableWidget' validator $ DBTable {..}
-
 
 -- | Table listing all submissions for the given user
-mkSubmissionGroupTable :: UserId -> DB Widget
+mkSubmissionGroupTable :: UserId -> DB (Bool, Widget)
 mkSubmissionGroupTable =
   let dbtIdent = "subGroups" :: Text
       dbtStyle = def
@@ -887,10 +919,10 @@ mkSubmissionGroupTable =
       dbtCsvDecode = Nothing
       dbtExtraReps = []
   in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
-              in  dbTableWidget' validator DBTable{..}
+              in  (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
 
 
-mkCorrectionsTable :: UserId -> DB Widget
+mkCorrectionsTable :: UserId -> DB (Bool, Widget)
 mkCorrectionsTable =
   let dbtIdent = "corrections" :: Text
       dbtStyle = def
@@ -960,7 +992,7 @@ mkCorrectionsTable =
       dbtCsvDecode = Nothing
       dbtExtraReps = []
   in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
-              in  dbTableWidget' validator DBTable{..}
+              in  (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
 
 
 -- | Table listing all qualifications that the given user is enrolled in
@@ -977,26 +1009,26 @@ mkQualificationsTable =
           E.on $ quser E.^. QualificationUserId             E.=?. qblock E.?. QualificationUserBlockQualificationUser
             E.&&.  qblock `isLatestBlockBefore` E.val now
           E.on $ quser E.^. QualificationUserQualification  E.==. quali  E.^. QualificationId
-          E.where_ $ quser E.^. QualificationUserUser E.==. E.val uid  
+          E.where_ $ quser E.^. QualificationUserUser E.==. E.val uid
           return (quali, quser, qblock)
       , dbtRowKey = \(_quali `E.InnerJoin` quser `E.LeftOuterJoin` _qblock) -> quser E.^. QualificationUserId
-      , dbtProj      = dbtProjId 
+      , dbtProj      = dbtProjId
       , dbtColonnade = mconcat
           [ colSchool (_dbrOutput . _1 . _entityVal . _qualificationSchool)
           , sortable (Just "quali")         (i18nCell MsgQualificationName)             $ qualificationDescrCell         <$> view (_dbrOutput . _1 . _entityVal)
-          , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)   $ dayCell                   <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserFirstHeld  )          
+          , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)   $ dayCell                   <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserFirstHeld  )
           , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh) $ dayCell                   <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserLastRefresh)
           , sortable (Just "valid-until")   (i18nCell MsgLmsQualificationValidUntil)    $ dayCell                   <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserValidUntil )
           , sortable (Just "blocked")       (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row ->
-              qualificationValidReasonCell False (utctDay now) (row ^? _dbrOutput . _3 . _Just . _entityVal) (row ^. _dbrOutput . _2 . _entityVal)                                                                                             
+              qualificationValidReasonCell False (utctDay now) (row ^? _dbrOutput . _3 . _Just . _entityVal) (row ^. _dbrOutput . _2 . _entityVal)
           ]
       , dbtSorting   = mconcat
           [ sortSchool $ to (\(quali `E.InnerJoin` _ `E.LeftOuterJoin` _) -> quali E.^. QualificationSchool)
-          , singletonMap "quali"        $ SortColumn $ withType $ \(quali `E.InnerJoin` _ `E.LeftOuterJoin`  _) -> quali  E.^. QualificationName  
+          , singletonMap "quali"        $ SortColumn $ withType $ \(quali `E.InnerJoin` _ `E.LeftOuterJoin`  _) -> quali  E.^. QualificationName
           , singletonMap "blocked"      $ SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.LeftOuterJoin` qblock) -> qblock E.?. QualificationUserBlockFrom
           , singletonMap "valid-until"  $ SortColumn $ withType $ \(_ `E.InnerJoin` quser `E.LeftOuterJoin`  _) -> quser  E.^. QualificationUserValidUntil
           , singletonMap "last-refresh" $ SortColumn $ withType $ \(_ `E.InnerJoin` quser `E.LeftOuterJoin`  _) -> quser  E.^. QualificationUserLastRefresh
-          , singletonMap "first-held"   $ SortColumn $ withType $ \(_ `E.InnerJoin` quser `E.LeftOuterJoin`  _) -> quser  E.^. QualificationUserFirstHeld          
+          , singletonMap "first-held"   $ SortColumn $ withType $ \(_ `E.InnerJoin` quser `E.LeftOuterJoin`  _) -> quser  E.^. QualificationUserFirstHeld
           ]
       , dbtFilter    = mempty
       , dbtFilterUI  = mempty
@@ -1027,9 +1059,9 @@ instance HasUser TblSupervisorData where
   hasUser = _dbrOutput . _1 . _entityVal
 
 -- | Table listing all supervisor of the given user
-mkSupervisorsTable :: UserId -> DB Widget
+mkSupervisorsTable :: UserId -> DB (Bool, Widget)
-mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
+mkSupervisorsTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..}
-  where 
+  where
     dbtIdent = "userSupervisedBy" :: Text
     dbtStyle = def
 
@@ -1043,10 +1075,10 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
     dbtColonnade = mconcat
         [ colUserNameModalHdr MsgTableSupervisor ForProfileDataR
         , colUserEmail
-        , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b          
+        , sortable (Just "rerouted")    (i18nCell MsgTableRerouteActive)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute
-        , sortable (Just "rerouted")    (i18nCell MsgTableRerouteActive)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> tickmarkCell b
+        , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
         , 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          
+        , sortable (Just "reason")      (i18nCell MsgSupervisorReason)    $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
         ]
     validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
     dbtSorting = mconcat
@@ -1055,7 +1087,7 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
         , singletonMap "postal-pref"  $ SortColumn $ queryUser            >>> (E.^. UserPrefersPostal)
         , singletonMap "rerouted"     $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorRerouteNotifications)
         , singletonMap "cshort"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorCompany)
-        , singletonMap "reason"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorReason)          
+        , singletonMap "reason"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorReason)
         ]
     dbtFilter  = mconcat
         [ singletonMap & uncurry $ fltrUserNameEmail queryUser
@@ -1068,9 +1100,9 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
 
 
 -- | Table listing all persons supervised by the given user
-mkSuperviseesTable :: UserId -> DB Widget
+mkSuperviseesTable :: UserId -> DB (Bool, Widget)
-mkSuperviseesTable uid = dbTableWidget' validator DBTable{..}
+mkSuperviseesTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..}
-  where 
+  where
     dbtIdent = "userSupervisedBy" :: Text
     dbtStyle = def
 
@@ -1084,10 +1116,10 @@ mkSuperviseesTable uid = dbTableWidget' validator DBTable{..}
     dbtColonnade = mconcat
         [ colUserNameModalHdr MsgTableSupervisee ForProfileDataR
         -- , colUserEmail
-        -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b          
+        , sortable (Just "rerouted")    (i18nCell MsgTableRerouteActive)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute
-        , sortable (Just "rerouted")    (i18nCell MsgTableRerouteActive)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> tickmarkCell b
+        -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
         , 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          
+        , sortable (Just "reason")      (i18nCell MsgSupervisorReason)    $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
         ]
     validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
     dbtSorting = mconcat
@@ -1096,7 +1128,7 @@ mkSuperviseesTable uid = dbTableWidget' validator DBTable{..}
         , singletonMap "postal-pref"  $ SortColumn $ queryUser            >>> (E.^. UserPrefersPostal)
         , singletonMap "rerouted"     $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorRerouteNotifications)
         , singletonMap "cshort"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorCompany)
-        , singletonMap "reason"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorReason)          
+        , singletonMap "reason"       $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorReason)
         ]
     dbtFilter  = mconcat
         [ singletonMap & uncurry $ fltrUserNameEmail queryUser

src/Handler/Users.hs

@@ -70,15 +70,15 @@ nullaryPathPiece ''UserAction $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''UserAction id
 
 data UserActionData = UserAvsSyncData
-                    | UserLdapSyncData 
+                    | UserLdapSyncData
                     | UserHijack
-                    | UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text } 
+                    | UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
                     | UserSetSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
                     | UserRemoveSupervisorData
                     | UserRemoveSubordinatesData
-                    
+
   deriving (Eq, Ord, Read, Show, Generic)
-  
+
 isNotSetSupervisor :: UserActionData -> Bool
 isNotSetSupervisor UserSetSupervisorData{} = False
 isNotSetSupervisor _ = True
@@ -128,10 +128,10 @@ postUsersR = do
               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)
+                icnReroute = text2widget " " <> toWgt (icon IconReroute)
             pure $ mconcat supervisors
       , sortable (Just "last-login") (i18nCell MsgLastLogin)  $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastAuthentication
-      , sortable (Just "auth-ldap")  (i18nCell MsgAuthMode)   $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication      
+      , sortable (Just "auth-ldap")  (i18nCell MsgAuthMode)   $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
       , sortable (Just "ldap-sync")  (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation
       , flip foldMap universeF $ \function ->
           sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
@@ -187,14 +187,14 @@ postUsersR = do
         return (act, usrSet)
 
       acts :: Map UserAction (AForm Handler UserActionData)
-      acts = mconcat 
+      acts = mconcat
         [ singletonMap UserLdapSync      $ pure UserLdapSyncData
         , singletonMap UserAvsSync       $ pure UserAvsSyncData
-        , singletonMap UserAddSupervisor $ UserAddSupervisorData 
+        , singletonMap UserAddSupervisor $ UserAddSupervisorData
             <$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
             <*> aopt   textField (fslI MsgSupervisorReason) Nothing
-        , singletonMap UserSetSupervisor $ UserSetSupervisorData 
+        , singletonMap UserSetSupervisor $ UserSetSupervisorData
             <$> apopt  (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
             <*> aopt   textField (fslI MsgSupervisorReason) Nothing
@@ -209,7 +209,7 @@ postUsersR = do
       , dbtProj      = dbtProjId
       , dbtSorting   = Map.fromList $
           [ ( SortingKey $ CI.mk $ toPathPiece function
-            , SortColumn $ \user -> E.subSelect $ E.from $ \uf -> do 
+            , SortColumn $ \user -> E.subSelect $ E.from $ \uf -> do
                 E.where_ $ uf E.^. UserFunctionUser     E.==. user E.^. UserId
                     E.&&.  uf E.^. UserFunctionFunction E.==. E.val function
                 return (uf E.^. UserFunctionSchool)
@@ -254,9 +254,9 @@ postUsersR = do
                 return (usrSpvr E.^. UserDisplayName)
             )
           , ( "system-function"
-            , SortColumn $ \user -> E.subSelect $ E.from $ \usf -> do 
+            , SortColumn $ \user -> E.subSelect $ E.from $ \usf -> do
                 E.where_ $ usf E.^. UserSystemFunctionUser     E.==. user E.^. UserId
-                return   $ usf E.^. UserSystemFunctionFunction            
+                return   $ usf E.^. UserSystemFunctionFunction
             )
           ]
       , dbtFilter    = Map.fromList -- OverloadedLists does not work with the templates
@@ -265,7 +265,7 @@ postUsersR = do
           --     if Set.null criteria then E.true else -- TODO: why is this condition not needed?
           --         -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
           --         E.any (\c -> user E.^. UserDisplayName `E.hasInfix` E.val c) criteria
-          --   )          
+          --   )
           -- , ( "user-ident", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
           --     Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
           --     Just needle -> E.castString (user E.^. UserIdent) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
@@ -300,7 +300,7 @@ postUsersR = do
                 | otherwise -> E.val True :: E.SqlExpr (E.Value Bool)
             )
           , ( "user-company", FilterColumn . E.mkExistsFilter $ \user criterion ->
-                E.from $ \(usrComp `E.InnerJoin` comp) -> do 
+                E.from $ \(usrComp `E.InnerJoin` comp) -> do
                   let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
                                   (E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
                       testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
@@ -317,12 +317,12 @@ postUsersR = do
                         E.&&.  E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria)
             )
           -- , ( "avs-number", FilterColumn $ E.mkExistsFilterWithComma CI.mk $ \user criterion -> -- note that this is an exact filter
-          --     E.from $ \usrAvs -> -- do 
+          --     E.from $ \usrAvs -> -- do
           --       E.where_ $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
           --           E.&&.  ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
           --                 (E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) )
           --   )
-          , ( "is-supervisor", FilterColumn $ \user criterion -> case criterion of                
+          , ( "is-supervisor", FilterColumn $ \user criterion -> case criterion of
                 Last (Just True)   -> E.exists    . E.from $ \usrSpr -> E.where_ $ user E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
                 Last (Just False)  -> E.notExists . E.from $ \usrSpr -> E.where_ $ user E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
                 _                  -> E.val True :: E.SqlExpr (E.Value Bool)
@@ -341,7 +341,7 @@ postUsersR = do
           , prismAForm (singletonFilter "user-supervisor")    mPrev $ aopt textField (fslI MsgTableSupervisor)
           , prismAForm (singletonFilter "school")             mPrev $ aopt (lift `hoistField` selectFieldList schoolOptions) (fslI MsgCourseSchool)
           , prismAForm (singletonFilter "is-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgUserIsSupervisor)
-          , prismAForm (singletonFilter "auth-ldap"     . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode)          
+          , prismAForm (singletonFilter "auth-ldap"     . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode)
           , prismAForm (singletonFilter "ldap-sync"     . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore)
           ]
       , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
@@ -368,10 +368,10 @@ postUsersR = do
   formResult usersRes $ \case
     (act, usersSet)
       | Set.null usersSet && isNotSetSupervisor act ->
-          addMessageI Info MsgActionNoUsersSelected          
+          addMessageI Info MsgActionNoUsersSelected
     (UserLdapSyncData, userSet) -> do
       forM_ userSet $ \uid -> queueJob' $ JobSynchroniseLdapUser uid
-      addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet      
+      addMessageI Success . MsgSynchroniseLdapUserQueued $ Set.size userSet
       redirectKeepGetParams UsersR
     (UserAvsSyncData, userSet) -> do
       n <- runDB $ queueAvsUpdateByUID userSet Nothing
@@ -379,7 +379,7 @@ postUsersR = do
       redirectKeepGetParams UsersR
     (UserHijack, Set.lookupMin -> Just uid) ->
       hijackUser uid >>= sendResponse
-    (UserRemoveSupervisorData, userSet) -> do      
+    (UserRemoveSupervisorData, userSet) -> do
       runDB $ deleteWhere [UserSupervisorUser <-. Set.toList userSet]
       addMessageI Success $ MsgUsersRemoveSupervisors $ Set.size userSet
       redirectKeepGetParams UsersR
@@ -388,11 +388,11 @@ postUsersR = do
       addMessageI Success $ MsgUsersRemoveSubordinates $ Set.size userSet
       redirectKeepGetParams UsersR
     (act, usersSet)
-      | isActionSupervisor act -> do 
+      | isActionSupervisor act -> do
         avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser $ getActionSupervisors act
         let (supersFound, supersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
             users = Set.toList usersSet
-            nrSuperNotFound = length supersNotFound            
+            nrSuperNotFound = length supersNotFound
         runDB $ do
           unless (isNotSetSupervisor act) $ deleteWhere [UserSupervisorUser <-. users]
           putMany [UserSupervisor s u r Nothing (getActionSupervisorReason act)
@@ -413,7 +413,7 @@ postUsersR = do
       runDBJobs . runConduit $ selectSource [] [] .| C.mapM_ (queueDBJob . JobSynchroniseLdapUser . entityKey)
       addMessageI Success MsgSynchroniseLdapAllUsersQueued
       redirect UsersR
-    AllUsersAvsSync -> do      
+    AllUsersAvsSync -> do
       now <- liftIO getCurrentTime
       let nowaday = utctDay now
       n <- runDB $ E.insertSelectWithConflictCount UniqueAvsSyncUser
@@ -425,7 +425,7 @@ postUsersR = do
                 -- Ex.<&> Ex.just (E.day E.now_) -- don't use DB time here, since job handler compares with FRADrive clock
                 Ex.<&> E.justVal nowaday
               )
-        ) (\current excluded -> 
+        ) (\current excluded ->
             [ AvsSyncCreationTime E.=. E.least    (current E.^. AvsSyncCreationTime) (excluded E.^. AvsSyncCreationTime)
             , AvsSyncPause        E.=. E.greatest (current E.^. AvsSyncPause)        (excluded E.^. AvsSyncPause)
             ]
@@ -450,7 +450,7 @@ hijackUser uid = do
   setCredsRedirect $ Creds apDummy (CI.original userIdent) []
 
 getAdminHijackUserR :: CryptoUUIDUser -> Handler Html
-getAdminHijackUserR cID = do    
+getAdminHijackUserR cID = do
   (hijackWgt, hijackEnctype) <- generateFormPost hijackUserForm
   let hjForm = wrapForm hijackWgt def{ formSubmit = FormNoSubmit, formEncoding = hijackEnctype, formAction = Just . SomeRoute $ AdminHijackUserR cID }
   uid :: UserId <- decrypt cID
@@ -463,7 +463,7 @@ getAdminHijackUserR cID = do
     |]
 
 postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
-postAdminHijackUserR cID = do  
+postAdminHijackUserR cID = do
   ((hijackRes, _), _) <- runFormPost hijackUserForm
   $logWarnS "HIJACK" $ "Form Result is: " <> tshow hijackRes
   uid <- decrypt cID
@@ -517,13 +517,13 @@ postAdminUserR uuid = do
         queueJob' $ JobSynchroniseLdapUser uid
         addMessageI Success $ MsgSynchroniseLdapUserQueued 1
         redirectKeepGetParams $ AdminUserR uuid
-      ThisUserAvsSync -> do 
+      ThisUserAvsSync -> do
         n <- runDB $ queueAvsUpdateByUID (Set.singleton uid) Nothing
         addMessageI Success $ MsgSynchroniseAvsUserQueued $ fromIntegral n
         redirectKeepGetParams $ AdminUserR uuid
       -- ThisUserHijack -> do
       --   redirect $ AdminHijackUserR uuid
-    let thisUserActWgt = wrapForm thisUserActWgt' def 
+    let thisUserActWgt = wrapForm thisUserActWgt' def
           { formSubmit    = FormNoSubmit
           , formAction    = Just $ SomeRoute $ AdminUserR uuid
           , formEncoding  = thisUserActEnctype

src/Handler/Utils/Table/Pagination.hs

@@ -84,7 +84,7 @@ import Data.Ratio ((%))
 import qualified Data.Foldable as Foldable
 
 import qualified Yesod.Form.Functions as Yesod
-  
+
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Internal as E (SqlSelect,unsafeSqlValue)
@@ -170,7 +170,7 @@ dbFilterKey ident = toPathPiece . WithIdent ident
 
 
 data SomeExprValue = forall a. PersistField a => SomeExprValue { getSomeExprValue :: E.SqlExpr (E.Value a) }
-  
+
 data SortColumn t r' = forall a. PersistField a => SortColumn           { getSortColumn :: t -> E.SqlExpr (E.Value a) }
                      | forall a. PersistField a => SortColumnNullsInv   { getSortColumn :: t -> E.SqlExpr (E.Value a) }
                      | forall a. PersistField a => SortColumnNeverNull  { getSortColumn :: t -> E.SqlExpr (E.Value a) }
@@ -264,7 +264,7 @@ instance Monoid (DBTProjFilterPost r') where
 data FilterColumn t fs = forall a. IsFilterColumn t a => FilterColumn a
                        | forall a. IsFilterColumnHandler t a => FilterColumnHandler a
                        | forall a. IsFilterProjected fs a => FilterProjected a
-                       
+
 
 filterColumn :: FilterColumn t fs -> Maybe ([Text] -> t -> E.SqlExpr (E.Value Bool))
 filterColumn (FilterColumn f) = Just $ filterColumn' f
@@ -292,9 +292,9 @@ instance IsFilterColumn t cont => IsFilterColumn t (t -> cont) where
 
 instance {-# OVERLAPPABLE #-} (PathPiece (Element l), IsFilterColumn t cont, MonoPointed l, Monoid l) => IsFilterColumn t (l -> cont) where
   filterColumn' cont is' = filterColumn' (cont $ is' ^. mono' _PathPiece) is'
-  
+
-class IsFilterColumnHandler t a where 
+class IsFilterColumnHandler t a where
-  filterColumnHandler' :: a -> [Text] -> Handler (t -> E.SqlExpr (E.Value Bool))  
+  filterColumnHandler' :: a -> [Text] -> Handler (t -> E.SqlExpr (E.Value Bool))
 
 instance IsFilterColumnHandler t ([Text] -> Handler (t -> E.SqlExpr (E.Value Bool))) where
   filterColumnHandler' fin args = fin args
@@ -482,7 +482,7 @@ data DBCsvMode
   | DBCsvAbort
 
 makePrisms ''DBCsvMode
-  
+
 data DBCsvDiff r' csv k'
   = DBCsvDiffNew
     { dbCsvNewKey :: Maybe k'
@@ -519,7 +519,7 @@ makeLenses_ ''DBCsvException
 
 instance (Typeable k', Show k') => Exception (DBCsvException k')
 
-  
+
 data DBTProjCtx fs r = DBTProjCtx
   { dbtProjFilter :: fs
   , dbtProjRow :: DBRow r
@@ -613,7 +613,7 @@ data DBStyle r = DBStyle
   }
 
 data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNumber :: Int64 -> Bool }
-                       | DBSTCourse 
+                       | DBSTCourse
                            (Lens' r (Entity Course))           -- course
                            (Traversal' r (Entity User))        -- lecturers
                            (Lens' r Bool)                      -- isRegistered
@@ -666,7 +666,7 @@ multiFilter key = prism' fromInner fromOuter
       -- prism' :: (Maybe [v] -> (Map k [v])) -> ((Map k [v]) -> Maybe (Maybe [v])) -> Prism' (Map k [v]) (Maybe [v])
       fromInner = maybe Map.empty (Map.singleton key)
       fromOuter = Just . Map.lookup key
-  
+
 data DBTCsvEncode r' k' csv = forall exportData filename sheetName.
   ( ToNamedRecord csv, CsvColumnsExplained csv
   , DBTableKey k'
@@ -750,7 +750,7 @@ dbtProjId :: forall fs r r'.
              ( fs ~ (), DBRow r ~ r' )
           => ReaderT (DBTProjCtx fs r) (MaybeT (ReaderT SqlBackend (HandlerFor UniWorX))) r'
 dbtProjId = dbtProjId'
-  
+
 dbtProjSimple' :: forall fs r r' r''.
                   DBRow r'' ~ r'
                => (r -> DB r'')
@@ -1059,7 +1059,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
   doSorting <- or2M
     (getsYesod . views _appBotMitigations $ Set.notMember SettingBotMitigationOnlyLoggedInTableSorting)
     (is _Just <$> maybeAuthId)
-  
+
   let
     sortingOptions = mkOptionList
       [ Option t' (SortingSetting t d) t'
@@ -1112,7 +1112,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
            <|> piInput
 
   psShortcircuit <- (== Just dbtIdent') <$> lookupCustomHeader HeaderDBTableShortcircuit
-  
+
   let
     -- adjustPI = over _piSorting $ guardOnM doSorting -- probably not neccessary; not displaying the links should be enough for now
     ((errs, PaginationSettings{..}), paginationInput@PaginationInput{..})
@@ -1217,8 +1217,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     --               && all (is _Just) filterSql
 
     -- psLimit' = bool PagesizeAll psLimit selectPagesize
-  
+
-  filterHandler <- case csvMode of 
+  filterHandler <- case csvMode of
     FormSuccess DBCsvImport{} -> return mempty -- don't execute Handler actions for unneeded filters upon csv _import_
     _other -> liftHandler $ forM psFilter' $ \(fc,args) -> mapM ($ args) $ filterColumnHandler fc
 
@@ -1240,7 +1240,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
           Just ps -> E.where_ $ dbtRowKey t `E.sqlIn` ps              -- Note that multiple where_ are indeed concatenated
           _other  -> return ()
         let filterAppT = Map.foldr (\fc expr -> maybe expr ((: expr) . ($ t)) fc) []
-            sqlFilters = filterAppT filterHandler <> filterAppT filterSql  -- Note that <> on the maps won't work as intended, since keys are present in both            
+            sqlFilters = filterAppT filterHandler <> filterAppT filterSql  -- Note that <> on the maps won't work as intended, since keys are present in both
         unless (null sqlFilters) $ E.where_ $ E.and sqlFilters
     return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), dbtRowKey t, res)
 
@@ -1279,7 +1279,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     exData <- hoistMaybe dbtCsvExampleData
     hdr <- lift $ dbtCsvHeader Nothing
     exportUrl <- toTextUrl (currentRoute, [(toPathPiece GetCsvExampleData, "")])
-    return $(widgetFile "table/csv-example") 
+    return $(widgetFile "table/csv-example")
 
   formResult csvMode $ \case
     DBCsvAbort{} -> do
@@ -1470,7 +1470,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     guardM doAltRep
 
     cts <- reqAccept <$> getRequest
-    
+
     altRep <- hoistMaybe <=< asum $ do
       mRep <- hoistMaybe . selectRep' extraReps' =<< cts
       return . return $ mRep <&> \case
@@ -1520,7 +1520,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                        -> State.modify $ (:) (n, beforeSize, cellSize)
                      | otherwise -> return ()
               let rowspanAcc'' = rowspanAcc'
-                    & traverse . _1 %~ pred 
+                    & traverse . _1 %~ pred
               whenIsJust (flattenAnnotated v) $ go rowspanAcc''
 
             compCellSize :: forall h' c. [(Int, Int, Int)] -> [Sized (Maybe Int) h' c] -> Sized (Maybe Int) h' c -> (Int, Maybe Int)
@@ -1634,7 +1634,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
                      addMessageI Success . MsgCsvImportSuccessful $ length acts'
                      E.transactionSave
                      redirect finalDest
-              
+
     _other -> return ((FormMissing, mempty), mempty)
   formResult csvImportConfirmRes $ \case
     (_, BtnCsvImportAbort) -> do
@@ -1661,7 +1661,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
     setParam :: Text -> Maybe Text -> QueryText -> QueryText
     setParam key = setParams key . maybeToList
-    
+
 
 dbTableWidget :: Monoid x
               => PSValidator (HandlerFor UniWorX) x
@@ -1784,7 +1784,7 @@ anchorCellCM cache routeM widget = anchorCellCM' cache routeM id (const widget)
 
 anchorCellM' :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => WidgetFor UniWorX x -> (x -> url) -> (x -> wgt) -> DBCell m a
 anchorCellM' xM x2route x2widget = linkEitherCellM' xM x2route (x2widget, x2widget)
-  
+
 anchorCellCM' :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a, Binary cache) => cache -> WidgetFor UniWorX x -> (x -> url) -> (x -> wgt) -> DBCell m a
 anchorCellCM' cache xM x2route x2widget = linkEitherCellCM' cache xM x2route (x2widget, x2widget)
 
@@ -1855,7 +1855,7 @@ maybeLinkEitherCellCM' mCache xM x2route (x2widgetAuth,x2widgetUnauth) = cell $
 
 listCell :: (IsDBTable m a, MonoFoldable mono) => mono -> (Element mono -> DBCell m a) -> DBCell m a
 listCell = listCell' . return
-  
+
 listCell' :: (IsDBTable m a, MonoFoldable mono) => WriterT a m mono -> (Element mono -> DBCell m a) -> DBCell m a
 listCell' mkXS mkCell = ilistCell' (otoList <$> mkXS) $ const mkCell
 
@@ -1926,7 +1926,7 @@ dbSelect :: forall x h r i a. (Headedness h, Monoid' x)
          -> Colonnade h (DBRow r) (DBCell (MForm (HandlerFor UniWorX)) x)
 -- dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ formCell resLens genIndex genForm
 dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ mempty & cellAttrs <>~ pure ("uw-hide-columns--no-hide","")) $ formCell resLens genIndex genForm
-  where    
+  where
     genForm _ mkUnique = do
       (selResult, selWidget) <- mreq checkBoxField (fsUniq mkUnique "select") (Just False)
       return (set selLens <$> selResult, [whamlet|^{fvWidget selWidget}|])
@@ -1936,7 +1936,7 @@ dbSelectIf :: forall x h r i a. (Headedness h, Monoid' x)
          => Lens' x (FormResult (DBFormResult i a (DBRow r)))
          -> Setter' a Bool
          -> (DBRow r -> MForm (HandlerFor UniWorX) i)
-         -> (DBRow r -> Bool) 
+         -> (DBRow r -> Bool)
          -> Colonnade h (DBRow r) (DBCell (MForm (HandlerFor UniWorX)) x)
 dbSelectIf resLens selLens genIndex condition = Colonnade.singleton (headednessPure $ mempty & cellAttrs <>~ [("uw-hide-columns--no-hide", mempty)] ) fCell
   where
@@ -1945,9 +1945,9 @@ dbSelectIf resLens selLens genIndex condition = Colonnade.singleton (headednessP
       (selResult, selWidget) <- mreq checkBoxField ((bool inputDisabled id $ condition row) $ fsUniq mkUnique "select") (Just False) -- produces disabled field, but still checked by master checkbox from header
       --(selResult, selWidget) <- mreq (bool noField checkBoxField $ condition row) (fsUniq mkUnique "select") (Just False) -- omits field entirely, but also removes master checkbox from header
       {- Similar to previous: omits field entirely, but also removes master checkbox from header
-      (selResult, selWidget) <- if condition row 
+      (selResult, selWidget) <- if condition row
           then mreq checkBoxField (fsUniq mkUnique "select") (Just False)
-          else return (FormMissing, FieldView "" Nothing "" mempty Nothing False) 
+          else return (FormMissing, FieldView "" Nothing "" mempty Nothing False)
       -}
       return (set selLens <$> selResult, [whamlet|^{fvWidget selWidget}|])
 

src/Utils.hs

@@ -412,6 +412,10 @@ citext2widget t = [whamlet|#{CI.original t}|]
 str2widget :: String -> WidgetFor site ()
 str2widget s = [whamlet|#{s}|]
 
+-- | hamlet does not like quotes
+spaceWidget :: WidgetFor site ()
+spaceWidget = str2widget " "
+
 int2widget :: Int64 -> WidgetFor site ()
 int2widget i = [whamlet|#{tshow i}|]
 

src/Utils/Icon.hs

@@ -106,19 +106,21 @@ data Icon
   | IconBlocked
   | IconCertificate
   | IconPrintCenter
-  | IconLetter
+  | IconLetter            -- only to be used for postal matters
   | IconAt
   | IconSupervisor
   | IconSupervisorForeign
+  | IconSuperior          -- supervisor and head of department
   --  IconWaitingForUser
   | IconExpired
   | IconLocked
   | IconUnlocked
-  | IconResetTries -- also see IconReset
+  | IconResetTries        -- also see IconReset
   | IconCompany
   | IconEdit
   | IconUserEdit
-  --  IconMagic      -- indicates automatic updates
+  --  IconMagic           -- indicates automatic updates
+  | IconReroute           -- for notification rerouting
 
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
@@ -158,7 +160,7 @@ iconText = \case
     IconSFTHint                 -> "life-ring"          -- for SheetFileType only
     IconSFTSolution             -> "exclamation-circle" -- for SheetFileType only
     IconSFTMarking              -> "check-circle"       -- for SheetFileType only
-    IconEmail                   -> "envelope" -- envelope is no longer unamibuous, use IconAt or IconLetter if email and postal need to be distinguished
+    IconEmail                   -> "envelope" -- envelope is no longer unambiguous, use IconAt or IconLetter if email and postal need to be distinguished
     IconRegisterTemplate        -> "file-alt"
     IconNoCorrectors            -> "user-slash"
     IconRemoveUser              -> "user-slash"
@@ -207,6 +209,7 @@ iconText = \case
     IconAt                      -> "at"        -- alternative for IconEmail to distinguish from IconLetter
     IconSupervisor              -> "head-side" -- must be notably different to user
     IconSupervisorForeign       -> "alien"
+    IconSuperior                -> "user-tie"  -- user-crown
     -- IconWaitingForUser          -> "user-cog"  -- Waiting on a user to do something
     IconExpired                 -> "hourglass-end"
     IconLocked                  -> "lock"
@@ -216,7 +219,7 @@ iconText = \case
     IconEdit                    -> "edit"
     IconUserEdit                -> "user-edit"
     -- IconMagic                   -> "wand-magic"
-
+    IconReroute                 -> "directions"
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon
 
@@ -316,6 +319,8 @@ iconExamRegister :: Bool -> Markup
 iconExamRegister True  = icon IconExamRegisterTrue
 iconExamRegister False = icon IconExamRegisterFalse
 
+-- | indicator whether notifications are sent by letter or email
+--   use iconReroute if type of rerouting is unclear
 iconLetterOrEmail :: Bool -> Markup
 iconLetterOrEmail True  = icon IconLetter
 iconLetterOrEmail False = icon IconAt

templates/profileData.hamlet

@@ -114,18 +114,6 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           _{MsgCompany}
         <dd .deflist__dd>
           ^{compWgt}
-      $if numSupervisors > 0
-        <dt .deflist__dt>_{MsgProfileSupervisor}
-          $if numSupervisors > 3
-            \ #{numSupervisors}
-        <dd .deflist__dd>
-          ^{mconcat supervisors}
-      $if numSupervisees > 0
-        <dt .deflist__dt>_{MsgProfileSupervisee}
-          $if length supervisees > 3
-            \ #{numSupervisees}
-        <dd .deflist__dd>
-          ^{mconcat supervisees}
       $if showAdminInfo
         <dt .deflist__dt>
           _{MsgUserCreated}
@@ -197,67 +185,25 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
                   $nothing
                     ^{formatTimeW SelFormatDateTime studyFeaturesLastObserved}
 <section>
-  <div .container>
-    $if hasRowsOwnedCourses
-      <div .container>
-        <h2>_{MsgProfileCourses}
-        <div .container>
-          ^{ownedCoursesTable}
 
-  <div .container>
+  ^{maybeTable' MsgProfileSupervisor (Just MsgProfileNoSupervisor) Nothing supervisorsTable}
-    <h2>_{MsgProfileCourseParticipations}
+  
-    <div .container>
+  ^{maybeTable' MsgProfileSupervisee (Just MsgProfileNoSupervisee) (Just (msg2widget MsgProfileSuperviseeReroute <> toWgt (iconLetterOrEmail userPrefersPostal))) superviseesTable}
-      ^{enrolledCoursesTable}
 
   <div .container>
     <h2>_{MsgProfileQualifications}
     <div .container>
       ^{qualificationsTable}
 
-  <div .container>
+  ^{maybeTable MsgProfileCourses ownedCoursesTable}
-    <h2>_{MsgProfileCourseExamResults}
+  
-    <div .container>
+  ^{maybeTable MsgProfileCourseParticipations enrolledCoursesTable}
-      ^{examTable}
 
-  <div .container>
+  ^{maybeTable MsgProfileSubmissionGroups submissionGroupTable}
-    <h2>_{MsgProfileTutorials}
-    <div .container>
-      ^{ownTutorialTable}
 
-  <div .container>
+  ^{maybeTable' MsgProfileSubmissions Nothing (Just (msg2widget MsgProfileGroupSubmissionDates)) submissionTable}
-    <h2>_{MsgProfileTutorialParticipations}
+  
-    <div .container>
+  ^{maybeTable' MsgTableCorrector Nothing (Just (msg2widget MsgProfileCorrectorRemark <> simpleLinkI MsgProfileCorrections CorrectionsR)) correctionsTable}
-      ^{tutorialTable}
+  
-
-  <div .container>
-    <h2>_{MsgProfileSubmissionGroups}
-    <div .container>
-      ^{submissionGroupTable}
-
-  <div .container>
-    <h2>_{MsgProfileSubmissions}
-    <div .container>
-      ^{submissionTable}
-      <em>_{MsgProfileRemark}
-      \ _{MsgProfileGroupSubmissionDates}
-
-  <div .container>
-    <h2> _{MsgTableCorrector}
-    <div .container>
-      ^{correctionsTable}
-
-    <em>_{MsgProfileRemark}
-    \ _{MsgProfileCorrectorRemark}
-    <a href=@{CorrectionsR}>_{MsgProfileCorrections}
-
-  <div .container>
-    <h2> _{MsgProfileSupervisor}
-    <div .container>
-      ^{supervisorsTable}
-
-  <div .container>
-    <h2> _{MsgProfileSupervisee}
-    <div .container>
-      ^{superviseesTable}
 
 ^{profileRemarks}