Refactor for Database.Esqueleto.Utils

src/Database/Esqueleto/Utils.hs

@@ -0,0 +1,43 @@
+module Database.Esqueleto.Utils where
+
+-- | Convenience for using Esqueleto,
+--   intended to be imported qualified
+--   just like Esqueleto
+
+import ClassyPrelude.Yesod hiding (isInfixOf, (||.))
+import Data.Foldable as F
+import Database.Esqueleto as E
+
+
+-- ezero = E.val (0 :: Int64)
+
+-- | Often needed with this concrete type
+true :: E.SqlExpr (E.Value Bool)
+true  = E.val True
+
+-- | Often needed with this concrete type
+false :: E.SqlExpr (E.Value Bool)
+false = E.val False
+
+-- | Check if the first string is contained in the text derived from the second argument
+isInfixOf :: (E.Esqueleto query expr backend, E.SqlString s2) =>
+   Text -> expr (E.Value s2) -> expr (E.Value Bool)
+isInfixOf needle strExpr = E.castString strExpr `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
+
+hasInfix :: (E.Esqueleto query expr backend, E.SqlString s2) =>
+   expr (E.Value s2) -> Text -> expr (E.Value Bool)
+hasInfix = flip isInfixOf
+
+-- | Given a test and a set of values, check whether anyone succeeds the test
+--   WARNING: SQL leaves it explicitely unspecified whether || is short curcuited (i.e. lazily evaluated)
+any :: Foldable f =>
+  (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool)
+any test = F.foldr (\needle acc -> acc ||. test needle) false
+
+-- | Given a test and a set of values, check whether all succeeds the test
+--   WARNING: SQL leaves it explicitely unspecified whether && is short curcuited (i.e. lazily evaluated)
+all :: Foldable f =>
+  (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool)
+all test = F.foldr (\needle acc -> acc &&. test needle) true
+
+

src/Handler/Users.hs

@@ -12,6 +12,7 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 
 hijackUserForm :: CryptoUUIDUser -> Form ()
@@ -93,16 +94,13 @@ getUsersR = do
           ]
       , dbtFilter    = Map.fromList -- OverloadedLists does not work with the templates
           [ ( "user-search", FilterColumn $ \user criterion ->
-                -- let searchSql needle = E.castString (user E.^. UserDisplayName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%) in
-                if Set.null criterion then E.val True else -- TODO: why is this condition not needed?
-                    Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `eLike` needle) eFalse (criterion :: Set.Set Text)
+              if Set.null criterion then E.true else -- TODO: why is this condition not needed?
+                  -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
+                  E.any (user E.^. UserDisplayName `E.hasInfix`) criterion
             )
           , ( "matriculation", FilterColumn $ \user (criterion :: Set.Set Text) -> if
-                 | Set.null criterion -> eTrue -- TODO: why can this be eFalse and work still?
-                 | otherwise          ->
-                     -- user E.^. UserMatrikelnummer `E.in_` E.justList (E.valList $ Set.toList criterion)
-                     Set.foldr (\needle acc -> acc E.||. (user E.^. UserMatrikelnummer) `eLike` needle) eFalse criterion
-
+                 | Set.null criterion -> E.true -- TODO: why can this be eFalse and work still?
+                 | otherwise          -> E.any (user E.^. UserMatrikelnummer `E.hasInfix`) criterion
             )
           , ( "school", FilterColumn $ \user criterion -> if
                 | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)

src/Utils/DB.hs

@@ -10,20 +10,6 @@ import qualified Data.Set as Set
 import qualified Database.Esqueleto as E
 -- import Database.Persist -- currently not needed here
 
--- ezero = E.val (0 :: Int64)
-
--- | Often needed with this concrete type
-eTrue :: E.SqlExpr (E.Value Bool)
-eTrue  = E.val True
-
--- | Often needed with this concrete type
-eFalse :: E.SqlExpr (E.Value Bool)
-eFalse = E.val False
-
-eLike :: (E.Esqueleto query expr backend, E.SqlString s2, E.SqlString s1) =>
-   expr (E.Value s2) -> s1 -> expr (E.Value Bool)
-eLike strExpr needle = E.castString strExpr `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
-
 emptyOrIn :: PersistField typ =>
   E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)
 emptyOrIn criterion testSet

src/index.md

@@ -1,3 +1,6 @@
+Database,Esqueleto.*
+  : Hilfsdefinitionen, welche Esqueleto anbieten könnte
+
 Utils, Utils.*
   : Hilfsfunktionionen _unabhängig von Foundation_