From cc2eb6d475d31da54fa8edb14db74ae9295cdeed Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 19 Feb 2019 09:37:44 +0100 Subject: [PATCH] Refactor for Database.Esqueleto.Utils --- src/Database/Esqueleto/Utils.hs | 43 +++++++++++++++++++ src/Handler/Users.hs | 14 +++--- src/Utils/DB.hs | 14 ------ src/index.md | 75 +++++++++++++++++---------------- 4 files changed, 88 insertions(+), 58 deletions(-) create mode 100644 src/Database/Esqueleto/Utils.hs diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs new file mode 100644 index 000000000..443af5517 --- /dev/null +++ b/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 + + diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 8e9f05af2..f1d1e575b 100644 --- a/src/Handler/Users.hs +++ b/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) diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index a2d79c8f7..cb8b80d4e 100644 --- a/src/Utils/DB.hs +++ b/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 diff --git a/src/index.md b/src/index.md index 563023e8b..f2b0b8adf 100644 --- a/src/index.md +++ b/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