{-# LANGUAGE PartialTypeSignatures #-}

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

import Data.HashMap.Strict qualified as HashMap
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.Function.Cache
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.BoolExp.AggregationPredicates (AggregationPredicate (..), AggregationPredicateArguments (..), AggregationPredicatesImplementation (..))
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Relationships.Local
import Hasura.SQL.Types
import Hasura.Table.Cache ()

-- This convoluted expression instead of col = val
-- to handle the case of col : null
equalsBoolExpBuilder :: SQLExpression ('Postgres pgKind) -> SQLExpression ('Postgres pgKind) -> S.BoolExp
equalsBoolExpBuilder :: forall (pgKind :: PostgresKind).
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 :: forall (pgKind :: PostgresKind).
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)
    )

-- | 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 :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
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 (StateT Word64 Identity) BoolExp
-> BoolExpCtx -> State Word64 BoolExp
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
        (BoolExpM BoolExp
-> ReaderT BoolExpCtx (StateT Word64 Identity) BoolExp
forall a.
BoolExpM a -> ReaderT BoolExpCtx (StateT Word64 Identity) 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
        { 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 {forall a.
BoolExpM a -> ReaderT BoolExpCtx (StateT Word64 Identity) a
unBoolExpM :: ReaderT BoolExpCtx (State Word64) a}
  deriving ((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
$cfmap :: forall a b. (a -> b) -> BoolExpM a -> BoolExpM b
fmap :: forall a b. (a -> b) -> BoolExpM a -> BoolExpM b
$c<$ :: forall a b. a -> BoolExpM b -> BoolExpM a
<$ :: forall a b. a -> BoolExpM b -> BoolExpM a
Functor, Functor BoolExpM
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
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
$cpure :: forall a. a -> BoolExpM a
pure :: forall a. a -> BoolExpM a
$c<*> :: forall a b. BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
<*> :: forall a b. BoolExpM (a -> b) -> BoolExpM a -> BoolExpM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
liftA2 :: forall a b c.
(a -> b -> c) -> BoolExpM a -> BoolExpM b -> BoolExpM c
$c*> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
*> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
$c<* :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM a
<* :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM a
Applicative, Applicative BoolExpM
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
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
$c>>= :: forall a b. BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
>>= :: forall a b. BoolExpM a -> (a -> BoolExpM b) -> BoolExpM b
$c>> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
>> :: forall a b. BoolExpM a -> BoolExpM b -> BoolExpM b
$creturn :: forall a. a -> BoolExpM a
return :: forall a. a -> BoolExpM a
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 :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
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 a. a -> BoolExpM a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp] -> BoolExp
sqlAnd [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
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 a. a -> BoolExpM a
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 a b. (a -> b -> b) -> b -> [a] -> b
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
    Word64
fresh <- (Word64 -> (Word64, Word64)) -> BoolExpM Word64
forall a. (Word64 -> (a, Word64)) -> BoolExpM a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state \Word64
identifier -> (Word64
identifier, Word64
identifier Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

    let alias :: S.TableAlias
        alias :: TableAlias
alias = Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Text -> Identifier
Identifier (Text
"_exists_table_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow Word64
fresh))

        identifier :: TableIdentifier
        identifier :: TableIdentifier
identifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
alias

    BoolExp
whereExp <- Qual -> BoolExpM BoolExp -> BoolExpM BoolExp
forall a. Qual -> BoolExpM a -> BoolExpM a
withCurrentTable (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
identifier Maybe TypeAnn
forall a. Maybe a
Nothing) (AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
wh)
    BoolExp -> BoolExpM BoolExp
forall a. a -> BoolExpM a
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 (TableAlias -> Maybe TableAlias
forall a. a -> Maybe a
Just TableAlias
alias)) 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 :: BoolExpCtx -> Qual
rootReference :: Qual
rootReference, Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference :: Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
      let colFld :: FieldName
colFld = 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 a. a -> BoolExpM a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp] -> BoolExp
sqlAnd [BoolExp]
bExps
    AVRelationship
      (RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetNativeQuery NativeQueryName
_})
      RelationshipFilters
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
_ -> [Char] -> BoolExpM BoolExp
forall a. HasCallStack => [Char] -> a
error [Char]
"translateBoolExp RelTargetNativeQuery"
    AVRelationship
      (RelInfo {riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping = HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
colMapping, riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetTable TableName ('Postgres pgKind)
relTN})
      RelationshipFilters
        { AnnBoolExpSQL ('Postgres pgKind)
rfTargetTablePermissions :: AnnBoolExpSQL ('Postgres pgKind)
rfTargetTablePermissions :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfTargetTablePermissions,
          AnnBoolExpSQL ('Postgres pgKind)
rfFilter :: AnnBoolExpSQL ('Postgres pgKind)
rfFilter :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfFilter
        } -> do
        -- Convert the where clause on the relationship
        TableAlias
relTNAlias <- Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias)
-> BoolExpM Identifier -> BoolExpM TableAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTable -> BoolExpM Identifier
forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
freshIdentifier TableName ('Postgres pgKind)
QualifiedTable
relTN
        let relTNIdentifier :: TableIdentifier
relTNIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
relTNAlias
            relTNQual :: Qual
relTNQual = TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
relTNIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing

        -- '$' references in permissions of the relationship target table refer to that table, so we
        -- reset both here.
        BoolExp
permBoolExp <-
          (BoolExpCtx -> BoolExpCtx) -> BoolExpM BoolExp -> BoolExpM BoolExp
forall a. (BoolExpCtx -> BoolExpCtx) -> BoolExpM a -> BoolExpM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
            ( \BoolExpCtx
e ->
                BoolExpCtx
e
                  { currTableReference :: Qual
currTableReference = Qual
relTNQual,
                    rootReference :: Qual
rootReference = Qual
relTNQual
                  }
            )
            (AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
rfTargetTablePermissions)
        BoolExp
annRelBoolExp <- Qual -> BoolExpM BoolExp -> BoolExpM BoolExp
forall a. Qual -> BoolExpM a -> BoolExpM a
withCurrentTable Qual
relTNQual (AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
rfFilter)
        BoolExp
tableRelExp <- HashMap PGCol PGCol -> TableIdentifier -> BoolExpM BoolExp
translateTableRelationship HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
colMapping TableIdentifier
relTNIdentifier
        let innerBoolExp :: BoolExp
innerBoolExp = BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp BoolExp
tableRelExp (BinOp -> BoolExp -> BoolExp -> BoolExp
S.BEBin BinOp
S.AndOp BoolExp
permBoolExp BoolExp
annRelBoolExp)
        BoolExp -> BoolExpM BoolExp
forall a. a -> BoolExpM a
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
$ TableAlias
relTNAlias) 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 :: BoolExpCtx -> Qual
rootReference :: Qual
rootReference, Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference :: 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 a. a -> BoolExpM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp] -> BoolExp
sqlAnd [BoolExp]
bExps
        CFBETable TableName ('Postgres pgKind)
_ AnnBoolExpSQL ('Postgres pgKind)
be -> do
          -- Convert the where clause on table computed field
          BoolExpCtx {Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference :: Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
          TableAlias
functionAlias <- Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias)
-> BoolExpM Identifier -> BoolExpM TableAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedFunction -> BoolExpM Identifier
forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
freshIdentifier FunctionName ('Postgres pgKind)
QualifiedFunction
function
          let functionIdentifier :: TableIdentifier
functionIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
functionAlias
              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
$ TableAlias
functionAlias
          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 -> BoolExpM BoolExp -> BoolExpM BoolExp
forall a. Qual -> BoolExpM a -> BoolExpM a
withCurrentTable (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
functionIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing) (AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
be)
    AVAggregationPredicates AggregationPredicates
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
aggPreds -> AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExpM BoolExp
translateAVAggregationPredicates AggregationPredicates
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
aggPreds

-- | Call a given translation action recursively using the given identifier for the 'current' table.
withCurrentTable :: forall a. S.Qual -> BoolExpM a -> BoolExpM a
withCurrentTable :: forall a. Qual -> BoolExpM a -> BoolExpM a
withCurrentTable Qual
curr = (BoolExpCtx -> BoolExpCtx) -> BoolExpM a -> BoolExpM a
forall a. (BoolExpCtx -> BoolExpCtx) -> BoolExpM a -> BoolExpM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx
e -> BoolExpCtx
e {currTableReference :: Qual
currTableReference = Qual
curr})

-- | Draw a fresh identifier intended to alias the given object.
freshIdentifier :: forall a. (ToTxt a) => QualifiedObject a -> BoolExpM Identifier
freshIdentifier :: forall a. ToTxt a => 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 a. a -> BoolExpM a
forall (m :: * -> *) a. Monad m => a -> m a
return Identifier
newIdentifier

identifierWithSuffix :: (ToTxt a) => QualifiedObject a -> Text -> Identifier
identifierWithSuffix :: forall a. ToTxt a => QualifiedObject a -> Text -> Identifier
identifierWithSuffix QualifiedObject a
relTableName Text
name =
  Text -> Identifier
Identifier (QualifiedObject a -> Text
forall a. ToTxt a => QualifiedObject a -> Text
snakeCaseQualifiedObject QualifiedObject a
relTableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)

-- | Given a GraphQL aggregation filter of the form:
-- > { where: {<table>_aggregate: {<aggregate_field>: {<bool_op>: <value>} } } }
--
-- Produces SQL of the form:
-- > EXISTS (
-- >   SELECT
-- >     1
-- >     FROM
-- >       (
-- >         SELECT
-- >           <aggregate_function> AS <aggregate_function_alias> -- Note: we can have multiple aggregate expressions here
-- >         FROM
-- >           <array_relationship_table> AS <array_relationship_table_alias>
-- >         WHERE
-- >           <relationship_table_key>
-- >             AND <row_permissions>
-- >             AND <filters>
-- >       ) AS "_sub"
-- >    WHERE
-- >      "_sub".<aggregate_function_alias> <bool_op> <value>
-- > )
translateAVAggregationPredicates ::
  forall pgKind.
  (Backend ('Postgres pgKind)) =>
  AggregationPredicatesImplementation ('Postgres pgKind) (SQLExpression ('Postgres pgKind)) ->
  BoolExpM S.BoolExp
translateAVAggregationPredicates :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
-> BoolExpM BoolExp
translateAVAggregationPredicates
  api :: AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
api@(AggregationPredicatesImplementation (RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetTable TableName ('Postgres pgKind)
relTableName, riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping = HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
colMapping}) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
_rowPermissions AggregationPredicate
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
predicate) = do
    -- e.g. __be_0_<schema>_<table_name>
    TableAlias
relTableNameAlias <- Identifier -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias (Identifier -> TableAlias)
-> BoolExpM Identifier -> BoolExpM TableAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTable -> BoolExpM Identifier
forall a. ToTxt a => QualifiedObject a -> BoolExpM Identifier
freshIdentifier TableName ('Postgres pgKind)
QualifiedTable
relTableName
    let relTableNameIdentifier :: TableIdentifier
relTableNameIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
relTableNameAlias
    BoolExp
tableRelExp <- HashMap PGCol PGCol -> TableIdentifier -> BoolExpM BoolExp
translateTableRelationship HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
colMapping TableIdentifier
relTableNameIdentifier
    let subselectAlias :: TableAlias
subselectAlias = Text -> TableAlias
S.mkTableAlias Text
"_sub"
        subselectIdentifier :: TableIdentifier
subselectIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
subselectAlias
        relTable :: Qual
relTable = TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
relTableNameIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing
    FromItem
subselect <-
      (BoolExpCtx -> BoolExpCtx)
-> BoolExpM FromItem -> BoolExpM FromItem
forall a. (BoolExpCtx -> BoolExpCtx) -> BoolExpM a -> BoolExpM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
        (\BoolExpCtx
e -> BoolExpCtx
e {currTableReference :: Qual
currTableReference = Qual
relTable, rootReference :: Qual
rootReference = Qual
relTable})
        (BoolExpM FromItem -> BoolExpM FromItem)
-> BoolExpM FromItem -> BoolExpM FromItem
forall a b. (a -> b) -> a -> b
$ TableAlias
-> TableAlias
-> BoolExp
-> AggregationPredicatesImplementation ('Postgres pgKind) SQLExp
-> BoolExpM FromItem
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
TableAlias
-> TableAlias
-> BoolExp
-> AggregationPredicatesImplementation ('Postgres pgKind) SQLExp
-> BoolExpM FromItem
translateAggPredsSubselect TableAlias
subselectAlias TableAlias
relTableNameAlias BoolExp
tableRelExp AggregationPredicatesImplementation
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AggregationPredicatesImplementation ('Postgres pgKind) SQLExp
api
    BoolExp
outerWhereFrag <- TableName ('Postgres pgKind)
-> TableIdentifier
-> AggregationPredicate ('Postgres pgKind) SQLExp
-> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
TableName ('Postgres pgKind)
-> TableIdentifier
-> AggregationPredicate ('Postgres pgKind) SQLExp
-> BoolExpM BoolExp
translateAggPredBoolExp TableName ('Postgres pgKind)
relTableName TableIdentifier
subselectIdentifier AggregationPredicate
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
AggregationPredicate ('Postgres pgKind) SQLExp
predicate
    BoolExp -> BoolExpM BoolExp
forall a. a -> BoolExpM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ FromItem -> BoolExp -> BoolExp
S.mkExists FromItem
subselect BoolExp
outerWhereFrag
translateAVAggregationPredicates (AggregationPredicatesImplementation (RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetNativeQuery NativeQueryName
_}) AnnBoolExp ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
_rowPermissions AggregationPredicate
  ('Postgres pgKind) (SQLExpression ('Postgres pgKind))
_predicate) =
  [Char] -> BoolExpM BoolExp
forall a. HasCallStack => [Char] -> a
error [Char]
"translateAVAggregationPredicates RelTargetNativeQuery"

translateAggPredBoolExp ::
  forall pgKind.
  TableName ('Postgres pgKind) ->
  TableIdentifier ->
  AggregationPredicate ('Postgres pgKind) S.SQLExp ->
  BoolExpM S.BoolExp
translateAggPredBoolExp :: forall (pgKind :: PostgresKind).
TableName ('Postgres pgKind)
-> TableIdentifier
-> AggregationPredicate ('Postgres pgKind) SQLExp
-> BoolExpM BoolExp
translateAggPredBoolExp
  TableName ('Postgres pgKind)
relTableName
  TableIdentifier
subselectIdentifier
  (AggregationPredicate {Text
aggPredFunctionName :: Text
aggPredFunctionName :: forall (b :: BackendType) field.
AggregationPredicate b field -> Text
aggPredFunctionName, [OpExpG ('Postgres pgKind) SQLExp]
aggPredPredicate :: [OpExpG ('Postgres pgKind) SQLExp]
aggPredPredicate :: forall (b :: BackendType) field.
AggregationPredicate b field -> [OpExpG b field]
aggPredPredicate}) = do
    BoolExpCtx {Qual
rootReference :: BoolExpCtx -> Qual
rootReference :: Qual
rootReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
    let (Identifier Text
aggAlias) = QualifiedTable -> Text -> Identifier
forall a. ToTxt a => QualifiedObject a -> Text -> Identifier
identifierWithSuffix TableName ('Postgres pgKind)
QualifiedTable
relTableName Text
aggPredFunctionName
        boolExps :: [BoolExp]
boolExps =
          (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 (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
subselectIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing) (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 (Text -> FieldName
FieldName Text
aggAlias))
            [OpExpG ('Postgres pgKind) SQLExp]
aggPredPredicate
    BoolExp -> BoolExpM BoolExp
forall a. a -> BoolExpM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp] -> BoolExp
sqlAnd [BoolExp]
boolExps

translateAggPredsSubselect ::
  forall pgKind.
  (Backend ('Postgres pgKind)) =>
  S.TableAlias ->
  S.TableAlias ->
  S.BoolExp ->
  AggregationPredicatesImplementation ('Postgres pgKind) S.SQLExp ->
  BoolExpM S.FromItem
translateAggPredsSubselect :: forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
TableAlias
-> TableAlias
-> BoolExp
-> AggregationPredicatesImplementation ('Postgres pgKind) SQLExp
-> BoolExpM FromItem
translateAggPredsSubselect
  TableAlias
_subselectAlias
  TableAlias
_relTableNameAlias
  BoolExp
_tableRelExp
  ( AggregationPredicatesImplementation
      RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetNativeQuery NativeQueryName
_}
      AnnBoolExp ('Postgres pgKind) SQLExp
_rowPermissions
      AggregationPredicate ('Postgres pgKind) SQLExp
_predicate
    ) = [Char] -> BoolExpM FromItem
forall a. HasCallStack => [Char] -> a
error [Char]
"translateAggPredsSubselect RelTargetNativeQuery"
translateAggPredsSubselect
  TableAlias
subselectAlias
  TableAlias
relTableNameAlias
  BoolExp
tableRelExp
  ( AggregationPredicatesImplementation
      RelInfo {riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget = RelTargetTable TableName ('Postgres pgKind)
relTableName}
      AnnBoolExp ('Postgres pgKind) SQLExp
rowPermissions
      AggregationPredicate ('Postgres pgKind) SQLExp
predicate
    ) = do
    Maybe BoolExp
mFilter <- (AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp)
-> Maybe (AnnBoolExp ('Postgres pgKind) SQLExp)
-> BoolExpM (Maybe BoolExp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp (AggregationPredicate ('Postgres pgKind) SQLExp
-> Maybe (AnnBoolExp ('Postgres pgKind) SQLExp)
forall (b :: BackendType) field.
AggregationPredicate b field -> Maybe (AnnBoolExp b field)
aggPredFilter AggregationPredicate ('Postgres pgKind) SQLExp
predicate)
    BoolExp
rowPermExp <- AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
AnnBoolExpSQL ('Postgres pgKind) -> BoolExpM BoolExp
translateBoolExp AnnBoolExpSQL ('Postgres pgKind)
AnnBoolExp ('Postgres pgKind) SQLExp
rowPermissions
    let relTableNameIdentifier :: TableIdentifier
relTableNameIdentifier = TableAlias -> TableIdentifier
S.tableAliasToIdentifier TableAlias
relTableNameAlias
        -- SELECT <aggregate_function> AS <aggregate_function_alias>
        extractorsExp :: Extractor
extractorsExp = TableIdentifier
-> TableName ('Postgres pgKind)
-> AggregationPredicate ('Postgres pgKind) SQLExp
-> Extractor
forall (pgKind :: PostgresKind) field.
TableIdentifier
-> TableName ('Postgres pgKind)
-> AggregationPredicate ('Postgres pgKind) field
-> Extractor
translateAggPredExtractor TableIdentifier
relTableNameIdentifier TableName ('Postgres pgKind)
relTableName AggregationPredicate ('Postgres pgKind) SQLExp
predicate
        -- FROM <array_relationship_table> AS <array_relationship_table_alias>
        fromExp :: [FromItem]
fromExp = FromItem -> [FromItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FromItem -> [FromItem]) -> FromItem -> [FromItem]
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> Maybe TableAlias -> FromItem
S.FISimple TableName ('Postgres pgKind)
QualifiedTable
relTableName (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
$ TableAlias -> TableAlias
forall a. IsIdentifier a => a -> TableAlias
S.toTableAlias TableAlias
relTableNameAlias
        -- WHERE <relationship_table_key> AND <row_permissions> AND <mFilter>
        whereExp :: BoolExp
whereExp = [BoolExp] -> BoolExp
sqlAnd ([BoolExp] -> BoolExp) -> [BoolExp] -> BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp
tableRelExp, BoolExp
rowPermExp] [BoolExp] -> [BoolExp] -> [BoolExp]
forall a. [a] -> [a] -> [a]
++ Maybe BoolExp -> [BoolExp]
forall a. Maybe a -> [a]
maybeToList Maybe BoolExp
mFilter
    FromItem -> BoolExpM FromItem
forall a. a -> BoolExpM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (FromItem -> BoolExpM FromItem) -> FromItem -> BoolExpM FromItem
forall a b. (a -> b) -> a -> b
$ Select -> TableAlias -> FromItem
S.mkSelFromItem
        Select
S.mkSelect
          { selExtr :: [Extractor]
S.selExtr = [Extractor
extractorsExp],
            selFrom :: Maybe FromExp
S.selFrom = FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ [FromItem] -> FromExp
S.FromExp [FromItem]
fromExp,
            selWhere :: Maybe WhereFrag
S.selWhere = WhereFrag -> Maybe WhereFrag
forall a. a -> Maybe a
Just (WhereFrag -> Maybe WhereFrag) -> WhereFrag -> Maybe WhereFrag
forall a b. (a -> b) -> a -> b
$ BoolExp -> WhereFrag
S.WhereFrag BoolExp
whereExp
          }
        TableAlias
subselectAlias

translateAggPredExtractor ::
  forall pgKind field.
  TableIdentifier ->
  TableName ('Postgres pgKind) ->
  AggregationPredicate ('Postgres pgKind) field ->
  S.Extractor
translateAggPredExtractor :: forall (pgKind :: PostgresKind) field.
TableIdentifier
-> TableName ('Postgres pgKind)
-> AggregationPredicate ('Postgres pgKind) field
-> Extractor
translateAggPredExtractor TableIdentifier
relTableNameIdentifier TableName ('Postgres pgKind)
relTableName (AggregationPredicate {Text
aggPredFunctionName :: forall (b :: BackendType) field.
AggregationPredicate b field -> Text
aggPredFunctionName :: Text
aggPredFunctionName, AggregationPredicateArguments ('Postgres pgKind)
aggPredArguments :: AggregationPredicateArguments ('Postgres pgKind)
aggPredArguments :: forall (b :: BackendType) field.
AggregationPredicate b field -> AggregationPredicateArguments b
aggPredArguments}) =
  let predArgsExp :: [SQLExp]
predArgsExp = NonEmpty SQLExp -> [SQLExp]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty SQLExp -> [SQLExp]) -> NonEmpty SQLExp -> [SQLExp]
forall a b. (a -> b) -> a -> b
$ AggregationPredicateArguments ('Postgres pgKind)
-> TableIdentifier -> NonEmpty SQLExp
forall (pgKind :: PostgresKind).
AggregationPredicateArguments ('Postgres pgKind)
-> TableIdentifier -> NonEmpty SQLExp
translateAggPredArguments AggregationPredicateArguments ('Postgres pgKind)
aggPredArguments TableIdentifier
relTableNameIdentifier
      aggAlias :: ColumnAlias
aggAlias = Identifier -> ColumnAlias
forall a. IsIdentifier a => a -> ColumnAlias
S.toColumnAlias (Identifier -> ColumnAlias) -> Identifier -> ColumnAlias
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> Text -> Identifier
forall a. ToTxt a => QualifiedObject a -> Text -> Identifier
identifierWithSuffix TableName ('Postgres pgKind)
QualifiedTable
relTableName Text
aggPredFunctionName
   in SQLExp -> Maybe ColumnAlias -> Extractor
S.Extractor (Text -> [SQLExp] -> Maybe OrderByExp -> SQLExp
S.SEFnApp Text
aggPredFunctionName [SQLExp]
predArgsExp Maybe OrderByExp
forall a. Maybe a
Nothing) (ColumnAlias -> Maybe ColumnAlias
forall a. a -> Maybe a
Just ColumnAlias
aggAlias)

translateAggPredArguments ::
  forall pgKind.
  AggregationPredicateArguments ('Postgres pgKind) ->
  TableIdentifier ->
  NonEmpty S.SQLExp
translateAggPredArguments :: forall (pgKind :: PostgresKind).
AggregationPredicateArguments ('Postgres pgKind)
-> TableIdentifier -> NonEmpty SQLExp
translateAggPredArguments AggregationPredicateArguments ('Postgres pgKind)
predArgs TableIdentifier
relTableNameIdentifier =
  case AggregationPredicateArguments ('Postgres pgKind)
predArgs of
    AggregationPredicateArguments ('Postgres pgKind)
AggregationPredicateArgumentsStar -> SQLExp -> NonEmpty SQLExp
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExp -> NonEmpty SQLExp) -> SQLExp -> NonEmpty SQLExp
forall a b. (a -> b) -> a -> b
$ Maybe Qual -> SQLExp
S.SEStar Maybe Qual
forall a. Maybe a
Nothing
    (AggregationPredicateArguments NonEmpty (Column ('Postgres pgKind))
cols) ->
      QIdentifier -> SQLExp
S.SEQIdentifier (QIdentifier -> SQLExp)
-> (PGCol -> QIdentifier) -> PGCol -> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableIdentifier -> PGCol -> QIdentifier
forall b. IsIdentifier b => TableIdentifier -> b -> QIdentifier
S.mkQIdentifier TableIdentifier
relTableNameIdentifier (PGCol -> SQLExp) -> NonEmpty PGCol -> NonEmpty SQLExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Column ('Postgres pgKind))
NonEmpty PGCol
cols

translateTableRelationship :: HashMap PGCol PGCol -> TableIdentifier -> BoolExpM S.BoolExp
translateTableRelationship :: HashMap PGCol PGCol -> TableIdentifier -> BoolExpM BoolExp
translateTableRelationship HashMap PGCol PGCol
colMapping TableIdentifier
relTableNameIdentifier = do
  BoolExpCtx {Qual
currTableReference :: BoolExpCtx -> Qual
currTableReference :: Qual
currTableReference} <- BoolExpM BoolExpCtx
forall r (m :: * -> *). MonadReader r m => m r
ask
  BoolExp -> BoolExpM BoolExp
forall a. a -> BoolExpM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (BoolExp -> BoolExpM BoolExp) -> BoolExp -> BoolExpM BoolExp
forall a b. (a -> b) -> a -> b
$ [BoolExp] -> BoolExp
sqlAnd
    ([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)]
HashMap.toList 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
S.mkIdentifierSQLExp (TableIdentifier -> Maybe TypeAnn -> Qual
S.QualifiedIdentifier TableIdentifier
relTableNameIdentifier Maybe TypeAnn
forall a. Maybe a
Nothing) PGCol
rCol)
        (Qual -> PGCol -> SQLExp
forall a. IsIdentifier a => Qual -> a -> SQLExp
S.mkIdentifierSQLExp Qual
currTableReference PGCol
lCol)

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 :: forall (pgKind :: PostgresKind).
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
_faePositional :: [SQLExp]
_faeNamed :: HashMap Text SQLExp
_faePositional :: forall a. FunctionArgsExpG a -> [a]
_faeNamed :: forall a. FunctionArgsExpG a -> HashMap Text a
..} = (ArgumentExp SQLExp -> SQLExp)
-> FunctionArgsExpG (ArgumentExp SQLExp) -> FunctionArgsExpG SQLExp
forall a b. (a -> b) -> FunctionArgsExpG a -> FunctionArgsExpG b
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

sqlAnd :: [S.BoolExp] -> S.BoolExp
sqlAnd :: [BoolExp] -> BoolExp
sqlAnd = (BoolExp -> BoolExp -> BoolExp) -> BoolExp -> [BoolExp] -> BoolExp
forall a b. (a -> b -> b) -> b -> [a] -> b
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)

mkFieldCompExp ::
  S.Qual -> S.Qual -> LHSField ('Postgres pgKind) -> OpExpG ('Postgres pgKind) S.SQLExp -> S.BoolExp
mkFieldCompExp :: forall (pgKind :: PostgresKind).
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 :: forall (pgKind :: PostgresKind).
RootOrCurrentColumn ('Postgres pgKind) -> SQLExp
mkQCol (RootOrCurrentColumn RootOrCurrent
IsRoot Column ('Postgres pgKind)
col) = Qual -> PGCol -> SQLExp
forall a. IsIdentifier a => Qual -> a -> SQLExp
S.mkIdentifierSQLExp Qual
rootReference Column ('Postgres pgKind)
PGCol
col
    mkQCol (RootOrCurrentColumn RootOrCurrent
IsCurrent Column ('Postgres pgKind)
col) = Qual -> PGCol -> SQLExp
forall a. IsIdentifier a => Qual -> a -> SQLExp
S.mkIdentifierSQLExp Qual
currTableReference Column ('Postgres pgKind)
PGCol
col

    mkCompExp :: SQLExpression ('Postgres pgKind) -> OpExpG ('Postgres pgKind) (SQLExpression ('Postgres pgKind)) -> S.BoolExp
    mkCompExp :: forall (pgKind :: PostgresKind).
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 ComparisonNullability
NullableComparison 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 ComparisonNullability
NonNullableComparison SQLExpression ('Postgres pgKind)
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SEQ SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExpression ('Postgres pgKind)
SQLExp
val
      ANE ComparisonNullability
NullableComparison 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 ComparisonNullability
NonNullableComparison 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 SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SILIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANILIKE SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNILIKE SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ASIMILAR SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SSIMILAR SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANSIMILAR SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNSIMILAR SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AREGEX SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AIREGEX SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SIREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANREGEX SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ANIREGEX SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SNIREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AContains SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AContainedIn SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKey SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKey SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKeysAny SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKeysAny SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AHasKeysAll SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKeysAll SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AAncestor SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AAncestorAny SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContains SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ADescendant SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ADescendantAny SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SContainedIn SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatches SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SREGEX SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatchesAny SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SHasKey SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        AMatchesFulltext SQLExp
val -> CompareOp -> SQLExp -> SQLExp -> BoolExp
S.BECompare CompareOp
S.SMatchesFulltext SQLExpression ('Postgres pgKind)
SQLExp
lhs SQLExp
val
        ASTContains SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Contains" SQLExp
val
        ASTCrosses SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Crosses" SQLExp
val
        ASTEquals SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Equals" SQLExp
val
        ASTIntersects SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Intersects" SQLExp
val
        AST3DIntersects SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_3DIntersects" SQLExp
val
        ASTOverlaps SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Overlaps" SQLExp
val
        ASTTouches SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Touches" SQLExp
val
        ASTWithin SQLExp
val -> Text -> SQLExp -> BoolExp
mkGeomOpBe Text
"ST_Within" SQLExp
val
        AST3DDWithinGeom (DWithinGeomOp SQLExp
r SQLExp
val) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_3DDWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r]
        ASTDWithinGeom (DWithinGeomOp SQLExp
r SQLExp
val) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_DWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r]
        ASTDWithinGeog (DWithinGeogOp SQLExp
r SQLExp
val SQLExp
sph) -> Text -> [SQLExp] -> BoolExp
applySQLFn Text
"ST_DWithin" [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val, SQLExp
r, SQLExp
sph]
        ASTIntersectsRast SQLExp
val -> [SQLExp] -> BoolExp
applySTIntersects [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
val]
        ASTIntersectsNbandGeom (STIntersectsNbandGeommin SQLExp
nband SQLExp
geommin) -> [SQLExp] -> BoolExp
applySTIntersects [SQLExpression ('Postgres pgKind)
SQLExp
lhs, SQLExp
nband, SQLExp
geommin]
        ASTIntersectsGeomNband (STIntersectsGeomminNband SQLExp
geommin Maybe SQLExp
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
sqlAnd ([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)]
HashMap.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
sqlAnd ([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