Generic contains SQL filter for generic user column

src/Database/Esqueleto/Utils.hs

@@ -5,7 +5,7 @@ module Database.Esqueleto.Utils
   , isInfixOf, hasInfix
   , any, all
   , SqlIn(..)
-  , mkInFilter
+  , mkExactFilter, mkContainsFilter
   ) where
 
 import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
@@ -52,23 +52,31 @@ all :: Foldable f =>
   (a -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool)
 all test = F.foldr (\needle acc -> acc E.&&. test needle) true
 
+
 $(sqlInTuples [2..16])
 
 
 -- | generic filter creation for dbTable
---   Given a lens-like function, make filter
+--   Given a lens-like function, make filter for exact matches in a collection
--- What I thought:
+--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
--- mkFilter :: (Foldable f, E.From query expr backend a)
+mkExactFilter :: (PersistField a)
---    => (a -> E.SqlExpr (E.Value b))
+  =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
---    -> a
+  -> t                             -- ^ query row
---    -> f b
+  -> Set.Set a                     -- ^ needle collection
---    -> E.SqlExpr (E.Value Bool)
--- What is inferred:
-mkInFilter :: (PersistField a)
-  =>  (t -> E.SqlExpr (E.Value a))
-  -> t
-  -> Set.Set a
   -> E.SqlExpr (E.Value Bool)
-mkInFilter lenslike row criterias
+mkExactFilter lenslike row criterias
   | Set.null criterias = true
-  | otherwise      = (lenslike row) `E.in_` E.valList (Set.toList criterias)
+  | otherwise = (lenslike row) `E.in_` E.valList (Set.toList criterias)
+
+-- | generic filter creation for dbTable
+--   Given a lens-like function, make filter searching for needles in String-like elements
+--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
+mkContainsFilter :: (E.SqlString a)
+  =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
+  -> t                             -- ^ query row
+  -> Set.Set Text                  -- ^ needle collection
+  -> E.SqlExpr (E.Value Bool)
+mkContainsFilter lenslike row criterias
+  | Set.null criterias = true
+  | otherwise = any (hasInfix $ lenslike row) criterias
+

src/Handler/Course.hs

@@ -767,7 +767,7 @@ makeCourseUserTable cid colChoices psValidator =
         ]
       dbtFilter    = Map.fromList
         [ filterUserName queryUser
-        , ( "course-user-semesternr", FilterColumn $ mkInFilter queryUserSemester)
+        , ( "course-user-semesternr", FilterColumn $ mkExactFilter queryUserSemester)
         -- TODO
         ]
       dbtFilterUI  = mempty -- TODO

src/Handler/Utils/Table/Columns.hs

@@ -65,10 +65,19 @@ defaultSortingByName = defaultSorting [SortAscBy "user-surname", SortAscBy "user
 filterUserName :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
   => (a2 -> E.SqlExpr (Entity User))
   -> (a1, FilterColumn t)
-filterUserName queryUser = ( "user-surname", FilterColumn $ mkInFilter queryName )
+filterUserName queryUser = ( "user-surname", FilterColumn $ mkContainsFilter queryName )
   where
     queryName = compose queryUser (E.^. UserSurname)
 
+filterUserNameExact :: (IsFilterColumn t (a2 -> Set Text -> E.SqlExpr (E.Value Bool)), IsString a1)
+  => (a2 -> E.SqlExpr (Entity User))
+  -> (a1, FilterColumn t)
+filterUserNameExact queryUser = ( "user-surname", FilterColumn $ mkExactFilter queryName )
+  where
+    queryName = compose queryUser (E.^. UserSurname)
+
+
+
 
 -------------------
 -- Matriclenumber