136 lines
4.9 KiB
Haskell
136 lines
4.9 KiB
Haskell
{-# 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
|