From f352eca7e7b873c3e4257e4998f1211f104b6217 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 12 Dec 2022 11:25:17 +0100 Subject: [PATCH] chore(users): add sorting and filtering by supervisor in users list Closes #8 --- .../utils/table_column/de-de-formal.msg | 1 + messages/uniworx/utils/table_column/en-eu.msg | 3 +- src/Handler/Profile.hs | 6 +-- src/Handler/Users.hs | 40 +++++++++++++++---- 4 files changed, 39 insertions(+), 11 deletions(-) diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index 7bf2ecfad..9d13065df 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/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 \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 0cba1d67c..367aa334e 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -71,4 +71,5 @@ TableDiffDaysTooltip: Duration given according to ISO 8601. Example: "P2Y3M4D" i TableExamOfficeLabel: Label name TableExamOfficeLabelStatus: Label colour TableExamOfficeLabelPriority: Label priority -TableCompany: Company \ No newline at end of file +TableCompany: Company +TableSupervisor: Supervisor \ No newline at end of file diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 81707ea77..2da7f79f7 100644 --- a/src/Handler/Profile.hs +++ b/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' diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index a6e1c49e0..e40d9395d 100644 --- a/src/Handler/Users.hs +++ b/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 -> @@ -182,12 +192,19 @@ postUsersR = do , SortColumn $ \user -> user E.^. UserLastLdapSynchronisation ) , ( "user-company" - , SortColumn $ \user -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do + , SortColumn $ \user -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId E.where_ $ usrComp E.^. UserCompanyUser E.==. user E.^. UserId 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) -> @@ -236,24 +253,33 @@ postUsersR = do ) , ( "user-company", FilterColumn $ \user criteria -> if | Set.null (criteria :: Set.Set Text) -> E.val True :: E.SqlExpr (E.Value Bool) - | otherwise -> - E.exists . E.from $ \(ucomp `E.InnerJoin` comp) -> do + | otherwise -> + E.exists . E.from $ \(ucomp `E.InnerJoin` comp) -> do E.on $ ucomp E.^. UserCompanyCompany E.==. comp E.^. CompanyId 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 "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr) , 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) + , prismAForm (singletonFilter "ldap-sync" . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore) ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } , dbtParams = DBParamsForm