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

chore(users): allow multiple filter criteria for avs no and personal no

Browse Source
This commit is contained in:
Steffen Jost 2023-10-24 14:55:55 +00:00
parent 315eedd1bc
commit 9ca9c38830
5 changed files with 39 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -16,7 +16,7 @@ TableTerm !ident-ok: Jahr
TableCourseSchool: Bereich TableCourseSchool: Bereich
TableSubmissionGroup: Feste Abgabegruppe TableSubmissionGroup: Feste Abgabegruppe
TableNoSubmissionGroup: Keine feste Abgabegruppe TableNoSubmissionGroup: Keine feste Abgabegruppe
TableMatrikelNr: AVS Nr TableMatrikelNr: AVS Personennummer
TableSex: Geschlecht TableSex: Geschlecht
TableBirthday: Geburtsdatum TableBirthday: Geburtsdatum
TableSchool: Bereich TableSchool: Bereich

2
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -16,7 +16,7 @@ TableTerm: Year
TableCourseSchool: Department TableCourseSchool: Department
TableSubmissionGroup: Registered submission group TableSubmissionGroup: Registered submission group
TableNoSubmissionGroup: No registered submission group TableNoSubmissionGroup: No registered submission group
TableMatrikelNr: AVS No TableMatrikelNr: AVS person no
TableSex: Sex TableSex: Sex
TableBirthday: Birthday TableBirthday: Birthday
TableSchool: Department TableSchool: Department

13
src/Database/Esqueleto/Utils.hs
View File

@ -24,7 +24,7 @@ module Database.Esqueleto.Utils
, mkContainsFilter, mkContainsFilterWith , mkContainsFilter, mkContainsFilterWith
, mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus , mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus
, mkDayFilter, mkDayFilterFrom, mkDayFilterTo , mkDayFilter, mkDayFilterFrom, mkDayFilterTo
, mkExistsFilter , mkExistsFilter, mkExistsFilterWithComma
, anyFilter, allFilter , anyFilter, allFilter
, ascNullsFirst, descNullsLast , ascNullsFirst, descNullsLast
, orderByList , orderByList
@ -421,6 +421,17 @@ mkExistsFilter query row criterias
| Set.null criterias = true | Set.null criterias = true
| otherwise = any (E.exists . query row) $ Set.toList criterias | otherwise = any (E.exists . query row) $ Set.toList criterias
mkExistsFilterWithComma :: PathPiece a
=> (Text -> a)
-> (t -> a -> E.SqlQuery ())
-> t
-> Set.Set Text
-> E.SqlExpr (E.Value Bool)
mkExistsFilterWithComma cast query row (foldMap commaSeparatedText -> criterias)
| Set.null criterias = true
| otherwise = any (E.exists . query row) (cast <$> Set.toList criterias)
-- | Combine several filters, using logical or -- | Combine several filters, using logical or
anyFilter :: Foldable f anyFilter :: Foldable f
=> f (t -> cs -> E.SqlExpr (E.Value Bool)) => f (t -> cs -> E.SqlExpr (E.Value Bool))

6
src/Handler/PrintCenter.hs
View File

@ -225,9 +225,9 @@ mkPJTable = do
dbtFilter = mconcat dbtFilter = mconcat
[ single ("name" , FilterColumn . E.mkContainsFilterWithCommaPlus id $ views (to queryPrintJob) (E.^. PrintJobName)) [ single ("name" , FilterColumn . E.mkContainsFilterWithCommaPlus id $ views (to queryPrintJob) (E.^. PrintJobName))
, single ("apcid" , FilterColumn . E.mkContainsFilterWithComma id $ views (to queryPrintJob) (E.^. PrintJobApcIdent)) , single ("apcid" , FilterColumn . E.mkContainsFilterWithComma id $ views (to queryPrintJob) (E.^. PrintJobApcIdent))
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename)) , single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) , single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) --, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
, single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryRecipient) (E.?. UserDisplayName)) , single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryRecipient) (E.?. UserDisplayName))
, single ("sender" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySender) (E.?. UserDisplayName)) , single ("sender" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySender) (E.?. UserDisplayName))
, single ("course" , FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryCourse) (E.?. CourseName)) , single ("course" , FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryCourse) (E.?. CourseName))

50
src/Handler/Users.hs
View File

@ -101,7 +101,7 @@ postUsersR = do
(AdminUserR <$> encrypt uid) (AdminUserR <$> encrypt uid)
(nameWidget userDisplayName userSurname) (nameWidget userDisplayName userSurname)
, sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = entUsr } -> cellHasMatrikelnummerLinked entUsr , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = entUsr } -> cellHasMatrikelnummerLinked entUsr
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \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" , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \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 companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
@ -265,15 +265,9 @@ postUsersR = do
Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) 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 , ( "personal-number" , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserCompanyPersonalNumber))
| Set.null criteria -> E.true , ( "matriculation" , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserMatrikelnummer)) -- allows partial matches
| otherwise -> E.any (\c -> user E.^. UserMatrikelnummer `E.hasInfix` E.val c) criteria , ( "company-department", FilterColumn $ \user (criteria :: Set.Set Text) -> if -- exact filter on table UserAvs
)
, ( "personal-number", FilterColumn $ \user (criteria :: Set.Set Text) -> if
| Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
)
, ( "company-department", FilterColumn $ \user (criteria :: Set.Set Text) -> if
| Set.null criteria -> E.true -- TODO: why can this be eFalse and work still? | Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
| otherwise -> E.any (\c -> user E.^. UserCompanyDepartment `E.hasInfix` E.val c) criteria | otherwise -> E.any (\c -> user E.^. UserCompanyDepartment `E.hasInfix` E.val c) criteria
) )
@ -312,12 +306,12 @@ postUsersR = do
E.where_ $ (spvr E.^. UserSupervisorUser E.==. user E.^.UserId) E.where_ $ (spvr E.^. UserSupervisorUser E.==. user E.^.UserId)
E.&&. E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria) E.&&. E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria)
) )
, ( "avs-number", FilterColumn $ E.mkExistsFilter $ \user criterion -> -- , ( "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.where_ $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==. -- E.&&. ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
(E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) ) -- (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 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 Last (Just False) -> E.notExists . E.from $ \usrSpr -> E.where_ $ user E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
@ -325,19 +319,19 @@ postUsersR = do
) )
] ]
, dbtFilterUI = \mPrev -> mconcat , dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName) [ prismAForm (singletonFilter "user-search") mPrev $ aopt textField (fslI MsgName)
, prismAForm (singletonFilter "user-ident") mPrev $ aopt textField (fslI MsgAdminUserIdent) , 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 "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber & setTooltip MsgTableFilterCommaPlus)
, prismAForm (singletonFilter "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber) , prismAForm (singletonFilter "matriculation") mPrev $ aopt matriculationField (fslI MsgTableMatrikelNr & setTooltip MsgTableFilterCommaPlus) -- contains filter on UserMatrikelnummer
, prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo) -- , prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo & setTooltip MsgTableFilterCommaPlus) -- exact filter on table UserAvs
, prismAForm (singletonFilter "company-department" ) mPrev $ aopt textField (fslI MsgCompanyDepartment) , prismAForm (singletonFilter "company-department") mPrev $ aopt textField (fslI MsgCompanyDepartment)
, prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany) , prismAForm (singletonFilter "user-company") mPrev $ aopt textField (fslI MsgTableCompany)
, prismAForm (singletonFilter "user-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) , 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 "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 "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 } , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
, dbtParams = DBParamsForm , dbtParams = DBParamsForm