fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2022-12-12 10:43:00 +01:00
parent 6606ccc82c
commit bbc1b169e8
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/Handler/Users.hs
View File

@ -85,13 +85,13 @@ postUsersR = do
-- , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
-- (AdminUserR <$> encrypt uid)
-- (toWgt userMatrikelnummer)
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
let companies = intersperse (text2markup ", ") $
let companies = intersperse (text2markup ", ") $
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies
@ -181,6 +181,13 @@ postUsersR = do
, ( "ldap-sync"
, SortColumn $ \user -> user E.^. UserLastLdapSynchronisation
)
, ( "user-company"
, 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)
)
]
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates
[ ( "user-search", FilterColumn $ \user (criteria :: Set.Set Text) ->
@ -195,7 +202,7 @@ postUsersR = do
, ( "user-email", FilterColumn $ \user criterion -> case getLast (criterion :: Last Text) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
)
-- , ( "matriculation", FilterColumn $ \user (criteria :: Set.Set Text) -> if
-- | Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
@ -227,17 +234,26 @@ postUsersR = do
in E.maybe E.true (E.<=. E.val minTime) $ user E.^. UserLastLdapSynchronisation
| otherwise -> E.val True :: E.SqlExpr (E.Value Bool)
)
, ( "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
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)
)
]
, 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 "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 "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
@ -327,7 +343,7 @@ nullaryPathPiece ''UserAssimilateButton $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''UserAssimilateButton id
getAdminUserR, postAdminUserR :: CryptoUUIDUser -> Handler Html
getAdminUserR = postAdminUserR
@ -347,7 +363,7 @@ postAdminUserR uuid = do
return (school, userFunction E.?. UserFunctionFunction, isAdmin)
systemFunctionsF <- Set.fromList . map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False] []
let systemFunctions = (`Set.member` systemFunctionsF)
let systemFunctions = (`Set.member` systemFunctionsF)
return ( user
, setOf (folded . filtered (view $ _3 . _Value) . _1 . _entityKey) schools