fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactor for Database.Esqueleto.Utils

Browse Source
This commit is contained in:
SJost 2019-02-19 09:37:44 +01:00
parent 09844a6a78
commit cc2eb6d475
4 changed files with 88 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Database/Esqueleto/Utils.hs Normal file
View File

@ -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

14
src/Handler/Users.hs
View File

@ -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)

14
src/Utils/DB.hs
View File

@ -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

75
src/index.md
View File

@ -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