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.true else -- TODO: why is this condition not needed?
-                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) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text)
-                    Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `eLike` 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?
+                 | Set.null criterion -> E.true -- TODO: why can this be eFalse and work still?
-                 | otherwise          ->
+                 | otherwise          -> E.any (user E.^. UserMatrikelnummer `E.hasInfix`) criterion
-                     -- 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
-
             )
           , ( "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,40 +1,43 @@
+Database,Esqueleto.*
+  : Hilfsdefinitionen, welche Esqueleto anbieten könnte
+
 Utils, Utils.*
   : Hilfsfunktionionen _unabhängig von Foundation_
-  
+
 Utils
   : Yesod Hilfsfunktionen und Instanzen, Text-HTML-Widget-Konvertierungen
     (`DisplayAble`), Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`,
     `MaybeT`, `Map`, und Attrs-Lists
-    
+
 Utils.TH
   : Template Haskell code-generatoren von unabhängigen Hilfsfunktionen (`deriveSimpleWith`)
-  
+
 Utils.DB
   : Derived persistent functions (`existsBy`, `getKeyBy404`, ...)
-  
+
 Utils.Form
   : `renderAForm`, Field-Settings helper, `FormIdentifier`, `Button`-Klasse,
     unabhängige konkrete Buttons
-    
+
 Utils.PathPiece
   : (Template-Haskell)-Hilfsfunktionen für Formulierung von PathPiece-Instanzen
-    
+
 Utils.Message
   : redefines addMessage, addMessageI, defines MessageClass
 
 Utils.Lens
   : Automatisch erzeugt Linsen für eigene und Yesod-Typen, `Control.Lens`-Export
-  
+
 Utils.DateTime
   : Template Haskell code-generatoren zum compile-time einbinden von Zeitzone
     und `TimeLocale`
-  
+
 Handler.Utils, Handler.Utils.*
   : Hilfsfunktionien, importieren `Import`
-  
+
 Handler.Utils
   : `Handler.Utils.*`, Unsortierte _Foundation-abhängige_ Hilfsfunktionen
-  
+
 Handler.Utils.DateTime
   : Nutzer-spezifisches `DateTime`-Formatieren
 
@@ -42,39 +45,39 @@ Handler.Utils.Form
   : Konkrete Buttons, spezielle Felder (inkl. Datei-Upload-Felder),
     Optionslisten (`optionsPersistCryptoId`), `forced`-Felder (erzwungenes
     Ergebnis, deaktiviertes Feld), `multiAction`
-    
+
 Handler.Utils.Rating
   : `Rating` (kodiert eine Rating-Datei), Parsen und PrettyPrinten von
     Rating-Dateien
-    
+
 Handler.Utils.Sheet
   : `fetchSheet`
-  
+
 Handler.Utils.StudyFeatures
   : Parsen von LDAP StudyFeatures-Strings
-  
+
 Handler.Utils.Submission
   : `assignSubmissions`, `sinkSubmission` State-Maschinen die (bereits geparste)
     ZIP-Archive auseinandernehmen und (in einer Transaction) in die Datenbank
     speichern
-    
+
 Handler.Utils.Submission.TH
   : Template Haskell zum parsen und einkompilieren von Dateiname-Blacklist für
     `sinkSubmission`; Patterns in `config/submission-blacklist`
-    
+
 Handler.Utils.Table
   : Hilfsfunktion zum direkten Benutzen von Colonnade (kein `dbTable`)
-  
+
 Handler.Utils.Table.Pagination
   : Here be Dragons
-  
+
     Paginated database-backed tables with support for sorting, filtering,
     numbering, forms, further database-requests within cells
-    
+
     Includes helper functions for mangling pagination-, sorting-, and filter-settings
-    
+
     Includes helper functions for constructing common types of cells
-  
+
 Handler.Utils.Table.Pagination.Types
   : `Sortable`-Headedness for colonnade
 
@@ -83,17 +86,17 @@ Handler.Utils.Table.Cells
 
 Handler.Utils.Templates
   : Modals
-  
+
 Handler.Utils.Zip
   : Conduit-basiertes ZIP Parsen und Erstellen
-  
+
 Handler.Common
   : Handler aus dem Scaffolding; Implementierungen von Handlern, die _jede
     Website_ irgendwann braucht
-    
+
 CryptoID
   : Definiert CryptoIDs für custom Typen (aus Model)
-  
+
 Model.Migration
   : Manuelle Datenbank-Migration
 
@@ -103,43 +106,43 @@ Model.Rating
 Jobs
   : `handleJobs` worker thread handling background jobs
     `JobQueueException`
-    
+
 Jobs.Types
   : `Job`, `Notification`, `JobCtl` Types of Jobs
-  
+
 Cron.Types
   : Datentypen zur Spezifikation von Intervallen zu denen Jobs ausgeführt werden
     können:
-  
+
     `Cron`, `CronMatch`, `CronAbsolute`, `CronRepeat`, `Crontab`
-    
+
 Cron
   : Seiteneffektfreie Berechnungen auf Typen aus `Cron.Types`: `nextCronMatch`
-  
+
 Jobs.Queue
   : Funktionen zum _anstoßen_ von Jobs und zur Kommunikation mit den
     Worker-Threads
-  
+
     `writeJobCtl` schickt Nachricht an einen pseudo-Zufälligen worker-thread der
     lokalen Instanz
-    
+
     `queueJob` und `queueJob'` schreiben neue Jobs in die Instanz-übergreifende
     Job-Queue, `queueJob'` stößt außerdem einen lokalen worker-thread an sich
     des Jobs anzunehmen
-    
+
     `runDBJobs` ersetzt `runDB` und erlaubt `queueDBJob` zu
     benutzen. `queueDBJob` schreibt einen Job in die Queue; am Ende stößt
     `runDBJobs` lokale worker-threads für alle mit `queueDBJobs` eingetragenen
     Jobs an.
-    
+
 Jobs.TH
   : Templatehaskell für den dispatch mechanismus für `Jobs`
-  
+
 Jobs.Crontab
   : Generiert `Crontab JobCtl` aus der Datenbank (sammelt alle in den Daten aus
     der Datenbank impliziten Jobs (notifications zu bestimmten zeiten,
     aufräumaktionen, ...) ein)
-    
+
 Jobs.Handler.**
   : Via `Jobs.TH` delegiert `Jobs` das Interpretieren und Ausführen eines Werts
     aus `Jobs.Types` an einen dieser Handler