{-# LANGUAGE PartialTypeSignatures #-}

-- | Postgres Translate BoolExp
--
-- Convert IR boolean expressions to Postgres-specific SQL expressions.
module Hasura.Backends.Postgres.Translate.BoolExp
  ( toSQLBoolExp,
    annBoolExp,
  )
where

import Data.HashMap.Strict qualified as M
import Data.Text.Extended (ToTxt)
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.SQL.Types hiding (TableName)
import Hasura.Backends.Postgres.Types.BoolExp
import Hasura.Backends.Postgres.Types.Function (onArgumentExp)
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BoolExp
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache hiding (BoolExpCtx (..), BoolExpM (..))
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types

-- This convoluted expression instead of col = val
-- to handle the case of col : null
equalsBoolExpBuilder :: SQLExpression ('Postgres pgKind) -> SQLExpression ('Postgres pgKind) -> S.BoolExp
equalsBoolExpBuilder :: SQLExpression ('Postgres pgKind)
-> SQLExpression ('Postgres pgKind) -> BoolExp
equalsBoolExpBuilder SQLExpression ('Postgres pgKind)
qualColExp SQLExpression ('Postgres pgKind)
rhsExp =
  BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin
    BinOp
S.OrOp
    (CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
qualColExp SQLExpression ('Postgres pgKind)
SQLExp
rhsExp)
    ( BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin
        BinOp
S.AndOp
        (SQLExp -> BoolExp
S.BENull SQLExpression ('Postgres pgKind)
SQLExp
qualColExp)
        (SQLExp -> BoolExp
S.BENull SQLExpression ('Postgres pgKind)
SQLExp
rhsExp)
    )

notEqualsBoolExpBuilder :: SQLExpression ('Postgres pgKind) -> SQLExpression ('Postgres pgKind) -> S.BoolExp
notEqualsBoolExpBuilder :: SQLExpression ('Postgres pgKind)
-> SQLExpression ('Postgres pgKind) -> BoolExp
notEqualsBoolExpBuilder SQLExpression ('Postgres pgKind)
qualColExp SQLExpression ('Postgres pgKind)
rhsExp =
  BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin
    BinOp
S.OrOp
    (CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNE SQLExpression ('Postgres pgKind)
SQLExp
qualColExp SQLExpression ('Postgres pgKind)
SQLExp
rhsExp)
    ( BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin
        BinOp
S.AndOp
        (SQLExp -> BoolExp
S.BENotNull SQLExpression ('Postgres pgKind)
SQLExp
qualColExp)
        (SQLExp -> BoolExp
S.BENull SQLExpression ('Postgres pgKind)
SQLExp
rhsExp)
    )

annBoolExp ::
  (QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
  BoolExpRHSParser b m v ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  GBoolExp b ColExp ->
  m (AnnBoolExp b v)
annBoolExp :: BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
fim GBoolExp b ColExp
boolExp =
  case GBoolExp b ColExp
boolExp of
    BoolAnd [GBoolExp b ColExp]
exps -> [AnnBoolExp b v] -> AnnBoolExp b v
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd ([AnnBoolExp b v] -> AnnBoolExp b v)
-> m [AnnBoolExp b v] -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps [GBoolExp b ColExp]
exps
    BoolOr [GBoolExp b ColExp]
exps -> [AnnBoolExp b v] -> AnnBoolExp b v
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolOr ([AnnBoolExp b v] -> AnnBoolExp b v)
-> m [AnnBoolExp b v] -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps [GBoolExp b ColExp]
exps
    BoolNot GBoolExp b ColExp
e -> AnnBoolExp b v -> AnnBoolExp b v
forall (backend :: BackendType) field.
GBoolExp backend field -> GBoolExp backend field
BoolNot (AnnBoolExp b v -> AnnBoolExp b v)
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
fim GBoolExp b ColExp
e
    BoolExists (GExists TableName b
refqt GBoolExp b ColExp
whereExp) ->
      Text -> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_exists" (m (AnnBoolExp b v) -> m (AnnBoolExp b v))
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ do
        FieldInfoMap (FieldInfo b)
refFields <- Text
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_table" (m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b)))
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b, TableCoreInfoRM b m) =>
TableName b -> m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource TableName b
refqt
        AnnBoolExp b v
annWhereExp <- Text -> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"_where" (m (AnnBoolExp b v) -> m (AnnBoolExp b v))
-> m (AnnBoolExp b v) -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
refFields GBoolExp b ColExp
whereExp
        AnnBoolExp b v -> m (AnnBoolExp b v)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExp b v -> m (AnnBoolExp b v))
-> AnnBoolExp b v -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v
forall (backend :: BackendType) field.
GExists backend field -> GBoolExp backend field
BoolExists (GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v)
-> GExists b (AnnBoolExpFld b v) -> AnnBoolExp b v
forall a b. (a -> b) -> a -> b
$ TableName b -> AnnBoolExp b v -> GExists b (AnnBoolExpFld b v)
forall (backend :: BackendType) field.
TableName backend
-> GBoolExp backend field -> GExists backend field
GExists TableName b
refqt AnnBoolExp b v
annWhereExp
    BoolField ColExp
fld -> AnnBoolExpFld b v -> AnnBoolExp b v
forall (backend :: BackendType) field.
field -> GBoolExp backend field
BoolField (AnnBoolExpFld b v -> AnnBoolExp b v)
-> m (AnnBoolExpFld b v) -> m (AnnBoolExp b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
annColExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
fim ColExp
fld
  where
    procExps :: [GBoolExp b ColExp] -> m [AnnBoolExp b v]
procExps = (GBoolExp b ColExp -> m (AnnBoolExp b v))
-> [GBoolExp b ColExp] -> m [AnnBoolExp b v]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
fim)

annColExp ::
  (QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
  BoolExpRHSParser b m v ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  ColExp ->
  m (AnnBoolExpFld b v)
annColExp :: BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ColExp
-> m (AnnBoolExpFld b v)
annColExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
colInfoMap (ColExp FieldName
fieldName Value
colVal) = do
  FieldInfo b
colInfo <- FieldInfoMap (FieldInfo b) -> FieldName -> m (FieldInfo b)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo b)
colInfoMap FieldName
fieldName
  case FieldInfo b
colInfo of
    FIColumn ColumnInfo b
pgi -> ColumnInfo b -> [OpExpG b v] -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
ColumnInfo backend
-> [OpExpG backend leaf] -> AnnBoolExpFld backend leaf
AVColumn ColumnInfo b
pgi ([OpExpG b v] -> AnnBoolExpFld b v)
-> m [OpExpG b v] -> m (AnnBoolExpFld b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ColumnReference b
-> Value
-> m [OpExpG b v]
forall (b :: BackendType) (m :: * -> *) v.
(BackendMetadata b, MonadError QErr m, TableCoreInfoRM b m) =>
ValueParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ColumnReference b
-> Value
-> m [OpExpG b v]
parseBoolExpOperations (BoolExpRHSParser b m v -> ValueParser b m v
forall (b :: BackendType) (m :: * -> *) v.
BoolExpRHSParser b m v -> ValueParser b m v
_berpValueParser BoolExpRHSParser b m v
rhsParser) TableName b
rootTable FieldInfoMap (FieldInfo b)
colInfoMap (ColumnInfo b -> ColumnReference b
forall (b :: BackendType). ColumnInfo b -> ColumnReference b
ColumnReferenceColumn ColumnInfo b
pgi) Value
colVal
    FIRelationship RelInfo b
relInfo -> do
      BoolExp b
relBoolExp <- Value -> m (BoolExp b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue Value
colVal
      FieldInfoMap (FieldInfo b)
relFieldInfoMap <- TableName b -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b, TableCoreInfoRM b m) =>
TableName b -> m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource (TableName b -> m (FieldInfoMap (FieldInfo b)))
-> TableName b -> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ RelInfo b -> TableName b
forall (b :: BackendType). RelInfo b -> TableName b
riRTable RelInfo b
relInfo
      AnnBoolExp b v
annRelBoolExp <- BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
relFieldInfoMap (GBoolExp b ColExp -> m (AnnBoolExp b v))
-> GBoolExp b ColExp -> m (AnnBoolExp b v)
forall a b. (a -> b) -> a -> b
$ BoolExp b -> GBoolExp b ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp b
relBoolExp
      AnnBoolExpFld b v -> m (AnnBoolExpFld b v)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpFld b v -> m (AnnBoolExpFld b v))
-> AnnBoolExpFld b v -> m (AnnBoolExpFld b v)
forall a b. (a -> b) -> a -> b
$ RelInfo b -> AnnBoolExp b v -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
RelInfo backend
-> AnnBoolExp backend leaf -> AnnBoolExpFld backend leaf
AVRelationship RelInfo b
relInfo AnnBoolExp b v
annRelBoolExp
    FIComputedField ComputedFieldInfo b
computedFieldInfo ->
      AnnComputedFieldBoolExp b v -> AnnBoolExpFld b v
forall (backend :: BackendType) leaf.
AnnComputedFieldBoolExp backend leaf -> AnnBoolExpFld backend leaf
AVComputedField (AnnComputedFieldBoolExp b v -> AnnBoolExpFld b v)
-> m (AnnComputedFieldBoolExp b v) -> m (AnnBoolExpFld b v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoolExpResolver b m v
-> BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ComputedFieldInfo b
-> Value
-> m (AnnComputedFieldBoolExp b v)
forall (b :: BackendType) (m :: * -> *) v.
(BackendMetadata b, MonadError QErr m, TableCoreInfoRM b m) =>
BoolExpResolver b m v
-> BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> ComputedFieldInfo b
-> Value
-> m (AnnComputedFieldBoolExp b v)
buildComputedFieldBooleanExp ((BoolExpRHSParser b m v
 -> TableName b
 -> FieldInfoMap (FieldInfo b)
 -> GBoolExp b ColExp
 -> m (AnnBoolExp b v))
-> BoolExpResolver b m v
forall (b :: BackendType) (m :: * -> *) v.
(BoolExpRHSParser b m v
 -> TableName b
 -> FieldInfoMap (FieldInfo b)
 -> GBoolExp b ColExp
 -> m (AnnBoolExp b v))
-> BoolExpResolver b m v
BoolExpResolver BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp) BoolExpRHSParser b m v
rhsParser TableName b
rootTable FieldInfoMap (FieldInfo b)
colInfoMap ComputedFieldInfo b
computedFieldInfo Value
colVal
    -- Using remote fields in the boolean expression is not supported.
    FIRemoteRelationship {} ->
      Code -> Text -> m (AnnBoolExpFld b v)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload Text
"remote field unsupported"

-- | Translate an IR boolean expression to an SQL boolean expression. References
-- to columns etc are relative to the given 'rootReference'.
toSQLBoolExp ::
  forall pgKind.
  Backend ('Postgres pgKind) =>
  -- | The name of the tabular value in query scope that the boolean expression
  -- applies to
  S.Qual ->
  -- | The boolean expression to translate
  AnnBoolExpSQL ('Postgres pgKind) ->
  S.BoolExp
toSQLBoolExp :: Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
toSQLBoolExp Qual
rootReference AnnBoolExpSQL ('Postgres pgKind)
e =
  State Word64 BoolExp -> Word64 -> BoolExp
forall s a. State s a -> s -> a
evalState
    ( ReaderT BoolExpCtx (State Word64) BoolExp
-> BoolExpCtx -> State Word64 BoolExp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        (BoolExpM BoolExp -> ReaderT BoolExpCtx (State Word64) BoolExp
forall a. BoolExpM a -> ReaderT BoolExpCtx (State Word64) a
unBoolExpM (AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
e))
        BoolExpCtx
initialCtx
    )
    Word64
0
  where
    initialCtx :: BoolExpCtx
initialCtx =
      BoolExpCtx :: Qual -> Qual -> BoolExpCtx
BoolExpCtx
        { currTableReference :: Qual
currTableReference = Qual
rootReference,
          rootReference :: Qual
rootReference = Qual
rootReference
        }

-- | The table context of boolean expression translation. This is used to
-- resolve references to fields, as those may refer to the so-called 'root
-- table' (identified by a '$'-sign in the expression input syntax) or the
-- 'current' table.
data BoolExpCtx = BoolExpCtx
  { -- | Reference to the current tabular value.
    BoolExpCtx -> Qual
currTableReference :: S.Qual,
    -- | Reference to the root tabular value.
    BoolExpCtx -> Qual
rootReference :: S.Qual
  }

-- | The monad that carries the translation of boolean expressions. This
-- supports the generation of fresh names for aliasing sub-expressions and
-- maintains the table context of the expressions being translated.
newtype BoolExpM a = BoolExpM {BoolExpM a -> ReaderT BoolExpCtx (State Word64) a
unBoolExpM :: ReaderT BoolExpCtx (State Word64) a}
  deriving (a -> BoolExpM b -> BoolExpM a
(a -> b) -> BoolExpM a -> BoolExpM b
(forall a b. (a -> b) -> BoolExpM a -> BoolExpM b)
-> (forall a b. a -> BoolExpM b -> BoolExpM a) -> Functor BoolExpM
forall a b. a -> BoolExpM b -> BoolExpM a
forall a b. (a -> b) -> BoolExpM a -> BoolExpM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BoolExpM b -> BoolExpM a
$c<$ :: forall a b. a -> BoolExpM b -> BoolExpM a
fmap :: (a -> b) -> BoolExpM a -> BoolExpM b
$cfmap :: forall a b. (a -> b) -> BoolExpM a -> BoolExpM b
Functor, Functor BoolExpM
a -> BoolExpM a
Functor BoolExpM
-> (forall a. a -> BoolExpM a)
-> (forall a b. BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b)
-> (forall a b c.
    (a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c)
-> (forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b)
-> (forall a b. BoolExpM a -> BoolExpM b -> BoolExpM a)
-> Applicative BoolExpM
BoolExpM a -> BoolExpM b -> BoolExpM b
BoolExpM a -> BoolExpM b -> BoolExpM a
BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
(a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
forall a. a -> BoolExpM a
forall a b. BoolExpM a -> BoolExpM b -> BoolExpM a
forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
forall a b. BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
forall a b c.
(a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BoolExpM a -> BoolExpM b -> BoolExpM a
$c<* :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM a
*> :: BoolExpM a -> BoolExpM b -> BoolExpM b
$c*> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
liftA2 :: (a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
<*> :: BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
$c<*> :: forall a b. BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
pure :: a -> BoolExpM a
$cpure :: forall a. a -> BoolExpM a
$cp1Applicative :: Functor BoolExpM
Applicative, Applicative BoolExpM
a -> BoolExpM a
Applicative BoolExpM
-> (forall a b. BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b)
-> (forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b)
-> (forall a. a -> BoolExpM a)
-> Monad BoolExpM
BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
BoolExpM a -> BoolExpM b -> BoolExpM b
forall a. a -> BoolExpM a
forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
forall a b. BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> BoolExpM a
$creturn :: forall a. a -> BoolExpM a
>> :: BoolExpM a -> BoolExpM b -> BoolExpM b
$c>> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
>>= :: BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
$c>>= :: forall a b. BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
$cp1Monad :: Applicative BoolExpM
Monad, MonadReader BoolExpCtx, MonadState Word64)

-- | Translate a 'GBoolExp' with annotated SQLExpressions in the leaves into a
-- bare SQL Boolean Expression.
translateBoolExp ::
  forall pgKind.
  (Backend ('Postgres pgKind)) =>
  AnnBoolExpSQL ('Postgres pgKind) ->
  BoolExpM S.BoolExp
translateBoolExp :: AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp = \case
  BoolAnd [AnnBoolExpSQL ('Postgres pgKind)]
bes -> do
    [BoolExp]
sqlBExps <- (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp)
-> [AnnBoolExp ('Postgres pgKind) SQLExp] -> BoolExpM [BoolExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp [AnnBoolExpSQL ('Postgres pgKind)]
[AnnBoolExp ('Postgres pgKind) SQLExp]
bes
    BoolExp -> BoolExpM BoolExp
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp) (Bool -> BoolExp
S.BELit Bool
True) [BoolExp]
sqlBExps
  BoolOr [AnnBoolExpSQL ('Postgres pgKind)]
bes -> do
    [BoolExp]
sqlBExps <- (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp)
-> [AnnBoolExp ('Postgres pgKind) SQLExp] -> BoolExpM [BoolExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp [AnnBoolExpSQL ('Postgres pgKind)]
[AnnBoolExp ('Postgres pgKind) SQLExp]
bes
    BoolExp -> BoolExpM BoolExp
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.OrOp) (Bool -> BoolExp
S.BELit Bool
False) [BoolExp]
sqlBExps
  BoolNot AnnBoolExpSQL ('Postgres pgKind)
notExp -> BoolExp -> BoolExp
S.BENot (BoolExp -> BoolExp) -> BoolExpM BoolExp -> BoolExpM BoolExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
notExp
  BoolExists (GExists TableName ('Postgres pgKind)
currTableReference AnnBoolExpSQL ('Postgres pgKind)
wh) -> do
    BoolExp
whereExp <- Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
recCurrentTable (QualifiedTable -> Qual
S.QualTable TableName ('Postgres pgKind)
QualifiedTable
currTableReference) AnnBoolExpSQL ('Postgres pgKind)
wh
    BoolExp -> BoolExpM BoolExp
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ FromItem -> BoolExp -> BoolExp
S.mkExists (QualifiedTable -> Maybe TableAlias -> FromItem
S.FISimple TableName ('Postgres pgKind)
QualifiedTable
currTableReference Maybe TableAlias
forall a. Maybe a
Nothing) BoolExp
whereExp
  BoolField AnnBoolExpFld ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
boolExp -> case AnnBoolExpFld ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
boolExp of
    AVColumn ColumnInfo ('Postgres pgKind)
colInfo [OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))]
opExps -> do
      BoolExpCtx {Qual
rootReference :: Qual
rootReference :: BoolExpCtx -> Qual
rootReference, Qual
currTableReference :: Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
      let colFld :: FieldName
colFld = Backend ('Postgres pgKind) =>
Column ('Postgres pgKind) -> FieldName
forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @('Postgres pgKind) (Column ('Postgres pgKind) -> FieldName)
-> Column ('Postgres pgKind) -> FieldName
forall a b. (a -> b) -> a -> b
$ ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
colInfo
          bExps :: [BoolExp]
bExps = (OpExpG ('Postgres pgKind) SQLExp -> BoolExp)
-> [OpExpG ('Postgres pgKind) SQLExp] -> [BoolExp]
forall a b. (a -> b) -> [a] -> [b]
map (Qual
-> Qual
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
forall (pgKind :: PostgresKind).
Qual
-> Qual
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
mkFieldCompExp Qual
rootReference Qual
currTableReference (LHSField ('Postgres pgKind)
 -> OpExpG ('Postgres pgKind) SQLExp -> BoolExp)
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
forall a b. (a -> b) -> a -> b
$ FieldName -> LHSField ('Postgres pgKind)
forall (b :: BackendType). FieldName -> LHSField b
LColumn FieldName
colFld) [OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))]
[OpExpG ('Postgres pgKind) SQLExp]
opExps
      BoolExp -> BoolExpM BoolExp
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp) (Bool -> BoolExp
S.BELit Bool
True) [BoolExp]
bExps
    AVRelationship (RelInfo RelName
_ RelType
_ HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
colMapping TableName ('Postgres pgKind)
relTN Bool
_ InsertOrder
_) AnnBoolExpSQL ('Postgres pgKind)
nesAnn -> do
      -- Convert the where clause on the relationship
      Identifier
aliasRelTN <- QualifiedTable -> BoolExpM Identifier
forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
freshIdentifier TableName ('Postgres pgKind)
QualifiedTable
relTN
      BoolExp
annRelBoolExp <- Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
recCurrentTable (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier Identifier
aliasRelTN Maybe TypeAnn
forall a. Maybe a
Nothing) AnnBoolExpSQL ('Postgres pgKind)
nesAnn
      BoolExpCtx {Qual
currTableReference :: Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
      let backCompExp :: BoolExp
backCompExp = (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp) (Bool -> BoolExp
S.BELit Bool
True) ([BoolExp] -> BoolExp) -> [BoolExp] -> BoolExp
forall a b. (a -> b) -> a -> b
$
            (((PGCol, PGCol) -> BoolExp) -> [(PGCol, PGCol)] -> [BoolExp])
-> [(PGCol, PGCol)] -> ((PGCol, PGCol) -> BoolExp) -> [BoolExp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PGCol, PGCol) -> BoolExp) -> [(PGCol, PGCol)] -> [BoolExp]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap PGCol PGCol -> [(PGCol, PGCol)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
colMapping) (((PGCol, PGCol) -> BoolExp) -> [BoolExp])
-> ((PGCol, PGCol) -> BoolExp) -> [BoolExp]
forall a b. (a -> b) -> a -> b
$ \(PGCol
lCol, PGCol
rCol) ->
              CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare
                CompareOp
S.SEQ
                (Qual -> PGCol -> SQLExp
forall a. IsIdentifier a => Qual -> a -> SQLExp
mkQCol (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier Identifier
aliasRelTN Maybe TypeAnn
forall a. Maybe a
Nothing) PGCol
rCol)
                (Qual -> PGCol -> SQLExp
forall a. IsIdentifier a => Qual -> a -> SQLExp
mkQCol Qual
currTableReference PGCol
lCol)
          innerBoolExp :: BoolExp
innerBoolExp = BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp BoolExp
backCompExp BoolExp
annRelBoolExp
      BoolExp -> BoolExpM BoolExp
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ FromItem -> BoolExp -> BoolExp
S.mkExists (QualifiedTable -> Maybe TableAlias -> FromItem
S.FISimple TableName ('Postgres pgKind)
QualifiedTable
relTN (Maybe TableAlias -> FromItem) -> Maybe TableAlias -> FromItem
forall a b. (a -> b) -> a -> b
$ TableAlias -> Maybe TableAlias
forall a. a -> Maybe a
Just (TableAlias -> Maybe TableAlias) -> TableAlias -> Maybe TableAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias Identifier
aliasRelTN) BoolExp
innerBoolExp
    AVComputedField (AnnComputedFieldBoolExp XComputedField ('Postgres pgKind)
_ ComputedFieldName
_ FunctionName ('Postgres pgKind)
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
sessionArgPresence ComputedFieldBoolExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
cfBoolExp) -> do
      case ComputedFieldBoolExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
cfBoolExp of
        CFBEScalar [OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))]
opExps -> do
          BoolExpCtx {Qual
rootReference :: Qual
rootReference :: BoolExpCtx -> Qual
rootReference, Qual
currTableReference :: Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
          -- Convert the where clause on scalar computed field
          let bExps :: [BoolExp]
bExps = (OpExpG ('Postgres pgKind) SQLExp -> BoolExp)
-> [OpExpG ('Postgres pgKind) SQLExp] -> [BoolExp]
forall a b. (a -> b) -> [a] -> [b]
map (Qual
-> Qual
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
forall (pgKind :: PostgresKind).
Qual
-> Qual
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
mkFieldCompExp Qual
rootReference Qual
currTableReference (LHSField ('Postgres pgKind)
 -> OpExpG ('Postgres pgKind) SQLExp -> BoolExp)
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
forall a b. (a -> b) -> a -> b
$ QualifiedFunction
-> FunctionArgsExp
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> LHSField ('Postgres pgKind)
forall (b :: BackendType).
QualifiedFunction
-> FunctionArgsExp b (SQLExpression b) -> LHSField b
LComputedField FunctionName ('Postgres pgKind)
QualifiedFunction
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
sessionArgPresence) [OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))]
[OpExpG ('Postgres pgKind) SQLExp]
opExps
          BoolExp -> BoolExpM BoolExp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp) (Bool -> BoolExp
S.BELit Bool
True) [BoolExp]
bExps
        CFBETable TableName ('Postgres pgKind)
_ AnnBoolExpSQL ('Postgres pgKind)
be -> do
          -- Convert the where clause on table computed field
          BoolExpCtx {Qual
currTableReference :: Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
          Identifier
aliasFunction <- QualifiedFunction -> BoolExpM Identifier
forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
freshIdentifier FunctionName ('Postgres pgKind)
QualifiedFunction
function
          let functionExp :: FunctionExp
functionExp =
                Qual
-> QualifiedFunction
-> FunctionArgsExp ('Postgres Any) (SQLExpression ('Postgres Any))
-> Maybe TableAlias
-> FunctionExp
forall (pgKind :: PostgresKind).
Qual
-> QualifiedFunction
-> FunctionArgsExp
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> Maybe TableAlias
-> FunctionExp
mkComputedFieldFunctionExp Qual
currTableReference FunctionName ('Postgres pgKind)
QualifiedFunction
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
FunctionArgsExp ('Postgres Any) (SQLExpression ('Postgres Any))
sessionArgPresence (Maybe TableAlias -> FunctionExp)
-> Maybe TableAlias -> FunctionExp
forall a b. (a -> b) -> a -> b
$
                  TableAlias -> Maybe TableAlias
forall a. a -> Maybe a
Just (TableAlias -> Maybe TableAlias) -> TableAlias -> Maybe TableAlias
forall a b. (a -> b) -> a -> b
$ Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias Identifier
aliasFunction
          FromItem -> BoolExp -> BoolExp
S.mkExists (FunctionExp -> FromItem
S.FIFunc FunctionExp
functionExp) (BoolExp -> BoolExp) -> BoolExpM BoolExp -> BoolExpM BoolExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
recCurrentTable (Identifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier Identifier
aliasFunction Maybe TypeAnn
forall a. Maybe a
Nothing) AnnBoolExpSQL ('Postgres pgKind)
be
    AVAggregationPredicates AggregationPredicates
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
_aggPreds -> [Char] -> BoolExpM BoolExp
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet: Pending https://github.com/hasura/graphql-engine-mono/issues/5174"
  where
    mkQCol :: forall a. IsIdentifier a => S.Qual -> a -> S.SQLExp
    mkQCol :: Qual -> a -> SQLExp
mkQCol Qual
q = QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp) -> (a -> QIdentifier) -> a -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qual -> Identifier -> QIdentifier
S.QIdentifier Qual
q (Identifier -> QIdentifier)
-> (a -> Identifier) -> a -> QIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier

    -- Draw a fresh identifier intended to alias the given object.
    freshIdentifier :: forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
    freshIdentifier :: QualifiedObject a -> BoolExpM Identifier
freshIdentifier QualifiedObject a
obj = do
      Word64
curVarNum <- BoolExpM Word64
forall s (m :: * -> *). MonadState s m => m s
get
      Word64 -> BoolExpM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Word64 -> BoolExpM ()) -> Word64 -> BoolExpM ()
forall a b. (a -> b) -> a -> b
$ Word64
curVarNum Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
      let newIdentifier :: Identifier
newIdentifier =
            Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$
              Text
"_be_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
curVarNum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
snakeCaseQualifiedObject QualifiedObject a
obj

      Identifier -> BoolExpM Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier
newIdentifier

    -- Call recursively using the given identifier for the 'current' table.
    recCurrentTable :: S.Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM S.BoolExp
    recCurrentTable :: Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
recCurrentTable Qual
curr = (BoolExpCtx -> BoolExpCtx) -> BoolExpM BoolExp -> BoolExpM BoolExp
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx
e -> BoolExpCtx
e {currTableReference :: Qual
currTableReference = Qual
curr}) (BoolExpM BoolExp -> BoolExpM BoolExp)
-> (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp)
-> AnnBoolExp ('Postgres pgKind) SQLExp
-> BoolExpM BoolExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp

data LHSField b
  = LColumn FieldName
  | LComputedField QualifiedFunction (FunctionArgsExp b (SQLExpression b))

mkComputedFieldFunctionExp ::
  S.Qual ->
  QualifiedFunction ->
  FunctionArgsExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind)) ->
  Maybe S.TableAlias ->
  S.FunctionExp
mkComputedFieldFunctionExp :: Qual
-> QualifiedFunction
-> FunctionArgsExp
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> Maybe TableAlias
-> FunctionExp
mkComputedFieldFunctionExp Qual
qual QualifiedFunction
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
functionArgs Maybe TableAlias
alias =
  -- "function_schema"."function_name"("qual".*)
  let tableRowInput :: SQLExp
tableRowInput = Maybe Qual -> SQLExp
S.SEStar (Maybe Qual -> SQLExp) -> Maybe Qual -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual -> Maybe Qual
forall a. a -> Maybe a
Just Qual
qual
      resolvedFunctionArgs :: FunctionArgs
resolvedFunctionArgs =
        let FunctionArgsExp {[SQLExp]
HashMap Text SQLExp
_faeNamed :: forall a. FunctionArgsExpG a -> HashMap Text a
_faePositional :: forall a. FunctionArgsExpG a -> [a]
_faeNamed :: HashMap Text SQLExp
_faePositional :: [SQLExp]
..} = (ArgumentExp SQLExp -> SQLExp)
-> FunctionArgsExpG (ArgumentExp SQLExp) -> FunctionArgsExpG SQLExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SQLExp -> (Text -> SQLExp) -> ArgumentExp SQLExp -> SQLExp
forall a. a -> (Text -> a) -> ArgumentExp a -> a
onArgumentExp SQLExp
tableRowInput (Identifier -> SQLExp
S.SEIdentifier (Identifier -> SQLExp) -> (Text -> Identifier) -> Text -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Identifier)) FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
FunctionArgsExpG (ArgumentExp SQLExp)
functionArgs
         in [SQLExp] -> HashMap Text SQLExp -> FunctionArgs
S.FunctionArgs [SQLExp]
_faePositional HashMap Text SQLExp
_faeNamed
   in QualifiedFunction
-> FunctionArgs -> Maybe FunctionAlias -> FunctionExp
S.FunctionExp QualifiedFunction
function FunctionArgs
resolvedFunctionArgs (Maybe FunctionAlias -> FunctionExp)
-> Maybe FunctionAlias -> FunctionExp
forall a b. (a -> b) -> a -> b
$ (TableAlias -> Maybe [FunctionDefinitionListItem] -> FunctionAlias)
-> Maybe [FunctionDefinitionListItem]
-> TableAlias
-> FunctionAlias
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableAlias -> Maybe [FunctionDefinitionListItem] -> FunctionAlias
S.FunctionAlias Maybe [FunctionDefinitionListItem]
forall a. Maybe a
Nothing (TableAlias -> FunctionAlias)
-> Maybe TableAlias -> Maybe FunctionAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TableAlias
alias

mkFieldCompExp ::
  S.Qual -> S.Qual -> LHSField ('Postgres pgKind) -> OpExpG ('Postgres pgKind) S.SQLExp -> S.BoolExp
mkFieldCompExp :: Qual
-> Qual
-> LHSField ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) SQLExp
-> BoolExp
mkFieldCompExp Qual
rootReference Qual
currTableReference LHSField ('Postgres pgKind)
lhsField = SQLExpression ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
SQLExpression ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
mkCompExp SQLExpression ('Postgres pgKind)
SQLExp
qLhsField
  where
    qLhsField :: SQLExp
qLhsField = case LHSField ('Postgres pgKind)
lhsField of
      LColumn FieldName
fieldName ->
        -- "qual"."column" =
        QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp) -> QIdentifier -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual -> Identifier -> QIdentifier
S.QIdentifier Qual
currTableReference (Identifier -> QIdentifier) -> Identifier -> QIdentifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt FieldName
fieldName
      LComputedField QualifiedFunction
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
sessionArgPresence ->
        -- "function_schema"."function_name"("qual".*) =
        FunctionExp -> SQLExp
S.SEFunction (FunctionExp -> SQLExp) -> FunctionExp -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual
-> QualifiedFunction
-> FunctionArgsExp ('Postgres Any) (SQLExpression ('Postgres Any))
-> Maybe TableAlias
-> FunctionExp
forall (pgKind :: PostgresKind).
Qual
-> QualifiedFunction
-> FunctionArgsExp
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> Maybe TableAlias
-> FunctionExp
mkComputedFieldFunctionExp Qual
currTableReference QualifiedFunction
function FunctionArgsExp
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
FunctionArgsExp ('Postgres Any) (SQLExpression ('Postgres Any))
sessionArgPresence Maybe TableAlias
forall a. Maybe a
Nothing

    mkQCol :: RootOrCurrentColumn ('Postgres pgKind) -> S.SQLExp
    mkQCol :: RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol (RootOrCurrentColumn RootOrCurrent
IsRoot Column ('Postgres pgKind)
col) = QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp) -> QIdentifier -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual -> Identifier -> QIdentifier
S.QIdentifier Qual
rootReference (Identifier -> QIdentifier) -> Identifier -> QIdentifier
forall a b. (a -> b) -> a -> b
$ PGCol -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier Column ('Postgres pgKind)
PGCol
col
    mkQCol (RootOrCurrentColumn RootOrCurrent
IsCurrent Column ('Postgres pgKind)
col) = QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp) -> QIdentifier -> SQLExp
forall a b. (a -> b) -> a -> b
$ Qual -> Identifier -> QIdentifier
S.QIdentifier Qual
currTableReference (Identifier -> QIdentifier) -> Identifier -> QIdentifier
forall a b. (a -> b) -> a -> b
$ PGCol -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier Column ('Postgres pgKind)
PGCol
col

    mkCompExp :: SQLExpression ('Postgres pgKind) -> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind)) -> S.BoolExp
    mkCompExp :: SQLExpression ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
mkCompExp SQLExpression ('Postgres pgKind)
lhs = \case
      ACast CastExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
casts -> HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp] -> BoolExp
mkCastsExp CastExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp]
casts
      AEQ Bool
False SQLExpression ('Postgres pgKind)
val -> SQLExpression ('Postgres Any)
-> SQLExpression ('Postgres Any) -> BoolExp
forall (pgKind :: PostgresKind).
SQLExpression ('Postgres pgKind)
-> SQLExpression ('Postgres pgKind) -> BoolExp
equalsBoolExpBuilder SQLExpression ('Postgres pgKind)
SQLExpression ('Postgres Any)
lhs SQLExpression ('Postgres pgKind)
SQLExpression ('Postgres Any)
val
      AEQ Bool
True SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ANE Bool
False SQLExpression ('Postgres pgKind)
val -> SQLExpression ('Postgres Any)
-> SQLExpression ('Postgres Any) -> BoolExp
forall (pgKind :: PostgresKind).
SQLExpression ('Postgres pgKind)
-> SQLExpression ('Postgres pgKind) -> BoolExp
notEqualsBoolExpBuilder SQLExpression ('Postgres pgKind)
SQLExpression ('Postgres Any)
lhs SQLExpression ('Postgres pgKind)
SQLExpression ('Postgres Any)
val
      ANE Bool
True SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      AIN SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompareAny CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ANIN SQLExpression ('Postgres pgKind)
val -> BoolExp -> BoolExp
S.BENot (BoolExp -> BoolExp) -> BoolExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompareAny CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      AGT SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SGT SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ALT SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SLT SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      AGTE SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SGTE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ALTE SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SLTE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ALIKE SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SLIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ANLIKE SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNLIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      CEQ RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      CNE RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNE SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      CGT RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SGT SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      CLT RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SLT SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      CGTE RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SGTE SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      CLTE RootOrCurrentColumn ('Postgres pgKind)
rhsCol -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SLTE SQLExpression ('Postgres pgKind)
SQLExp
lhs (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol RootOrCurrentColumn ('Postgres pgKind)
rhsCol
      OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
ANISNULL -> SQLExp -> BoolExp
S.BENull SQLExpression ('Postgres pgKind)
SQLExp
lhs
      OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
ANISNOTNULL -> SQLExp -> BoolExp
S.BENotNull SQLExpression ('Postgres pgKind)
SQLExp
lhs
      ABackendSpecific BooleanOperators
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
op -> case BooleanOperators
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
op of
        AILIKE val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SILIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANILIKE val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNILIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ASIMILAR val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SSIMILAR SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANSIMILAR val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNSIMILAR SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AREGEX val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AIREGEX val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SIREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANREGEX val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANIREGEX val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNIREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AContains val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AContainedIn val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKey val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKey SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKeysAny val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKeysAny SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKeysAll val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKeysAll SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AAncestor val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AAncestorAny val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ADescendant val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ADescendantAny val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatches val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatchesAny val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKey SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatchesFulltext val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SMatchesFulltext SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ASTContains val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Contains" SQLExp
val
        ASTCrosses val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Crosses" SQLExp
val
        ASTEquals val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Equals" SQLExp
val
        ASTIntersects val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Intersects" SQLExp
val
        AST3DIntersects val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_3DIntersects" SQLExp
val
        ASTOverlaps val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Overlaps" SQLExp
val
        ASTTouches val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Touches" SQLExp
val
        ASTWithin val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Within" SQLExp
val
        AST3DDWithinGeom (DWithinGeomOp r val) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_3DDWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r]
        ASTDWithinGeom (DWithinGeomOp r val) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_DWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r]
        ASTDWithinGeog (DWithinGeogOp r val sph) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_DWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r, SQLExp
sph]
        ASTIntersectsRast val -> [SQLExp] -> BoolExp
applySTIntersects [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val]
        ASTIntersectsNbandGeom (STIntersectsNbandGeommin nband geommin) -> [SQLExp] -> BoolExp
applySTIntersects [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
nband, SQLExp
geommin]
        ASTIntersectsGeomNband (STIntersectsGeomminNband geommin mNband) -> [SQLExp] -> BoolExp
applySTIntersects [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
geommin, Maybe SQLExp -> SQLExp
withSQLNull Maybe SQLExp
mNband]
      where
        mkGeomOpBe :: Text -> SQLExp -> BoolExp
mkGeomOpBe Text
fn SQLExp
v = Text -> [SQLExp] -> BoolExp
applySQLFn Text
fn [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
v]

        applySQLFn :: Text -> [SQLExp] -> BoolExp
applySQLFn Text
f [SQLExp]
exps = SQLExp -> BoolExp
S.BEExp (SQLExp -> BoolExp) -> SQLExp -> BoolExp
forall a b. (a -> b) -> a -> b
$ Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
f [SQLExp]
exps Maybe OrderByExp
forall a. Maybe a
Nothing

        applySTIntersects :: [SQLExp] -> BoolExp
applySTIntersects = Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_Intersects"

        withSQLNull :: Maybe SQLExp -> SQLExp
withSQLNull = SQLExp -> Maybe SQLExp -> SQLExp
forall a. a -> Maybe a -> a
fromMaybe SQLExp
S.SENull

        mkCastsExp :: HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp] -> BoolExp
mkCastsExp HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp]
casts =
          [BoolExp] -> BoolExp
sqlAll ([BoolExp] -> BoolExp)
-> (((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
    -> [BoolExp])
-> ((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
-> BoolExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
 -> [(PGScalarType, [OpExpG ('Postgres pgKind) SQLExp])]
 -> [BoolExp])
-> [(PGScalarType, [OpExpG ('Postgres pgKind) SQLExp])]
-> ((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
-> [BoolExp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
-> [(PGScalarType, [OpExpG ('Postgres pgKind) SQLExp])]
-> [BoolExp]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp]
-> [(PGScalarType, [OpExpG ('Postgres pgKind) SQLExp])]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap PGScalarType [OpExpG ('Postgres pgKind) SQLExp]
casts) (((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
 -> BoolExp)
-> ((PGScalarType, [OpExpG ('Postgres pgKind) SQLExp]) -> BoolExp)
-> BoolExp
forall a b. (a -> b) -> a -> b
$ \(PGScalarType
targetType, [OpExpG ('Postgres pgKind) SQLExp]
operations) ->
            let targetAnn :: TypeAnn
targetAnn = CollectableType PGScalarType -> TypeAnn
S.mkTypeAnn (CollectableType PGScalarType -> TypeAnn)
-> CollectableType PGScalarType -> TypeAnn
forall a b. (a -> b) -> a -> b
$ PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeScalar PGScalarType
targetType
             in [BoolExp] -> BoolExp
sqlAll ([BoolExp] -> BoolExp) -> [BoolExp] -> BoolExp
forall a b. (a -> b) -> a -> b
$ (OpExpG ('Postgres pgKind) SQLExp -> BoolExp)
-> [OpExpG ('Postgres pgKind) SQLExp] -> [BoolExp]
forall a b. (a -> b) -> [a] -> [b]
map (SQLExpression ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
forall (pgKind :: PostgresKind).
SQLExpression ('Postgres pgKind)
-> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExp
mkCompExp (SQLExp -> TypeAnn -> SQLExp
S.SETyAnn SQLExpression ('Postgres pgKind)
SQLExp
lhs TypeAnn
targetAnn)) [OpExpG ('Postgres pgKind) SQLExp]
operations

        sqlAll :: [BoolExp] -> BoolExp
sqlAll = (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp) (Bool -> BoolExp
S.BELit Bool
True)