From c4d77d665ac806334e5c32819f1c1f5cfe55180a Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Sat, 9 Mar 2019 14:35:47 +0100
Subject: [PATCH] Generic contains SQL filter for generic user column

---
 src/Database/Esqueleto/Utils.hs    | 38 ++++++++++++++++++------------
 src/Handler/Course.hs              |  2 +-
 src/Handler/Utils/Table/Columns.hs | 11 ++++++++-
 3 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 5f904f6f3..f3594d523 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/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
--- What I thought:
--- mkFilter :: (Foldable f, E.From query expr backend a)
---    => (a -> E.SqlExpr (E.Value b))
---    -> a
---    -> f b
---    -> E.SqlExpr (E.Value Bool)
--- What is inferred:
-mkInFilter :: (PersistField a)
-  =>  (t -> E.SqlExpr (E.Value a))
-  -> t
-  -> Set.Set a
+--   Given a lens-like function, make filter for exact matches in a collection
+--   (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
+mkExactFilter :: (PersistField a)
+  =>  (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
+  -> t                             -- ^ query row
+  -> Set.Set a                     -- ^ needle collection
   -> 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)
\ No newline at end of file
+  | 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
+
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index c32e6d47d..9ed7a197b 100644
--- a/src/Handler/Course.hs
+++ b/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
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index 6ff916033..f864e15ef 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/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