chore(users): add sorting and filtering by supervisor in users list

Closes #8

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -72,3 +72,4 @@ TableExamOfficeLabel: Label-Name
 TableExamOfficeLabelStatus: Label-Farbe
 TableExamOfficeLabelPriority: Label-Priorität
 TableCompany: Firma
+TableSupervisor: Ansprechpartner

messages/uniworx/utils/table_column/en-eu.msg

@@ -72,3 +72,4 @@ TableExamOfficeLabel: Label name
 TableExamOfficeLabelStatus: Label colour
 TableExamOfficeLabelPriority: Label priority
 TableCompany: Company
+TableSupervisor: Supervisor

src/Handler/Profile.hs

@@ -675,16 +675,16 @@ makeProfileData (Entity uid User{..}) = do
         (\(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
-      E.orderBy [E.asc (usrSpvr E.^. UserDisplayName) ]
+      E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid      
+      E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
       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
+      E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid      
       return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
   let supervisees = intersperse (text2widget ", ") $ 
         (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisees'

src/Handler/Users.hs

@@ -102,6 +102,16 @@ postUsersR = do
 --       , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
 --           (AdminUserR <$> encrypt uid)
 --           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
+      , sortable (Just "user-supervisor") (i18nCell MsgTableSupervisor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
+            supervisors' <- liftHandler . runDB . E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+              E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
+              E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
+              E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
+              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)
+            pure $ mconcat supervisors
       , 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 ->
@@ -188,6 +198,13 @@ postUsersR = do
                 E.orderBy [E.asc (comp E.^. CompanyName)]
                 return (comp E.^. CompanyName)
             )
+          , ( "user-supervisor"
+            , SortColumn $ \user -> E.subSelect $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+                E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
+                E.where_ $ spvr E.^. UserSupervisorUser E.==. user E.^. UserId
+                E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
+                return (usrSpvr E.^. UserDisplayName)
+            )
           ]
       , dbtFilter    = Map.fromList -- OverloadedLists does not work with the templates
           [ ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) ->
@@ -242,15 +259,24 @@ postUsersR = do
                       E.where_ $ (ucomp E.^. UserCompanyUser E.==. user E.^.UserId)
                           E.&&.  E.any (E.hasInfix (comp E.^. CompanyName)) (E.val <$> Set.toList criteria)
             )
+          , ( "user-supervisor", FilterColumn $ \user criteria -> if
+                | Set.null (criteria :: Set.Set Text) -> E.val True :: E.SqlExpr (E.Value Bool)
+                | otherwise ->
+                    E.exists . E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
+                      E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
+                      E.where_ $ (spvr E.^. UserSupervisorUser E.==. user E.^.UserId)
+                        E.&&.  E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria)
+            )
           ]
       , dbtFilterUI  = \mPrev -> mconcat
           [ prismAForm (singletonFilter "user-search") mPrev $ aopt textField  (fslI MsgName)
           , prismAForm (singletonFilter "user-ident") mPrev $ aopt textField  (fslI MsgAdminUserIdent)
           , prismAForm (singletonFilter "user-email") mPrev $ aopt textField (fslI MsgAdminUserEmail)
           -- , prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField  (fslI MsgTableMatrikelNr)          
-          , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
           , prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
           , prismAForm (singletonFilter "company-department" ) mPrev $ aopt textField (fslI MsgCompanyDepartment)
+          , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
+          , prismAForm (singletonFilter "user-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
           , prismAForm (singletonFilter "auth-ldap" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode)
           , prismAForm (singletonFilter "school") mPrev $ aopt (lift `hoistField` selectFieldList schoolOptions) (fslI MsgCourseSchool)
           , prismAForm (singletonFilter "ldap-sync" . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore)