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

2023-10-24 14:55:55 +00:00 · 2023-10-24 14:55:55 +00:00 · 9ca9c38830
commit 9ca9c38830
parent 315eedd1bc
5 changed files with 39 additions and 34 deletions
--- a/messages/uniworx/utils/table_column/de-de-formal.msg
+++ b/messages/uniworx/utils/table_column/de-de-formal.msg
@ -16,7 +16,7 @@ TableTerm !ident-ok: Jahr
 TableCourseSchool: Bereich
 TableSubmissionGroup: Feste Abgabegruppe
 TableNoSubmissionGroup: Keine feste Abgabegruppe
-TableMatrikelNr: AVS Nr
+TableMatrikelNr: AVS Personennummer
 TableSex: Geschlecht
 TableBirthday: Geburtsdatum
 TableSchool: Bereich
--- a/messages/uniworx/utils/table_column/en-eu.msg
+++ b/messages/uniworx/utils/table_column/en-eu.msg
@ -16,7 +16,7 @@ TableTerm: Year
 TableCourseSchool: Department
 TableSubmissionGroup: Registered submission group
 TableNoSubmissionGroup: No registered submission group
-TableMatrikelNr: AVS No
+TableMatrikelNr: AVS person no
 TableSex: Sex
 TableBirthday: Birthday
 TableSchool: Department
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@ -24,7 +24,7 @@ module Database.Esqueleto.Utils
  , mkContainsFilter, mkContainsFilterWith
  , mkContainsFilterWithSet, mkContainsFilterWithComma, mkContainsFilterWithCommaPlus
  , mkDayFilter, mkDayFilterFrom, mkDayFilterTo
-  , mkExistsFilter
+  , mkExistsFilter, mkExistsFilterWithComma
  , anyFilter, allFilter
  , ascNullsFirst, descNullsLast
  , orderByList
@ -421,6 +421,17 @@ mkExistsFilter query row criterias
  | Set.null criterias = true
  | 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
 anyFilter :: Foldable f
          => f (t -> cs -> E.SqlExpr (E.Value Bool))
--- a/src/Handler/PrintCenter.hs
+++ b/src/Handler/PrintCenter.hs
@ -225,9 +225,9 @@ mkPJTable = do
    dbtFilter = mconcat
      [ single ("name"         , FilterColumn . E.mkContainsFilterWithCommaPlus id                $ views (to queryPrintJob)      (E.^. PrintJobName))
      , single ("apcid"        , FilterColumn . E.mkContainsFilterWithComma     id                $ views (to queryPrintJob)      (E.^. PrintJobApcIdent))
-      , single ("filename"     , FilterColumn . E.mkContainsFilter                            $ views (to queryPrintJob)      (E.^. PrintJobFilename))      
-      , single ("created"      , FilterColumn . E.mkDayFilter                                 $ views (to queryPrintJob)      (E.^. PrintJobCreated))
-      --, single ("created"      , FilterColumn . E.mkDayBetweenFilter                        $ views (to queryPrintJob)      (E.^. PrintJobCreated))
+      , single ("filename"     , FilterColumn . E.mkContainsFilter                                $ views (to queryPrintJob)      (E.^. PrintJobFilename))      
+      , single ("created"      , FilterColumn . E.mkDayFilter                                     $ 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 ("sender"       , FilterColumn . E.mkContainsFilterWithCommaPlus Just              $ views (to querySender)        (E.?. UserDisplayName))
      , single ("course"       , FilterColumn . E.mkContainsFilterWith          (Just . CI.mk)    $ views (to queryCourse)        (E.?. CourseName))
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@ -101,7 +101,7 @@ postUsersR = do
          (AdminUserR <$> encrypt uid)
          (nameWidget userDisplayName userSurname)
      , 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
              E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
              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.%))
                      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
-                | otherwise         -> E.any (\c -> user E.^. UserMatrikelnummer `E.hasInfix` E.val c) criteria
-           )
-          , ( "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
+          , ( "personal-number"   , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserCompanyPersonalNumber))
+          , ( "matriculation"     , FilterColumn . E.mkContainsFilterWithComma Just $ (E.^. UserMatrikelnummer)) -- allows partial matches
+          , ( "company-department", FilterColumn $ \user (criteria :: Set.Set Text) -> if                        -- exact filter on table UserAvs
                 | 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
            )
@ -312,12 +306,12 @@ postUsersR = do
                      E.where_ $ (spvr E.^. UserSupervisorUser E.==. user E.^.UserId)
                        E.&&.  E.any (E.hasInfix (usrSpvr E.^. UserDisplayName)) (E.val <$> Set.toList criteria)
            )
-          , ( "avs-number", FilterColumn $ E.mkExistsFilter $ \user criterion ->
-              E.from $ \usrAvs -> -- do 
-                E.where_ $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
-                    E.&&.  ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
-                          (E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) )
-            )
+          -- , ( "avs-number", FilterColumn $ E.mkExistsFilterWithComma CI.mk $ \user criterion -> -- note that this is an exact filter
+          --     E.from $ \usrAvs -> -- do 
+          --       E.where_ $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
+          --           E.&&.  ((E.val criterion :: E.SqlExpr (E.Value (CI Text))) E.==.
+          --                 (E.explicitUnsafeCoerceSqlExprValue "citext" (usrAvs E.^. UserAvsNoPerson) :: E.SqlExpr (E.Value (CI Text))) )
+          --   )
          , ( "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 False)  -> E.notExists . E.from $ \usrSpr -> E.where_ $ user E.^. UserId E.==. usrSpr E.^. UserSupervisorSupervisor
@ -325,19 +319,19 @@ postUsersR = do
            )
          ]
      , 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 "personal-number" ) mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
-          , prismAForm (singletonFilter "avs-number" ) mPrev $ aopt textField (fslI MsgAvsPersonNo)
-          , 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 "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 "personal-number" )   mPrev $ aopt textField (fslI MsgCompanyPersonalNumber     & setTooltip MsgTableFilterCommaPlus)
+          , prismAForm (singletonFilter "matriculation")      mPrev $ aopt matriculationField  (fslI MsgTableMatrikelNr & setTooltip MsgTableFilterCommaPlus)    -- contains filter on UserMatrikelnummer
+          -- , 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 "user-company")       mPrev $ aopt textField (fslI MsgTableCompany)
+          , 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 "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 "auth-ldap"     . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` selectFieldList [(MsgAuthPWHash "", False), (MsgAuthLDAP, True)]) (fslI MsgAuthMode)          
+          , prismAForm (singletonFilter "ldap-sync"     . maybePrism _PathPiece) mPrev $ aopt utcTimeField (fslI MsgLdapSyncedBefore)
          ]
      , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
      , dbtParams    = DBParamsForm