refactor(qualification): card filter accepts multiple cards now

src/Database/Esqueleto/Utils.hs

@@ -347,7 +347,7 @@ mkExactFilterMaybeLast' lensexists lenslike row criterias
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter searching for needles in String-like elements
 --   (Keep Set here to ensure that there are no duplicates)
-mkContainsFilter :: E.SqlString a
+mkContainsFilter :: (E.SqlString a, Ord a)
                  => (t -> E.SqlExpr (E.Value a))  -- ^ getter from query to searched element
                  -> t                             -- ^ query row
                  -> Set.Set a                     -- ^ needle collection
@@ -355,7 +355,7 @@ mkContainsFilter :: E.SqlString a
 mkContainsFilter = mkContainsFilterWith id
 
 -- | like `mkContainsFilter` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter`
-mkContainsFilterWith :: E.SqlString b
+mkContainsFilterWith :: (E.SqlString b, Ord a)
                      => (a -> b)
                      -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
                      -> t                             -- ^ query row
@@ -363,7 +363,7 @@ mkContainsFilterWith :: E.SqlString b
                      -> E.SqlExpr (E.Value Bool)
 mkContainsFilterWith cast lenslike row criterias
   | Set.null criterias = true
-  | otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias)
+  | otherwise = any (hasInfix (lenslike row) . E.val . cast) criterias
 
 -- | like `mkContainsFilterWith` but allows conversion to produce multiple needles
 mkContainsFilterWithSet :: (E.SqlString b, Ord b, Ord a)
@@ -374,7 +374,7 @@ mkContainsFilterWithSet :: (E.SqlString b, Ord b, Ord a)
                      -> E.SqlExpr (E.Value Bool)
 mkContainsFilterWithSet cast lenslike row criterias
   | Set.null criterias = true
-  | otherwise = any (hasInfix $ lenslike row) (E.val <$> Set.toList (foldMap cast criterias))
+  | otherwise = any (hasInfix (lenslike row) . E.val)  (foldMap cast criterias)
 
 -- | like `mkContainsFilterWithSet` but fixed to comma separated Texts
 mkContainsFilterWithComma :: (E.SqlString b, Ord b)
@@ -385,7 +385,7 @@ mkContainsFilterWithComma :: (E.SqlString b, Ord b)
                      -> E.SqlExpr (E.Value Bool)
 mkContainsFilterWithComma cast lenslike row (foldMap commaSeparatedText -> criterias)
   | Set.null criterias = true
-  | otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias)
+  | otherwise = any (hasInfix (lenslike row) . E.val . cast) criterias
 
 -- | like `mkContainsFilterWithComma` but enforced the existence of all Texts prefixed with +
 mkContainsFilterWithCommaPlus :: (E.SqlString b, Ord b)
@@ -401,8 +401,8 @@ mkContainsFilterWithCommaPlus cast lenslike row (foldMap commaSeparatedText -> c
   | otherwise             = cond_compulsory E.&&. cond_optional
   where    
     (Set.mapMonotonic (Text.stripStart . Text.drop 1) -> compulsories, alternatives) = Set.partition (Text.isPrefixOf "+") criterias
-    cond_compulsory = all (hasInfix $ lenslike row) (E.val . cast <$> Set.toList compulsories)
+    cond_compulsory = all (hasInfix (lenslike row) . E.val . cast) compulsories
-    cond_optional   = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList alternatives)
+    cond_optional   = any (hasInfix (lenslike row) . E.val . cast) alternatives
 
 mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime))  -- ^ getter from query to searched element
             -> t                                   -- ^ query row
@@ -447,7 +447,7 @@ mkExistsFilterWithComma :: PathPiece a
                -> 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)
+  | otherwise = any (E.exists . query row . cast) criterias
 
 
 -- | Combine several filters, using logical or

src/Handler/Qualification.hs

@@ -416,16 +416,15 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       --           E.on     $ usrAvs E.^. UserAvsPersonId  E.==. avsCard E.^. UserAvsCardPersonId  
       --           E.where_ $ usrAvs E.^. UserAvsUser      E.==. user    E.^. UserId
       --               E.&&. (avsCard E.^. UserAvsCardCardNo E.==. E.val cardNo)
-      --     )
+      --     )      
-      -- , single ("avs-card"  , FilterColumnIO $ \(queryUser -> user) (criterion :: [Text]) -> const (return E.true :: IO (E.SqlExpr (E.Value Bool))) -- putStrLn "********   IT WORKS   *****************"
       , single ("avs-card"  , FilterColumnHandler $ \(criteria :: [Text]) -> 
           case criteria of 
             [] -> return (const E.true) :: Handler (QualificationTableExpr -> E.SqlExpr (E.Value Bool))
             xs -> do
-              apids <- queryAvsCardNos $ mapMaybe parseAvsCardNo xs -- $ foldMap cfAnySeparatedSet xs TODO
+              let crds = mapMaybe parseAvsCardNo $ foldMap anySeparatedText xs
+              apids <- queryAvsCardNos crds
               if null apids
-                then 
+                then                   
-                  -- addMessageI ???
                   return (const E.false)
                 else 
                   return $ \(queryUser-> user) ->
@@ -463,7 +462,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
       , prismAForm (singletonFilter "user-company")                             mPrev $ aopt textField (fslI MsgTableCompany)
       , prismAForm (singletonFilter "personal-number" )                         mPrev $ aopt textField (fslI MsgCompanyPersonalNumber)
-      , prismAForm (singletonFilter "avs-card" )                                mPrev $ aopt textField (fslI MsgAvsCardNo) --  & cfAnySeparatedSet
+      , prismAForm (singletonFilter "avs-card" )                                mPrev $ aopt textField (fslI MsgAvsCardNo & setTooltip MsgTableFilterComma)
       , prismAForm (singletonFilter "avs-number" )                              mPrev $ aopt textField (fslI MsgAvsPersonNo)            
       , prismAForm (singletonFilter "validity"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
       , if isNothing mbRenewal then mempty

src/Utils.hs

@@ -526,6 +526,12 @@ textUnlines = Text.intercalate $ Text.singleton '\n'
 commaSeparatedText :: Text -> Set Text
 commaSeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split (==',')
 
+-- also see Utils.Form.cfAnySeparatedSet
+anySeparatedText :: Text -> Set Text
+anySeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split anySeparator
+  where anySeparator :: Char -> Bool
+        anySeparator c = Char.isSeparator c || c == ',' || c == ';'
+
 
 -----------
 -- Fixed --