chore(users): add sorting and filtering by supervisor in users list
Closes #8
This commit is contained in:
Steffen Jost
parent
bbc1b169e8
commit
f352eca7e7
@ -72,3 +72,4 @@ TableExamOfficeLabel: Label-Name
|
||||
TableExamOfficeLabelStatus: Label-Farbe
|
||||
TableExamOfficeLabelPriority: Label-Priorität
|
||||
TableCompany: Firma
|
||||
TableSupervisor: Ansprechpartner
|
||||
@ -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
|
||||
TableCompany: Company
|
||||
TableSupervisor: Supervisor
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user