module Servant.Util.Beam.Postgres.Filtering
( matches_
, filtersGuard_
, filterOn
, manualFilter
, likeToSqlPattern
) where
import Universum
import Database.Beam.Backend.SQL (BeamSqlBackend, BeamSqlBackendIsString, BeamSqlBackendSyntax,
HasSqlValueSyntax, Sql92ExpressionValueSyntax,
Sql92SelectSelectTableSyntax, Sql92SelectTableExpressionSyntax)
import Database.Beam.Backend.SQL.SQL92 (Sql92SelectSyntax)
import Database.Beam.Query (HasSqlEqualityCheck, Q, guard_, in_, like_, val_, (&&.), (/=.), (<.),
(<=.), (==.), (>.), (>=.))
import Database.Beam.Query.Internal (QExpr)
import Servant.Util.Combinators.Filtering.Backend
import Servant.Util.Combinators.Filtering.Base
import Servant.Util.Combinators.Filtering.Filters
data QExprFilterBackend be s
instance FilterBackend (QExprFilterBackend be s) where
type AutoFilteredValue (QExprFilterBackend be s) a =
QExpr be s a
type MatchPredicate (QExprFilterBackend be s) =
QExpr be s Bool
instance ( HasSqlEqualityCheck be a
, HasSqlValueSyntax
(Sql92ExpressionValueSyntax
(Sql92SelectTableExpressionSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax
(Database.Beam.Backend.SQL.BeamSqlBackendSyntax be)))))
a
) =>
AutoFilterSupport (QExprFilterBackend be s) FilterMatching a where
autoFilterSupport :: FilterMatching a -> AutoFilterImpl (QExprFilterBackend be s) a
autoFilterSupport = \case
FilterMatching a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
FilterNotMatching a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
/=. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
FilterItemsIn [a]
vs -> (QExpr be s a -> [QExpr be s a] -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) a. SqlIn expr a => a -> [a] -> expr Bool
`in_` (a -> QExpr be s a) -> [a] -> [QExpr be s a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ [a]
vs)
instance ( BeamSqlBackend be
, HasSqlValueSyntax
(Sql92ExpressionValueSyntax
(Sql92SelectTableExpressionSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax
(Database.Beam.Backend.SQL.BeamSqlBackendSyntax be)))))
a
) =>
AutoFilterSupport (QExprFilterBackend be s) FilterComparing a where
autoFilterSupport :: FilterComparing a -> AutoFilterImpl (QExprFilterBackend be s) a
autoFilterSupport = \case
FilterGT a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
FilterLT a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
<. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
FilterGTE a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>=. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
FilterLTE a
v -> (QExpr be s a -> QExpr be s a -> QGenExpr QValueContext be s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
<=. HaskellLiteralForQExpr (QExpr be s a) -> QExpr be s a
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ a
HaskellLiteralForQExpr (QExpr be s a)
v)
pattern PgEsc :: Char
pattern $bPgEsc :: Char
$mPgEsc :: forall r. Char -> (Void# -> r) -> (Void# -> r) -> r
PgEsc = '\\'
likeToSqlPattern :: LikePattern -> String
likeToSqlPattern :: LikePattern -> String
likeToSqlPattern = String -> String
go (String -> String)
-> (LikePattern -> String) -> LikePattern -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LText -> String
forall a. ToString a => a -> String
toString (LText -> String)
-> (LikePattern -> LText) -> LikePattern -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LikePattern -> LText
unLikePattern
where
go :: String -> String
go = \case
Char
Esc : Char
'.' : String
r -> Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
Esc : Char
'*' : String
r -> Char
'*' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
Esc : Char
c : String
r -> Char
Esc Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
'_' : String
r -> Char
PgEsc Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
'%' : String
r -> Char
PgEsc Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
'.' : String
r -> Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
'*' : String
r -> Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
Char
c : String
r -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
r
[] -> []
instance ( IsString text
, BeamSqlBackend be
, BeamSqlBackendIsString be text
, HasSqlValueSyntax
(Sql92ExpressionValueSyntax
(Sql92SelectTableExpressionSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax
(Database.Beam.Backend.SQL.BeamSqlBackendSyntax be)))))
text
) =>
AutoFilterSupport (QExprFilterBackend be s) FilterLike text where
autoFilterSupport :: FilterLike text -> AutoFilterImpl (QExprFilterBackend be s) text
autoFilterSupport = \case
FilterLike (CaseSensitivity Bool
True) LikePattern
pat ->
let sqlPat :: text
sqlPat = String -> text
forall a. IsString a => String -> a
fromString (String -> text) -> String -> text
forall a b. (a -> b) -> a -> b
$ LikePattern -> String
likeToSqlPattern LikePattern
pat
in (QGenExpr QValueContext be s text
-> QGenExpr QValueContext be s text
-> QGenExpr QValueContext be s Bool
forall be text ctxt s.
(BeamSqlBackendIsString be text, BeamSqlBackend be) =>
QGenExpr ctxt be s text
-> QGenExpr ctxt be s text -> QGenExpr ctxt be s Bool
`like_` HaskellLiteralForQExpr (QGenExpr QValueContext be s text)
-> QGenExpr QValueContext be s text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ text
HaskellLiteralForQExpr (QGenExpr QValueContext be s text)
sqlPat)
FilterLike (CaseSensitivity Bool
False) LikePattern
_ ->
Text
-> QGenExpr QValueContext be s text
-> QGenExpr QValueContext be s Bool
forall a. HasCallStack => Text -> a
error Text
"Case-insensitive filters are not supported by this backend."
matches_
:: ( BeamSqlBackend be
, backend ~ QExprFilterBackend be s
, BackendApplySomeFilter backend params
)
=> FilteringSpec params
-> FilteringSpecApp backend params
-> QExpr be s Bool
matches_ :: FilteringSpec params
-> FilteringSpecApp backend params -> QExpr be s Bool
matches_ = (Element [QExpr be s Bool] -> QExpr be s Bool -> QExpr be s Bool)
-> QExpr be s Bool -> [QExpr be s Bool] -> QExpr be s Bool
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element [QExpr be s Bool] -> QExpr be s Bool -> QExpr be s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
(&&.) (HaskellLiteralForQExpr (QExpr be s Bool) -> QExpr be s Bool
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Bool
HaskellLiteralForQExpr (QExpr be s Bool)
True) ([QExpr be s Bool] -> QExpr be s Bool)
-> (FilteringSpec params
-> FilteringSpecApp (QExprFilterBackend be s) params
-> [QExpr be s Bool])
-> FilteringSpec params
-> FilteringSpecApp backend params
-> QExpr be s Bool
forall a b c. SuperComposition a b c => a -> b -> c
... FilteringSpec params
-> FilteringSpecApp (QExprFilterBackend be s) params
-> [QExpr be s Bool]
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpec params
-> FilteringSpecApp backend params -> [MatchPredicate backend]
backendApplyFilters
data QFilterBackend be (db :: (* -> *) -> *) s
instance FilterBackend (QFilterBackend be db s) where
type AutoFilteredValue (QFilterBackend be db s) a =
QExpr be s a
type MatchPredicate (QFilterBackend be db s) =
Q be db s ()
instance ( BeamSqlBackend be
, AutoFilterSupport (QExprFilterBackend be s) filter a
) =>
AutoFilterSupport (QFilterBackend be db s) filter a where
autoFilterSupport :: filter a -> AutoFilterImpl (QFilterBackend be db s) a
autoFilterSupport =
QExpr be s Bool -> Q be db s ()
forall be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
QExpr be s Bool -> Q be db s ()
guard_ (QExpr be s Bool -> Q be db s ())
-> (filter a -> QExpr be s a -> QExpr be s Bool)
-> filter a
-> QExpr be s a
-> Q be db s ()
forall a b c. SuperComposition a b c => a -> b -> c
... forall k (backend :: k) (filter :: * -> *) a.
AutoFilterSupport backend filter a =>
filter a -> AutoFilterImpl backend a
forall (filter :: * -> *) a.
AutoFilterSupport (QExprFilterBackend be s) filter a =>
filter a -> AutoFilterImpl (QExprFilterBackend be s) a
autoFilterSupport @(QExprFilterBackend _ _)
filtersGuard_
:: ( backend ~ QFilterBackend be db s
, BackendApplySomeFilter backend params
)
=> FilteringSpec params
-> FilteringSpecApp backend params
-> Q be db s ()
filtersGuard_ :: FilteringSpec params
-> FilteringSpecApp backend params -> Q be db s ()
filtersGuard_ = [Q be db s ()] -> Q be db s ()
forall t (m :: * -> *) a.
(Container t, Monad m, Element t ~ m a) =>
t -> m ()
sequence_ ([Q be db s ()] -> Q be db s ())
-> (FilteringSpec params
-> FilteringSpecApp (QFilterBackend be db s) params
-> [Q be db s ()])
-> FilteringSpec params
-> FilteringSpecApp backend params
-> Q be db s ()
forall a b c. SuperComposition a b c => a -> b -> c
... FilteringSpec params
-> FilteringSpecApp (QFilterBackend be db s) params
-> [Q be db s ()]
forall k (backend :: k) (params :: [TyNamedFilter]).
BackendApplySomeFilter backend params =>
FilteringSpec params
-> FilteringSpecApp backend params -> [MatchPredicate backend]
backendApplyFilters