{-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Esqueleto.Utils ( true, false , isInfixOf, hasInfix , any, all , SqlIn(..) , mkExactFilter, mkExactFilterWith , mkContainsFilter , mkExistsFilter , anyFilter, allFilter ) where import ClassyPrelude.Yesod hiding (isInfixOf, any, all) import qualified Data.Set as Set import qualified Data.Foldable as F import qualified Database.Esqueleto as E import Database.Esqueleto.Utils.TH -- -- Description : Convenience for using `Esqueleto`, -- intended to be imported qualified -- just like @Esqueleto@ -- 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 -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool) any test = F.foldr (\needle acc -> acc E.||. 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 -> E.SqlExpr (E.Value Bool)) -> f a -> E.SqlExpr (E.Value Bool) all test = F.foldr (\needle acc -> acc E.&&. test needle) true -- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples $(sqlInTuples [2..16]) -- | Example for usage of unValueN _exampleUnValueN :: (E.Value a, E.Value b, E.Value c) -> (a,b,c) _exampleUnValueN = $(unValueN 3) -- | Example for usage of unValueNIs _exampleUnValueNIs :: (E.Value a, b, E.Value c) -> (a,b,c) _exampleUnValueNIs = $(unValueNIs 3 [1,3]) -- | Example for usage of sqlIJproj _queryFeaturesDegree :: (a `E.InnerJoin` b `E.InnerJoin` c) -> b _queryFeaturesDegree = $(sqlIJproj 3 2) -- | generic filter creation for dbTable -- 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) mkExactFilter = mkExactFilterWith id -- | like `mkExactFiler` but allows for conversion; convenient in conjunction with `anyFilter` and `allFilter` mkExactFilterWith :: (PersistField b) => (a -> b) -- ^ type conversion -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element -> t -- ^ query row -> Set.Set a -- ^ needle collection -> E.SqlExpr (E.Value Bool) mkExactFilterWith cast lenslike row criterias | Set.null criterias = true | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias) -- | generic filter creation for dbTable -- Given a lens-like function, make filter searching for needles in String-like elements -- (Keep Set here to ensure that there are no duplicates) 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 mkExistsFilter :: PathPiece a => (t -> a -> E.SqlQuery ()) -> t -> Set.Set a -> E.SqlExpr (E.Value Bool) mkExistsFilter query row criterias | Set.null criterias = true | otherwise = any (E.exists . query row) criterias -- | Combine several filters, using logical or anyFilter :: (Foldable f) => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) -> t -> Set.Set Text -> E.SqlExpr (E.Value Bool) anyFilter fltrs needle criterias = F.foldr aux false fltrs where aux fltr acc = fltr needle criterias E.||. acc -- | Combine several filters, using logical and allFilter :: (Foldable f) => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) -> t -> Set.Set Text -> E.SqlExpr (E.Value Bool) allFilter fltrs needle criterias = F.foldr aux true fltrs where aux fltr acc = fltr needle criterias E.&&. acc