{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Postgres Instances Schema
--
-- Defines a 'Hasura.GraphQL.Schema.Backend.BackendSchema' type class instance for Postgres.
module Hasura.Backends.Postgres.Instances.Schema
  (
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.Types (JSONPathElement (..))
import Data.Has
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Parser.JSONPath
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.DML as Postgres hiding (CountType, incOp)
import Hasura.Backends.Postgres.SQL.Types as Postgres hiding (FunctionName, TableName)
import Hasura.Backends.Postgres.SQL.Value as Postgres
import Hasura.Backends.Postgres.Schema.OnConflict
import Hasura.Backends.Postgres.Schema.Select
import Hasura.Backends.Postgres.Types.Aggregates
import Hasura.Backends.Postgres.Types.BoolExp
import Hasura.Backends.Postgres.Types.Column
import Hasura.Backends.Postgres.Types.Insert as PGIR
import Hasura.Backends.Postgres.Types.Update as PGIR
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (toErrorMessage)
import Hasura.Base.ToErrorValue
import Hasura.Function.Cache (FunctionInfo)
import Hasura.GraphQL.ApolloFederation (ApolloFederationParserFunction)
import Hasura.GraphQL.Schema.Backend
  ( BackendSchema,
    BackendTableSelectSchema,
    BackendUpdateOperatorsSchema,
    ComparisonExp,
    MonadBuildSchema,
  )
import Hasura.GraphQL.Schema.Backend qualified as BS
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.BoolExp.AggregationPredicates as Agg
import Hasura.GraphQL.Schema.Build qualified as GSB
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Mutation qualified as GSB
import Hasura.GraphQL.Schema.Parser
  ( Definition,
    FieldParser,
    InputFieldsParser,
    Kind (..),
    MonadParse,
    Parser,
    memoize,
    memoizeOn,
    type (<:),
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Update qualified as SU
import Hasura.GraphQL.Schema.Update.Batch qualified as SUB
import Hasura.LogicalModel.Schema (defaultLogicalModelArgs, defaultLogicalModelSelectionSet)
import Hasura.Name qualified as Name
import Hasura.NativeQuery.Schema qualified as NativeQueries
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Root (RemoteRelationshipField)
import Hasura.RQL.IR.Root qualified as IR
import Hasura.RQL.IR.Select
  ( QueryDB (QDBConnection),
  )
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Update qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.BackendType (BackendType (Postgres), PostgresKind (Citus, Cockroach, Vanilla))
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.SQL.Types
import Hasura.Table.Cache (TableInfo (..), UpdPermInfo (..))
import Language.GraphQL.Draft.Syntax qualified as G
import Language.GraphQL.Draft.Syntax.QQ qualified as G

----------------------------------------------------------------
-- BackendSchema instance

-- | This class is an implementation detail of 'BackendSchema'.
-- Some functions of 'BackendSchema' differ across different Postgres "kinds",
-- or call to functions (such as those related to Relay) that have not been
-- generalized to all kinds of Postgres and still explicitly work on Vanilla
-- Postgres. This class allows each "kind" to specify its own specific
-- implementation. All common code is directly part of `BackendSchema`.
--
-- Note: Users shouldn't ever put this as a constraint. Use `BackendSchema
-- ('Postgres pgKind)` instead.
class PostgresSchema (pgKind :: PostgresKind) where
  pgkBuildTableRelayQueryFields ::
    forall r m n.
    (MonadBuildSchema ('Postgres pgKind) r m n) =>
    MkRootFieldName ->
    TableName ('Postgres pgKind) ->
    TableInfo ('Postgres pgKind) ->
    C.GQLNameIdentifier ->
    NESeq (ColumnInfo ('Postgres pgKind)) ->
    SchemaT r m [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]
  pgkBuildFunctionRelayQueryFields ::
    forall r m n.
    (MonadBuildSchema ('Postgres pgKind) r m n) =>
    MkRootFieldName ->
    FunctionName ('Postgres pgKind) ->
    FunctionInfo ('Postgres pgKind) ->
    TableName ('Postgres pgKind) ->
    NESeq (ColumnInfo ('Postgres pgKind)) ->
    SchemaT r m [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]
  pgkRelayExtension ::
    Maybe (XRelay ('Postgres pgKind))
  pgkBuildTableQueryAndSubscriptionFields ::
    forall r m n.
    ( MonadBuildSchema ('Postgres pgKind) r m n,
      AggregationPredicatesSchema ('Postgres pgKind),
      BackendTableSelectSchema ('Postgres pgKind)
    ) =>
    MkRootFieldName ->
    TableName ('Postgres pgKind) ->
    TableInfo ('Postgres pgKind) ->
    C.GQLNameIdentifier ->
    SchemaT
      r
      m
      ( [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))],
        [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))],
        Maybe (G.Name, Parser 'Output n (ApolloFederationParserFunction n))
      )
  pgkBuildTableStreamingSubscriptionFields ::
    forall r m n.
    ( MonadBuildSchema ('Postgres pgKind) r m n,
      AggregationPredicatesSchema ('Postgres pgKind),
      BackendTableSelectSchema ('Postgres pgKind)
    ) =>
    MkRootFieldName ->
    TableName ('Postgres pgKind) ->
    TableInfo ('Postgres pgKind) ->
    C.GQLNameIdentifier ->
    SchemaT r m [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]

instance PostgresSchema 'Vanilla where
  pgkBuildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Vanilla) r m n =>
MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres 'Vanilla))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
pgkBuildTableRelayQueryFields = MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres 'Vanilla))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableRelayQueryFields
  pgkBuildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Vanilla) r m n =>
MkRootFieldName
-> FunctionName ('Postgres 'Vanilla)
-> FunctionInfo ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
-> NESeq (ColumnInfo ('Postgres 'Vanilla))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
pgkBuildFunctionRelayQueryFields = MkRootFieldName
-> FunctionName ('Postgres 'Vanilla)
-> FunctionInfo ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
-> NESeq (ColumnInfo ('Postgres 'Vanilla))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionRelayQueryFields
  pgkRelayExtension :: Maybe (XRelay ('Postgres 'Vanilla))
pgkRelayExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  pgkBuildTableQueryAndSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Vanilla) r m n,
 AggregationPredicatesSchema ('Postgres 'Vanilla),
 BackendTableSelectSchema ('Postgres 'Vanilla)) =>
MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Vanilla)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Vanilla)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Vanilla)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Vanilla)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
pgkBuildTableQueryAndSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Vanilla)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Vanilla)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Vanilla)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Vanilla)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
GSB.buildTableQueryAndSubscriptionFields
  pgkBuildTableStreamingSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Vanilla) r m n,
 AggregationPredicatesSchema ('Postgres 'Vanilla),
 BackendTableSelectSchema ('Postgres 'Vanilla)) =>
MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
pgkBuildTableStreamingSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Vanilla)
-> TableInfo ('Postgres 'Vanilla)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Vanilla)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Vanilla)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableStreamingSubscriptionFields

instance PostgresSchema 'Citus where
  pgkBuildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Citus) r m n =>
MkRootFieldName
-> TableName ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres 'Citus))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
pgkBuildTableRelayQueryFields MkRootFieldName
_ TableName ('Postgres 'Citus)
_ TableInfo ('Postgres 'Citus)
_ GQLNameIdentifier
_ NESeq (ColumnInfo ('Postgres 'Citus))
_ = [FieldParser
   n
   (QueryDB
      ('Postgres 'Citus)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres 'Citus)))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  pgkBuildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Citus) r m n =>
MkRootFieldName
-> FunctionName ('Postgres 'Citus)
-> FunctionInfo ('Postgres 'Citus)
-> TableName ('Postgres 'Citus)
-> NESeq (ColumnInfo ('Postgres 'Citus))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
pgkBuildFunctionRelayQueryFields MkRootFieldName
_ FunctionName ('Postgres 'Citus)
_ FunctionInfo ('Postgres 'Citus)
_ TableName ('Postgres 'Citus)
_ NESeq (ColumnInfo ('Postgres 'Citus))
_ = [FieldParser
   n
   (QueryDB
      ('Postgres 'Citus)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres 'Citus)))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  pgkRelayExtension :: Maybe (XRelay ('Postgres 'Citus))
pgkRelayExtension = Maybe ()
Maybe (XRelay ('Postgres 'Citus))
forall a. Maybe a
Nothing
  pgkBuildTableQueryAndSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Citus) r m n,
 AggregationPredicatesSchema ('Postgres 'Citus),
 BackendTableSelectSchema ('Postgres 'Citus)) =>
MkRootFieldName
-> TableName ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Citus)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Citus)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Citus)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Citus)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
pgkBuildTableQueryAndSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Citus)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Citus)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Citus)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Citus)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
GSB.buildTableQueryAndSubscriptionFields
  pgkBuildTableStreamingSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Citus) r m n,
 AggregationPredicatesSchema ('Postgres 'Citus),
 BackendTableSelectSchema ('Postgres 'Citus)) =>
MkRootFieldName
-> TableName ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
pgkBuildTableStreamingSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Citus)
-> TableInfo ('Postgres 'Citus)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Citus)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Citus)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableStreamingSubscriptionFields

instance PostgresSchema 'Cockroach where
  pgkBuildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Cockroach) r m n =>
MkRootFieldName
-> TableName ('Postgres 'Cockroach)
-> TableInfo ('Postgres 'Cockroach)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres 'Cockroach))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
pgkBuildTableRelayQueryFields MkRootFieldName
_ TableName ('Postgres 'Cockroach)
_ TableInfo ('Postgres 'Cockroach)
_ GQLNameIdentifier
_ NESeq (ColumnInfo ('Postgres 'Cockroach))
_ = [FieldParser
   n
   (QueryDB
      ('Postgres 'Cockroach)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres 'Cockroach)))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  pgkBuildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres 'Cockroach) r m n =>
MkRootFieldName
-> FunctionName ('Postgres 'Cockroach)
-> FunctionInfo ('Postgres 'Cockroach)
-> TableName ('Postgres 'Cockroach)
-> NESeq (ColumnInfo ('Postgres 'Cockroach))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
pgkBuildFunctionRelayQueryFields MkRootFieldName
_ FunctionName ('Postgres 'Cockroach)
_ FunctionInfo ('Postgres 'Cockroach)
_ TableName ('Postgres 'Cockroach)
_ NESeq (ColumnInfo ('Postgres 'Cockroach))
_ = [FieldParser
   n
   (QueryDB
      ('Postgres 'Cockroach)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres 'Cockroach)))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  pgkRelayExtension :: Maybe (XRelay ('Postgres 'Cockroach))
pgkRelayExtension = Maybe ()
Maybe (XRelay ('Postgres 'Cockroach))
forall a. Maybe a
Nothing
  pgkBuildTableQueryAndSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Cockroach) r m n,
 AggregationPredicatesSchema ('Postgres 'Cockroach),
 BackendTableSelectSchema ('Postgres 'Cockroach)) =>
MkRootFieldName
-> TableName ('Postgres 'Cockroach)
-> TableInfo ('Postgres 'Cockroach)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Cockroach)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Cockroach)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Cockroach)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Cockroach)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
pgkBuildTableQueryAndSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Cockroach)
-> TableInfo ('Postgres 'Cockroach)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres 'Cockroach)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Cockroach)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres 'Cockroach)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres 'Cockroach)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      [FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
GSB.buildTableQueryAndSubscriptionFields
  pgkBuildTableStreamingSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres 'Cockroach) r m n,
 AggregationPredicatesSchema ('Postgres 'Cockroach),
 BackendTableSelectSchema ('Postgres 'Cockroach)) =>
MkRootFieldName
-> TableName ('Postgres 'Cockroach)
-> TableInfo ('Postgres 'Cockroach)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
pgkBuildTableStreamingSubscriptionFields = MkRootFieldName
-> TableName ('Postgres 'Cockroach)
-> TableInfo ('Postgres 'Cockroach)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres 'Cockroach)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres 'Cockroach)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableStreamingSubscriptionFields

-- postgres schema

instance (BackendSchema ('Postgres pgKind)) => AggregationPredicatesSchema ('Postgres pgKind) where
  aggregationPredicatesParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n
           [AggregationPredicates
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]))
aggregationPredicatesParser = [FunctionSignature ('Postgres pgKind)]
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n
           [AggregationPredicatesImplementation
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))]))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
[FunctionSignature b]
-> TableInfo b
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n [AggregationPredicatesImplementation b (UnpreparedValue b)]))
Agg.defaultAggregationPredicatesParser [FunctionSignature ('Postgres pgKind)]
forall (pgKind :: PostgresKind).
[FunctionSignature ('Postgres pgKind)]
aggregationFunctions

-- | The aggregation functions that are supported by postgres variants.
aggregationFunctions :: [Agg.FunctionSignature ('Postgres pgKind)]
aggregationFunctions :: forall (pgKind :: PostgresKind).
[FunctionSignature ('Postgres pgKind)]
aggregationFunctions =
  [ Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"avg",
        fnGQLName :: Name
fnGQLName = [G.name|avg|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"bool_and",
        fnGQLName :: Name
fnGQLName = [G.name|bool_and|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGBoolean,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGBoolean
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"bool_or",
        fnGQLName :: Name
fnGQLName = [G.name|bool_or|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGBoolean,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGBoolean
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"count",
        fnGQLName :: Name
fnGQLName = [G.name|count|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGInteger,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ArgumentsSignature b
Agg.ArgumentsStar
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"max",
        fnGQLName :: Name
fnGQLName = [G.name|max|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"min",
        fnGQLName :: Name
fnGQLName = [G.name|min|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"sum",
        fnGQLName :: Name
fnGQLName = [G.name|sum|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"corr",
        fnGQLName :: Name
fnGQLName = [G.name|corr|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments =
          NonEmpty (ArgumentSignature ('Postgres pgKind))
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType).
NonEmpty (ArgumentSignature b) -> ArgumentsSignature b
Agg.Arguments
            ( [ArgumentSignature ('Postgres pgKind)]
-> NonEmpty (ArgumentSignature ('Postgres pgKind))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
                [ Agg.ArgumentSignature
                    { argType :: ScalarType ('Postgres pgKind)
argType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
                      argName :: Name
argName = [G.name|Y|]
                    },
                  Agg.ArgumentSignature
                    { argType :: ScalarType ('Postgres pgKind)
argType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
                      argName :: Name
argName = [G.name|X|]
                    }
                ]
            )
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"covar_samp",
        fnGQLName :: Name
fnGQLName = [G.name|covar_samp|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments =
          NonEmpty (ArgumentSignature ('Postgres pgKind))
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType).
NonEmpty (ArgumentSignature b) -> ArgumentsSignature b
Agg.Arguments
            ( [ArgumentSignature ('Postgres pgKind)]
-> NonEmpty (ArgumentSignature ('Postgres pgKind))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
                [ Agg.ArgumentSignature
                    { argType :: ScalarType ('Postgres pgKind)
argType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
                      argName :: Name
argName = [G.name|Y|]
                    },
                  Agg.ArgumentSignature
                    { argType :: ScalarType ('Postgres pgKind)
argType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
                      argName :: Name
argName = [G.name|X|]
                    }
                ]
            )
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"stddev_samp",
        fnGQLName :: Name
fnGQLName = [G.name|stddev_samp|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      },
    Agg.FunctionSignature
      { fnName :: Text
fnName = Text
"var_samp",
        fnGQLName :: Name
fnGQLName = [G.name|var_samp|],
        fnReturnType :: ScalarType ('Postgres pgKind)
fnReturnType = ScalarType ('Postgres pgKind)
PGScalarType
PGDouble,
        fnArguments :: ArgumentsSignature ('Postgres pgKind)
fnArguments = ScalarType ('Postgres pgKind)
-> ArgumentsSignature ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ArgumentsSignature b
Agg.SingleArgument ScalarType ('Postgres pgKind)
PGScalarType
PGDouble
      }
  ]

instance
  ( PostgresSchema pgKind,
    Backend ('Postgres pgKind)
  ) =>
  BS.BackendTableSelectSchema ('Postgres pgKind)
  where
  tableArguments :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (SelectArgsG
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
tableArguments = TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (SelectArgsG
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
TableInfo b -> SchemaT r m (InputFieldsParser n (SelectArgs b))
defaultTableArgs
  selectTable :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r m (Maybe (FieldParser n (SelectExp ('Postgres pgKind))))
selectTable = TableInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r m (Maybe (FieldParser n (SelectExp ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
TableInfo b
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (SelectExp b)))
defaultSelectTable
  selectTableAggregate :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r m (Maybe (FieldParser n (AggSelectExp ('Postgres pgKind))))
selectTableAggregate = TableInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r m (Maybe (FieldParser n (AggSelectExp ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
TableInfo b
-> Name
-> Maybe Description
-> SchemaT r m (Maybe (FieldParser n (AggSelectExp b)))
defaultSelectTableAggregate
  tableSelectionSet :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (Parser 'Output n (AnnotatedFields ('Postgres pgKind))))
tableSelectionSet = TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (Parser 'Output n (AnnotatedFields ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(AggregationPredicatesSchema b, BackendTableSelectSchema b,
 Eq (AnnBoolExp b (UnpreparedValue b)), MonadBuildSchema b r m n) =>
TableInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
defaultTableSelectionSet

instance
  ( PostgresSchema pgKind,
    Backend ('Postgres pgKind)
  ) =>
  BS.BackendLogicalModelSelectSchema ('Postgres pgKind)
  where
  logicalModelArguments :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
LogicalModelInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (SelectArgsG
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
logicalModelArguments = LogicalModelInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (SelectArgsG
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b) =>
LogicalModelInfo b
-> SchemaT r m (InputFieldsParser n (SelectArgs b))
defaultLogicalModelArgs
  logicalModelSelectionSet :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
LogicalModelInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (Parser 'Output n (AnnotatedFields ('Postgres pgKind))))
logicalModelSelectionSet = LogicalModelInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (Parser 'Output n (AnnotatedFields ('Postgres pgKind))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
defaultLogicalModelSelectionSet

instance
  ( PostgresSchema pgKind,
    Backend ('Postgres pgKind)
  ) =>
  BS.BackendNativeQuerySelectSchema ('Postgres pgKind)
  where
  selectNativeQuery :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema ('Postgres pgKind) r m n =>
NativeQueryInfo ('Postgres pgKind)
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
selectNativeQuery = NativeQueryInfo ('Postgres pgKind)
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultSelectNativeQuery
  selectNativeQueryObject :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
NativeQueryInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
selectNativeQueryObject = NativeQueryInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultSelectNativeQueryObject

instance
  ( Backend ('Postgres pgKind),
    PostgresSchema pgKind
  ) =>
  BackendSchema ('Postgres pgKind)
  where
  -- top level parsers
  buildTableQueryAndSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
buildTableQueryAndSubscriptionFields = MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind),
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(PostgresSchema pgKind, MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind),
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     ([FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
pgkBuildTableQueryAndSubscriptionFields
  buildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableRelayQueryFields = MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(PostgresSchema pgKind,
 MonadBuildSchema ('Postgres pgKind) r m n) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
pgkBuildTableRelayQueryFields
  buildTableStreamingSubscriptionFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableStreamingSubscriptionFields = MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind),
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(PostgresSchema pgKind, MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind),
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
pgkBuildTableStreamingSubscriptionFields
  buildTableInsertMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> Scenario
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedInsert
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableInsertMutationFields = (TableInfo ('Postgres pgKind)
 -> SchemaT
      r
      m
      (InputFieldsParser
         n
         (BackendInsert
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> MkRootFieldName
-> Scenario
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        MetadataObjId
        n
        (AnnotatedInsert
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b) =>
(TableInfo b
 -> SchemaT
      r m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> MkRootFieldName
-> Scenario
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedInsert
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableInsertMutationFields TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (BackendInsert
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) r (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
backendInsertParser
  buildTableUpdateMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableUpdateMutationFields = Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 PostgresSchema pgKind) =>
Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
pgkBuildTableUpdateMutationFields
  buildTableDeleteMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> Scenario
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableDeleteMutationFields = MkRootFieldName
-> Scenario
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> Scenario
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnDelG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableDeleteMutationFields
  buildFunctionQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionQueryFields = MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionQueryFieldsPG
  buildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionRelayQueryFields = MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(PostgresSchema pgKind,
 MonadBuildSchema ('Postgres pgKind) r m n) =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
pgkBuildFunctionRelayQueryFields
  buildFunctionMutationFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (MutationDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionMutationFields = MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (MutationDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> SchemaT
     r
     m
     [FieldParser
        n
        (MutationDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionMutationFieldsPG
  buildNativeQueryRootFields :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
NativeQueryInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
buildNativeQueryRootFields = NativeQueryInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
NativeQueries.defaultBuildNativeQueryRootFields

  mkRelationshipParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
RelInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n
           (Maybe
              (AnnotatedInsertField
                 ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))))
mkRelationshipParser = (TableInfo ('Postgres pgKind)
 -> SchemaT
      r
      m
      (InputFieldsParser
         n
         (BackendInsert
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> XNestedInserts ('Postgres pgKind)
-> RelInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n
           (Maybe
              (AnnotatedInsertField
                 ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
(TableInfo b
 -> SchemaT
      r m (InputFieldsParser n (BackendInsert b (UnpreparedValue b))))
-> XNestedInserts b
-> RelInfo b
-> SchemaT
     r
     m
     (Maybe
        (InputFieldsParser
           n (Maybe (AnnotatedInsertField b (UnpreparedValue b)))))
GSB.mkDefaultRelationshipParser TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (BackendInsert
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) r (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
backendInsertParser ()

  -- backend extensions
  relayExtension :: Maybe (XRelay ('Postgres pgKind))
relayExtension = forall (pgKind :: PostgresKind).
PostgresSchema pgKind =>
Maybe (XRelay ('Postgres pgKind))
pgkRelayExtension @pgKind
  nodesAggExtension :: Maybe (XNodesAgg ('Postgres pgKind))
nodesAggExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  streamSubscriptionExtension :: Maybe (XStreamingSubscription ('Postgres pgKind))
streamSubscriptionExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  groupByExtension :: Maybe (XGroupBy ('Postgres pgKind))
groupByExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()

  -- individual components
  columnParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser = ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser
  enumParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableName ('Postgres pgKind)
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue ('Postgres pgKind)))
enumParser = forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableName ('Postgres pgKind)
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue ('Postgres pgKind)))
enumParser @pgKind
  possiblyNullable :: forall (m :: * -> *).
MonadParse m =>
ScalarType ('Postgres pgKind)
-> Nullability
-> Parser 'Both m (ScalarValue ('Postgres pgKind))
-> Parser 'Both m (ScalarValue ('Postgres pgKind))
possiblyNullable = ScalarType ('Postgres pgKind)
-> Nullability
-> Parser MetadataObjId 'Both m (ScalarValue ('Postgres pgKind))
-> Parser MetadataObjId 'Both m (ScalarValue ('Postgres pgKind))
ScalarType ('Postgres Any)
-> Nullability
-> Parser 'Both m (ScalarValue ('Postgres Any))
-> Parser 'Both m (ScalarValue ('Postgres Any))
forall (m :: * -> *) (k :: Kind) (pgKind :: PostgresKind).
(MonadParse m, 'Input <: k) =>
ScalarType ('Postgres pgKind)
-> Nullability
-> Parser k m (ScalarValue ('Postgres pgKind))
-> Parser k m (ScalarValue ('Postgres pgKind))
possiblyNullable
  scalarSelectionArgumentsParser :: forall (n :: * -> *).
MonadParse n =>
ColumnType ('Postgres pgKind)
-> InputFieldsParser
     n (Maybe (ScalarSelectionArguments ('Postgres pgKind)))
scalarSelectionArgumentsParser = ColumnType ('Postgres pgKind)
-> InputFieldsParser
     n (Maybe (ScalarSelectionArguments ('Postgres pgKind)))
forall (n :: * -> *) (pgKind :: PostgresKind).
MonadParse n =>
ColumnType ('Postgres pgKind)
-> InputFieldsParser
     n (Maybe (ScalarSelectionArguments ('Postgres pgKind)))
pgScalarSelectionArgumentsParser

  -- NOTE: We don't use @orderByOperators@ directly as this will cause memory
  --  growth, instead we use separate functions, according to @jberryman on the
  --  memory growth, "This is turning a CAF Into a function, And the output is
  --  likely no longer going to be shared even for the same arguments, and even
  --  though the domain is extremely small (just HasuraCase or GraphqlCase)."
  orderByOperators :: SourceInfo ('Postgres pgKind)
-> NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres pgKind),
        NullsOrderType ('Postgres pgKind))))
orderByOperators SourceInfo ('Postgres pgKind)
_sourceInfo = \case
    NamingCase
HasuraCase -> (Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres Any), NullsOrderType ('Postgres Any))))
forall (pgKind :: PostgresKind).
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
orderByOperatorsHasuraCase
    NamingCase
GraphqlCase -> (Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres Any), NullsOrderType ('Postgres Any))))
forall (pgKind :: PostgresKind).
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
orderByOperatorsGraphqlCase
  comparisonExps :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
comparisonExps = ColumnType ('Postgres pgKind)
-> SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
comparisonExps
  countTypeInput :: forall (n :: * -> *).
MonadParse n =>
Maybe
  (Parser
     'Both
     n
     (Column ('Postgres pgKind),
      AnnRedactionExpUnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
countTypeInput = Maybe
  (Parser
     'Both
     n
     (Column ('Postgres pgKind),
      AnnRedactionExpUnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall (n :: * -> *) (pgKind :: PostgresKind).
MonadParse n =>
Maybe
  (Parser
     'Both
     n
     (Column ('Postgres pgKind),
      AnnRedactionExpUnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
countTypeInput
  aggregateOrderByCountType :: ScalarType ('Postgres pgKind)
aggregateOrderByCountType = ScalarType ('Postgres pgKind)
PGScalarType
Postgres.PGInteger
  computedField :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ComputedFieldInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (FieldParser n (AnnotatedField ('Postgres pgKind))))
computedField = ComputedFieldInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (FieldParser n (AnnotatedField ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
ComputedFieldInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r m (Maybe (FieldParser n (AnnotatedField ('Postgres pgKind))))
computedFieldPG

instance (Backend ('Postgres pgKind)) => BackendUpdateOperatorsSchema ('Postgres pgKind) where
  type UpdateOperators ('Postgres pgKind) = UpdateOpExpression

  parseUpdateOperators :: forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> UpdPermInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOperators
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
parseUpdateOperators = TableInfo ('Postgres pgKind)
-> UpdPermInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))))
TableInfo ('Postgres pgKind)
-> UpdPermInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOperators
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> UpdPermInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))))
pgkParseUpdateOperators

backendInsertParser ::
  forall pgKind m r n.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  TableInfo ('Postgres pgKind) ->
  SchemaT r m (InputFieldsParser n (PGIR.BackendInsert pgKind (IR.UnpreparedValue ('Postgres pgKind))))
backendInsertParser :: forall (pgKind :: PostgresKind) (m :: * -> *) r (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
backendInsertParser TableInfo ('Postgres pgKind)
tableInfo =
  (Maybe
   (OnConflictClause
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
 -> BackendInsert pgKind (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe
        (OnConflictClause
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind)))
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe
  (OnConflictClause
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
Maybe (OnConflictClause ('Postgres pgKind) v)
-> BackendInsert pgKind v
BackendInsert (InputFieldsParser
   MetadataObjId
   n
   (Maybe
      (OnConflictClause
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
 -> InputFieldsParser
      MetadataObjId
      n
      (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (BackendInsert pgKind (UnpreparedValue ('Postgres pgKind))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind)) =>
TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (Maybe
           (OnConflictClause
              ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
onConflictFieldParser TableInfo ('Postgres pgKind)
tableInfo

----------------------------------------------------------------
-- Top level parsers

buildTableRelayQueryFields ::
  forall r m n pgKind.
  ( MonadBuildSchema ('Postgres pgKind) r m n,
    BackendTableSelectSchema ('Postgres pgKind)
  ) =>
  MkRootFieldName ->
  TableName ('Postgres pgKind) ->
  TableInfo ('Postgres pgKind) ->
  C.GQLNameIdentifier ->
  NESeq (ColumnInfo ('Postgres pgKind)) ->
  SchemaT r m [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]
buildTableRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> TableName ('Postgres pgKind)
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildTableRelayQueryFields MkRootFieldName
mkRootFieldName TableName ('Postgres pgKind)
tableName TableInfo ('Postgres pgKind)
tableInfo GQLNameIdentifier
gqlName NESeq (ColumnInfo ('Postgres pgKind))
pkeyColumns = do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  let customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization
      fieldDesc :: Maybe Description
fieldDesc = Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"fetch data from the table: " Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName ('Postgres pgKind)
QualifiedTable
tableName
      rootFieldName :: Name
rootFieldName = MkRootFieldName -> Name -> Name
runMkRootFieldName MkRootFieldName
mkRootFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier -> GQLNameIdentifier
mkRelayConnectionField GQLNameIdentifier
gqlName)
  (Maybe
   (FieldParser
      n
      (QueryDB
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind))))
 -> [FieldParser
       n
       (QueryDB
          ('Postgres pgKind)
          (RemoteRelationshipField UnpreparedValue)
          (UnpreparedValue ('Postgres pgKind)))])
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe
  (FieldParser
     n
     (QueryDB
        ('Postgres pgKind)
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue ('Postgres pgKind))))
-> [FieldParser
      n
      (QueryDB
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind)))]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t a -> f a
afold
    (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))))
 -> SchemaT
      r
      m
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))])
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall a b. (a -> b) -> a -> b
$ (ConnectionSelect
   ('Postgres pgKind)
   (RemoteRelationshipField UnpreparedValue)
   (UnpreparedValue ('Postgres pgKind))
 -> QueryDB
      ('Postgres pgKind)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres pgKind)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser ConnectionSelect
  ('Postgres pgKind)
  (RemoteRelationshipField UnpreparedValue)
  (UnpreparedValue ('Postgres pgKind))
-> QueryDB
     ('Postgres pgKind)
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) r v.
ConnectionSelect b r v -> QueryDB b r v
QDBConnection
    (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (ConnectionSelect
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (QueryDB
               ('Postgres pgKind)
               (RemoteRelationshipField UnpreparedValue)
               (UnpreparedValue ('Postgres pgKind))))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall a b. (a -> b) -> a -> b
$ TableInfo ('Postgres pgKind)
-> Name
-> Maybe Description
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendTableSelectSchema b,
 AggregationPredicatesSchema b) =>
TableInfo b
-> Name
-> Maybe Description
-> PrimaryKeyColumns b
-> SchemaT r m (Maybe (FieldParser n (ConnectionSelectExp b)))
selectTableConnection TableInfo ('Postgres pgKind)
tableInfo Name
rootFieldName Maybe Description
fieldDesc NESeq (ColumnInfo ('Postgres pgKind))
pkeyColumns

buildFunctionRelayQueryFields ::
  forall r m n pgKind.
  ( MonadBuildSchema ('Postgres pgKind) r m n,
    BackendTableSelectSchema ('Postgres pgKind)
  ) =>
  MkRootFieldName ->
  FunctionName ('Postgres pgKind) ->
  FunctionInfo ('Postgres pgKind) ->
  TableName ('Postgres pgKind) ->
  NESeq (ColumnInfo ('Postgres pgKind)) ->
  SchemaT r m [FieldParser n (QueryDB ('Postgres pgKind) (RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]
buildFunctionRelayQueryFields :: forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> FunctionName ('Postgres pgKind)
-> FunctionInfo ('Postgres pgKind)
-> TableName ('Postgres pgKind)
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
buildFunctionRelayQueryFields MkRootFieldName
mkRootFieldName FunctionName ('Postgres pgKind)
functionName FunctionInfo ('Postgres pgKind)
functionInfo TableName ('Postgres pgKind)
tableName NESeq (ColumnInfo ('Postgres pgKind))
pkeyColumns = do
  let fieldDesc :: Maybe Description
fieldDesc = Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"execute function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName ('Postgres pgKind)
QualifiedFunction
functionName QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" which returns " Text -> QualifiedTable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName ('Postgres pgKind)
QualifiedTable
tableName
  (Maybe
   (FieldParser
      n
      (QueryDB
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind))))
 -> [FieldParser
       n
       (QueryDB
          ('Postgres pgKind)
          (RemoteRelationshipField UnpreparedValue)
          (UnpreparedValue ('Postgres pgKind)))])
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe
  (FieldParser
     n
     (QueryDB
        ('Postgres pgKind)
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue ('Postgres pgKind))))
-> [FieldParser
      n
      (QueryDB
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind)))]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t a -> f a
afold
    (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))))
 -> SchemaT
      r
      m
      [FieldParser
         n
         (QueryDB
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))])
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     [FieldParser
        n
        (QueryDB
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall a b. (a -> b) -> a -> b
$ (ConnectionSelect
   ('Postgres pgKind)
   (RemoteRelationshipField UnpreparedValue)
   (UnpreparedValue ('Postgres pgKind))
 -> QueryDB
      ('Postgres pgKind)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres pgKind)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser ConnectionSelect
  ('Postgres pgKind)
  (RemoteRelationshipField UnpreparedValue)
  (UnpreparedValue ('Postgres pgKind))
-> QueryDB
     ('Postgres pgKind)
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) r v.
ConnectionSelect b r v -> QueryDB b r v
QDBConnection
    (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (ConnectionSelect
            ('Postgres pgKind)
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue ('Postgres pgKind)))))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (QueryDB
               ('Postgres pgKind)
               (RemoteRelationshipField UnpreparedValue)
               (UnpreparedValue ('Postgres pgKind))))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall a b. (a -> b) -> a -> b
$ MkRootFieldName
-> FunctionInfo ('Postgres pgKind)
-> Maybe Description
-> NESeq (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (ConnectionSelect
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema ('Postgres pgKind) r m n,
 AggregationPredicatesSchema ('Postgres pgKind),
 BackendTableSelectSchema ('Postgres pgKind)) =>
MkRootFieldName
-> FunctionInfo ('Postgres pgKind)
-> Maybe Description
-> PrimaryKeyColumns ('Postgres pgKind)
-> SchemaT
     r
     m
     (Maybe (FieldParser n (ConnectionSelectExp ('Postgres pgKind))))
selectFunctionConnection MkRootFieldName
mkRootFieldName FunctionInfo ('Postgres pgKind)
functionInfo Maybe Description
fieldDesc NESeq (ColumnInfo ('Postgres pgKind))
pkeyColumns

pgkBuildTableUpdateMutationFields ::
  forall r m n pgKind.
  (MonadBuildSchema ('Postgres pgKind) r m n, PostgresSchema pgKind) =>
  Scenario ->
  TableInfo ('Postgres pgKind) ->
  C.GQLNameIdentifier ->
  SchemaT r m [P.FieldParser n (IR.AnnotatedUpdateG ('Postgres pgKind) (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue ('Postgres pgKind)))]
pgkBuildTableUpdateMutationFields :: forall r (m :: * -> *) (n :: * -> *) (pgKind :: PostgresKind).
(MonadBuildSchema ('Postgres pgKind) r m n,
 PostgresSchema pgKind) =>
Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
pgkBuildTableUpdateMutationFields Scenario
scenario TableInfo ('Postgres pgKind)
tableInfo GQLNameIdentifier
gqlName = do
  [FieldParser
   n
   (AnnotatedUpdateG
      ('Postgres pgKind)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres pgKind)))]
updateRootFields <- (UpdateBatch
   ('Postgres pgKind)
   (UpdateOperators ('Postgres pgKind))
   (UnpreparedValue ('Postgres pgKind))
 -> UpdateVariant
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           ('Postgres pgKind)
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue ('Postgres pgKind)))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b, BackendUpdateOperatorsSchema b) =>
(UpdateBatch b (UpdateOperators b) (UnpreparedValue b)
 -> UpdateVariant b (UnpreparedValue b))
-> Scenario
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     [FieldParser
        n
        (AnnotatedUpdateG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildSingleBatchTableUpdateMutationFields UpdateBatch
  ('Postgres pgKind)
  UpdateOpExpression
  (UnpreparedValue ('Postgres pgKind))
-> PgUpdateVariant pgKind (UnpreparedValue ('Postgres pgKind))
UpdateBatch
  ('Postgres pgKind)
  (UpdateOperators ('Postgres pgKind))
  (UnpreparedValue ('Postgres pgKind))
-> UpdateVariant
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
UpdateBatch ('Postgres pgKind) UpdateOpExpression v
-> PgUpdateVariant pgKind v
SingleBatch Scenario
scenario TableInfo ('Postgres pgKind)
tableInfo GQLNameIdentifier
gqlName
  Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        ('Postgres pgKind)
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue ('Postgres pgKind))))
updateManyRootField <- ([UpdateBatch
    ('Postgres pgKind)
    (UpdateOperators ('Postgres pgKind))
    (UnpreparedValue ('Postgres pgKind))]
 -> UpdateVariant
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> Scenario
-> TableInfo ('Postgres pgKind)
-> GQLNameIdentifier
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              ('Postgres pgKind)
              (RemoteRelationshipField UnpreparedValue)
              (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b, BackendUpdateOperatorsSchema b) =>
([UpdateBatch b (UpdateOperators b) (UnpreparedValue b)]
 -> UpdateVariant b (UnpreparedValue b))
-> Scenario
-> TableInfo b
-> GQLNameIdentifier
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnotatedUpdateG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
SUB.updateTableMany [UpdateBatch
   ('Postgres pgKind)
   UpdateOpExpression
   (UnpreparedValue ('Postgres pgKind))]
-> PgUpdateVariant pgKind (UnpreparedValue ('Postgres pgKind))
[UpdateBatch
   ('Postgres pgKind)
   (UpdateOperators ('Postgres pgKind))
   (UnpreparedValue ('Postgres pgKind))]
-> UpdateVariant
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
[UpdateBatch ('Postgres pgKind) UpdateOpExpression v]
-> PgUpdateVariant pgKind v
MultipleBatches Scenario
scenario TableInfo ('Postgres pgKind)
tableInfo GQLNameIdentifier
gqlName
  pure $ [FieldParser
   n
   (AnnotatedUpdateG
      ('Postgres pgKind)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres pgKind)))]
updateRootFields [FieldParser
   n
   (AnnotatedUpdateG
      ('Postgres pgKind)
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue ('Postgres pgKind)))]
-> [FieldParser
      n
      (AnnotatedUpdateG
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind)))]
-> [FieldParser
      n
      (AnnotatedUpdateG
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind)))]
forall a. [a] -> [a] -> [a]
++ (Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        ('Postgres pgKind)
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue ('Postgres pgKind))))
-> [FieldParser
      n
      (AnnotatedUpdateG
         ('Postgres pgKind)
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue ('Postgres pgKind)))]
forall a. Maybe a -> [a]
maybeToList Maybe
  (FieldParser
     n
     (AnnotatedUpdateG
        ('Postgres pgKind)
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue ('Postgres pgKind))))
updateManyRootField)

----------------------------------------------------------------
-- Individual components

columnParser ::
  forall pgKind r m n.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  ColumnType ('Postgres pgKind) ->
  G.Nullability ->
  SchemaT r m (Parser 'Both n (IR.ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser :: forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser ColumnType ('Postgres pgKind)
columnType Nullability
nullability = case ColumnType ('Postgres pgKind)
columnType of
  ColumnScalar ScalarType ('Postgres pgKind)
scalarType -> Name
-> (PGScalarType, Nullability)
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
memoizeOn 'columnParser (ScalarType ('Postgres pgKind)
PGScalarType
scalarType, Nullability
nullability) do
    -- We convert the value to JSON and use the FromJSON instance. This avoids
    -- having two separate ways of parsing a value in the codebase, which
    -- could lead to inconsistencies.
    --
    -- The mapping from postgres type to GraphQL scalar name is done by
    -- 'mkScalarTypeName'. This is confusing, and we might want to fix it
    -- later, as we will parse values differently here than how they'd be
    -- parsed in other places using the same scalar name; for instance, we
    -- will accept strings for postgres columns of type "Integer", despite the
    -- fact that they will be represented as GraphQL ints, which otherwise do
    -- not accept strings.
    --
    -- TODO: introduce new dedicated scalars for Postgres column types.
    (Name
name, Type MetadataObjId 'Both
schemaType) <- case ScalarType ('Postgres pgKind)
scalarType of
      PGArray PGScalarType
innerScalar -> do
        -- postgres arrays break introspection for some clients so allow them
        -- to disable it
        UsePostgresArrays
disableArrays <- (SchemaOptions -> UsePostgresArrays)
-> SchemaT r m UsePostgresArrays
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> UsePostgresArrays
Options.soPostgresArrays
        case UsePostgresArrays
disableArrays of
          UsePostgresArrays
Options.UsePostgresArrays -> do
            Name
name <- PGScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
innerScalar
            pure
              ( Name
name,
                Nullability -> Type MetadataObjId 'Both -> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability -> Type origin k -> Type origin k
P.TList
                  Nullability
P.NonNullable
                  (Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar)
              )
          UsePostgresArrays
Options.DontUsePostgresArrays -> do
            -- previously, we represented text[] as `_text` - recover this
            -- naming:
            Name
arrayName <- PGScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName (Text -> PGScalarType
PGUnknown (Text -> PGScalarType) -> Text -> PGScalarType
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType -> Text
pgScalarTypeToText PGScalarType
innerScalar)
            pure
              ( Name
arrayName,
                Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
arrayName Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar
              )
      ScalarType ('Postgres pgKind)
_ -> do
        Name
name <- PGScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName ScalarType ('Postgres pgKind)
PGScalarType
scalarType
        pure (Name
name, Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar)
    Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
 -> SchemaT
      r
      m
      (Parser
         'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n (ColumnValue ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin
      (Parser 'Both n (ColumnValue ('Postgres pgKind))
 -> Parser
      'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
-> Parser 'Both n (ColumnValue ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ (PGScalarValue -> ColumnValue ('Postgres pgKind))
-> Parser MetadataObjId 'Both n PGScalarValue
-> Parser 'Both n (ColumnValue ('Postgres pgKind))
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnType ('Postgres pgKind)
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType ('Postgres pgKind)
columnType)
      (Parser MetadataObjId 'Both n PGScalarValue
 -> Parser 'Both n (ColumnValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Both n PGScalarValue
-> Parser 'Both n (ColumnValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ ScalarType ('Postgres Any)
-> Nullability
-> Parser 'Both n (ScalarValue ('Postgres Any))
-> Parser 'Both n (ScalarValue ('Postgres Any))
forall (m :: * -> *) (k :: Kind) (pgKind :: PostgresKind).
(MonadParse m, 'Input <: k) =>
ScalarType ('Postgres pgKind)
-> Nullability
-> Parser k m (ScalarValue ('Postgres pgKind))
-> Parser k m (ScalarValue ('Postgres pgKind))
possiblyNullable ScalarType ('Postgres pgKind)
ScalarType ('Postgres Any)
scalarType Nullability
nullability
      (Parser 'Both n (ScalarValue ('Postgres Any))
 -> Parser 'Both n (ScalarValue ('Postgres Any)))
-> Parser 'Both n (ScalarValue ('Postgres Any))
-> Parser 'Both n (ScalarValue ('Postgres Any))
forall a b. (a -> b) -> a -> b
$ P.Parser
        { pType :: Type MetadataObjId 'Both
pType = Type MetadataObjId 'Both
schemaType,
          pParser :: ParserInput 'Both -> n PGScalarValue
pParser =
            GType -> InputValue Variable -> n Value
forall (m :: * -> *).
MonadParse m =>
GType -> InputValue Variable -> m Value
P.valueToJSON (Type MetadataObjId 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
P.toGraphQLType Type MetadataObjId 'Both
schemaType) (InputValue Variable -> n Value)
-> (Value -> n PGScalarValue)
-> InputValue Variable
-> n PGScalarValue
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
              Value
J.Null -> ErrorMessage -> n PGScalarValue
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> n PGScalarValue)
-> ErrorMessage -> n PGScalarValue
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"unexpected null value for type " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Name -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue Name
name
              Value
value ->
                (Value -> Parser PGScalarValue)
-> Value -> Either QErr PGScalarValue
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser (PGScalarType -> Value -> Parser PGScalarValue
parsePGValue ScalarType ('Postgres pgKind)
PGScalarType
scalarType) Value
value
                  Either QErr PGScalarValue
-> (QErr -> n PGScalarValue) -> n PGScalarValue
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (ParseErrorCode -> ErrorMessage -> n PGScalarValue
forall a. ParseErrorCode -> ErrorMessage -> n a
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
P.parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> n PGScalarValue)
-> (QErr -> ErrorMessage) -> QErr -> n PGScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage) -> (QErr -> Text) -> QErr -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Text
qeError)
        }
  ColumnEnumReference (EnumReference TableName ('Postgres pgKind)
tableName EnumValues
enumValues Maybe Name
tableCustomName) ->
    case [(EnumValue, EnumValueInfo)]
-> Maybe (NonEmpty (EnumValue, EnumValueInfo))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(EnumValue, EnumValueInfo)]
 -> Maybe (NonEmpty (EnumValue, EnumValueInfo)))
-> ([(EnumValue, EnumValueInfo)] -> [(EnumValue, EnumValueInfo)])
-> [(EnumValue, EnumValueInfo)]
-> Maybe (NonEmpty (EnumValue, EnumValueInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EnumValue, EnumValueInfo) -> EnumValue)
-> [(EnumValue, EnumValueInfo)] -> [(EnumValue, EnumValueInfo)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (EnumValue, EnumValueInfo) -> EnumValue
forall a b. (a, b) -> a
fst ([(EnumValue, EnumValueInfo)]
 -> Maybe (NonEmpty (EnumValue, EnumValueInfo)))
-> [(EnumValue, EnumValueInfo)]
-> Maybe (NonEmpty (EnumValue, EnumValueInfo))
forall a b. (a -> b) -> a -> b
$ EnumValues -> [(EnumValue, EnumValueInfo)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList EnumValues
enumValues of
      Just NonEmpty (EnumValue, EnumValueInfo)
enumValuesList ->
        Parser 'Both n (ColumnValue ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin
          (Parser 'Both n (ColumnValue ('Postgres pgKind))
 -> Parser
      'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
-> (Parser MetadataObjId 'Both n PGScalarValue
    -> Parser 'Both n (ColumnValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Both n PGScalarValue
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGScalarValue -> ColumnValue ('Postgres pgKind))
-> Parser MetadataObjId 'Both n PGScalarValue
-> Parser 'Both n (ColumnValue ('Postgres pgKind))
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnType ('Postgres pgKind)
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType ('Postgres pgKind)
columnType)
          (Parser MetadataObjId 'Both n PGScalarValue
 -> Parser
      'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
-> SchemaT r m (Parser MetadataObjId 'Both n PGScalarValue)
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableName ('Postgres pgKind)
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue ('Postgres pgKind)))
enumParser @pgKind TableName ('Postgres pgKind)
tableName NonEmpty (EnumValue, EnumValueInfo)
enumValuesList Maybe Name
tableCustomName Nullability
nullability
      Maybe (NonEmpty (EnumValue, EnumValueInfo))
Nothing -> Code
-> Text
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"empty enum values"

enumParser ::
  forall pgKind r m n.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  TableName ('Postgres pgKind) ->
  NonEmpty (EnumValue, EnumValueInfo) ->
  Maybe G.Name ->
  G.Nullability ->
  SchemaT r m (Parser 'Both n (ScalarValue ('Postgres pgKind)))
enumParser :: forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
TableName ('Postgres pgKind)
-> NonEmpty (EnumValue, EnumValueInfo)
-> Maybe Name
-> Nullability
-> SchemaT r m (Parser 'Both n (ScalarValue ('Postgres pgKind)))
enumParser TableName ('Postgres pgKind)
tableName NonEmpty (EnumValue, EnumValueInfo)
enumValues Maybe Name
tableCustomName Nullability
nullability = do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  let customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization
  GQLNameIdentifier
tableGQLName <- Either QErr GQLNameIdentifier -> SchemaT r m GQLNameIdentifier
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (QualifiedTable -> Either QErr GQLNameIdentifier
forall a.
ToTxt a =>
QualifiedObject a -> Either QErr GQLNameIdentifier
getIdentifierQualifiedObject TableName ('Postgres pgKind)
QualifiedTable
tableName)
  let name :: Name
name = ResolvedSourceCustomization
-> GQLNameIdentifier -> Maybe Name -> Name
addEnumSuffix ResolvedSourceCustomization
customization GQLNameIdentifier
tableGQLName Maybe Name
tableCustomName
  Parser 'Both n PGScalarValue
-> SchemaT r m (Parser 'Both n PGScalarValue)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Both n PGScalarValue
 -> SchemaT r m (Parser 'Both n PGScalarValue))
-> Parser 'Both n PGScalarValue
-> SchemaT r m (Parser 'Both n PGScalarValue)
forall a b. (a -> b) -> a -> b
$ ScalarType ('Postgres Any)
-> Nullability
-> Parser 'Both n (ScalarValue ('Postgres Any))
-> Parser 'Both n (ScalarValue ('Postgres Any))
forall (m :: * -> *) (k :: Kind) (pgKind :: PostgresKind).
(MonadParse m, 'Input <: k) =>
ScalarType ('Postgres pgKind)
-> Nullability
-> Parser k m (ScalarValue ('Postgres pgKind))
-> Parser k m (ScalarValue ('Postgres pgKind))
possiblyNullable ScalarType ('Postgres Any)
PGScalarType
PGText Nullability
nullability (Parser 'Both n (ScalarValue ('Postgres Any))
 -> Parser 'Both n (ScalarValue ('Postgres Any)))
-> Parser 'Both n (ScalarValue ('Postgres Any))
-> Parser 'Both n (ScalarValue ('Postgres Any))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty (Definition EnumValueInfo, PGScalarValue)
-> Parser 'Both n PGScalarValue
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
name Maybe Description
forall a. Maybe a
Nothing (NamingCase
-> (EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue ('Postgres pgKind))
mkEnumValue NamingCase
tCase ((EnumValue, EnumValueInfo)
 -> (Definition EnumValueInfo, PGScalarValue))
-> NonEmpty (EnumValue, EnumValueInfo)
-> NonEmpty (Definition EnumValueInfo, PGScalarValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (EnumValue, EnumValueInfo)
enumValues)
  where
    mkEnumValue :: NamingCase -> (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue ('Postgres pgKind))
    mkEnumValue :: NamingCase
-> (EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue ('Postgres pgKind))
mkEnumValue NamingCase
tCase (EnumValue Name
value, EnumValueInfo Maybe Text
description) =
      ( Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> EnumValueInfo
-> Definition EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
value) (Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
description) Maybe MetadataObjId
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo,
        Text -> PGScalarValue
PGValText (Text -> PGScalarValue) -> Text -> PGScalarValue
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
value
      )

possiblyNullable ::
  (MonadParse m, 'Input <: k) =>
  ScalarType ('Postgres pgKind) ->
  G.Nullability ->
  Parser k m (ScalarValue ('Postgres pgKind)) ->
  Parser k m (ScalarValue ('Postgres pgKind))
possiblyNullable :: forall (m :: * -> *) (k :: Kind) (pgKind :: PostgresKind).
(MonadParse m, 'Input <: k) =>
ScalarType ('Postgres pgKind)
-> Nullability
-> Parser k m (ScalarValue ('Postgres pgKind))
-> Parser k m (ScalarValue ('Postgres pgKind))
possiblyNullable ScalarType ('Postgres pgKind)
scalarType (G.Nullability Bool
isNullable)
  | Bool
isNullable = (Maybe PGScalarValue -> PGScalarValue)
-> Parser MetadataObjId k m (Maybe PGScalarValue)
-> Parser MetadataObjId k m PGScalarValue
forall a b.
(a -> b)
-> Parser MetadataObjId k m a -> Parser MetadataObjId k m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PGScalarValue -> Maybe PGScalarValue -> PGScalarValue
forall a. a -> Maybe a -> a
fromMaybe (PGScalarValue -> Maybe PGScalarValue -> PGScalarValue)
-> PGScalarValue -> Maybe PGScalarValue -> PGScalarValue
forall a b. (a -> b) -> a -> b
$ PGScalarType -> PGScalarValue
PGNull ScalarType ('Postgres pgKind)
PGScalarType
scalarType) (Parser MetadataObjId k m (Maybe PGScalarValue)
 -> Parser MetadataObjId k m PGScalarValue)
-> (Parser MetadataObjId k m PGScalarValue
    -> Parser MetadataObjId k m (Maybe PGScalarValue))
-> Parser MetadataObjId k m PGScalarValue
-> Parser MetadataObjId k m PGScalarValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId k m PGScalarValue
-> Parser MetadataObjId k m (Maybe PGScalarValue)
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (Maybe a)
P.nullable
  | Bool
otherwise = Parser MetadataObjId k m (ScalarValue ('Postgres pgKind))
-> Parser MetadataObjId k m (ScalarValue ('Postgres pgKind))
Parser MetadataObjId k m PGScalarValue
-> Parser MetadataObjId k m PGScalarValue
forall a. a -> a
id

pgScalarSelectionArgumentsParser ::
  (MonadParse n) =>
  ColumnType ('Postgres pgKind) ->
  InputFieldsParser n (Maybe (ScalarSelectionArguments ('Postgres pgKind)))
pgScalarSelectionArgumentsParser :: forall (n :: * -> *) (pgKind :: PostgresKind).
MonadParse n =>
ColumnType ('Postgres pgKind)
-> InputFieldsParser
     n (Maybe (ScalarSelectionArguments ('Postgres pgKind)))
pgScalarSelectionArgumentsParser ColumnType ('Postgres pgKind)
columnType
  | (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
Postgres.isJSONType ColumnType ('Postgres pgKind)
columnType =
      Name
-> Maybe Description
-> Parser MetadataObjId 'Both n Text
-> InputFieldsParser MetadataObjId n (Maybe Text)
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
fieldName Maybe Description
description Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string InputFieldsParser MetadataObjId n (Maybe Text)
-> (Maybe Text -> n (Maybe ColumnOp))
-> InputFieldsParser MetadataObjId n (Maybe ColumnOp)
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` (Maybe (Maybe ColumnOp) -> Maybe ColumnOp)
-> n (Maybe (Maybe ColumnOp)) -> n (Maybe ColumnOp)
forall a b. (a -> b) -> n a -> n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe ColumnOp) -> Maybe ColumnOp
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (n (Maybe (Maybe ColumnOp)) -> n (Maybe ColumnOp))
-> (Maybe Text -> n (Maybe (Maybe ColumnOp)))
-> Maybe Text
-> n (Maybe ColumnOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> n (Maybe ColumnOp))
-> Maybe Text -> n (Maybe (Maybe ColumnOp))
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 Text -> n (Maybe ColumnOp)
forall {m :: * -> *}. MonadParse m => Text -> m (Maybe ColumnOp)
toColExp
  | Bool
otherwise = Maybe ColumnOp
-> InputFieldsParser MetadataObjId n (Maybe ColumnOp)
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ColumnOp
forall a. Maybe a
Nothing
  where
    fieldName :: Name
fieldName = Name
Name._path
    description :: Maybe Description
description = Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"JSON select path"
    toColExp :: Text -> m (Maybe ColumnOp)
toColExp Text
textValue = case Text -> Either Text JSONPath
parseJSONPath Text
textValue of
      Left Text
err -> ErrorMessage -> m (Maybe ColumnOp)
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> m (Maybe ColumnOp))
-> ErrorMessage -> m (Maybe ColumnOp)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"parse json path error: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Text -> ErrorMessage
toErrorMessage Text
err
      Right [] -> Maybe ColumnOp -> m (Maybe ColumnOp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ColumnOp
forall a. Maybe a
Nothing
      Right JSONPath
jPaths -> Maybe ColumnOp -> m (Maybe ColumnOp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ColumnOp -> m (Maybe ColumnOp))
-> Maybe ColumnOp -> m (Maybe ColumnOp)
forall a b. (a -> b) -> a -> b
$ ColumnOp -> Maybe ColumnOp
forall a. a -> Maybe a
Just (ColumnOp -> Maybe ColumnOp) -> ColumnOp -> Maybe ColumnOp
forall a b. (a -> b) -> a -> b
$ SQLOp -> SQLExp -> ColumnOp
Postgres.ColumnOp SQLOp
Postgres.jsonbPathOp (SQLExp -> ColumnOp) -> SQLExp -> ColumnOp
forall a b. (a -> b) -> a -> b
$ [SQLExp] -> SQLExp
Postgres.SEArray ([SQLExp] -> SQLExp) -> [SQLExp] -> SQLExp
forall a b. (a -> b) -> a -> b
$ (JSONPathElement -> SQLExp) -> JSONPath -> [SQLExp]
forall a b. (a -> b) -> [a] -> [b]
map JSONPathElement -> SQLExp
elToColExp JSONPath
jPaths
    elToColExp :: JSONPathElement -> SQLExp
elToColExp (Key Key
k) = Text -> SQLExp
Postgres.SELit (Text -> SQLExp) -> Text -> SQLExp
forall a b. (a -> b) -> a -> b
$ Key -> Text
K.toText Key
k
    elToColExp (Index Int
i) = Text -> SQLExp
Postgres.SELit (Text -> SQLExp) -> Text -> SQLExp
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
i

orderByOperatorsHasuraCase ::
  (G.Name, NonEmpty (Definition P.EnumValueInfo, (BasicOrderType ('Postgres pgKind), NullsOrderType ('Postgres pgKind))))
orderByOperatorsHasuraCase :: forall (pgKind :: PostgresKind).
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
orderByOperatorsHasuraCase = NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres Any), NullsOrderType ('Postgres Any))))
forall (pgKind :: PostgresKind).
NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres pgKind),
        NullsOrderType ('Postgres pgKind))))
orderByOperators NamingCase
HasuraCase

orderByOperatorsGraphqlCase ::
  (G.Name, NonEmpty (Definition P.EnumValueInfo, (BasicOrderType ('Postgres pgKind), NullsOrderType ('Postgres pgKind))))
orderByOperatorsGraphqlCase :: forall (pgKind :: PostgresKind).
(Name,
 NonEmpty
   (Definition EnumValueInfo,
    (BasicOrderType ('Postgres pgKind),
     NullsOrderType ('Postgres pgKind))))
orderByOperatorsGraphqlCase = NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres Any), NullsOrderType ('Postgres Any))))
forall (pgKind :: PostgresKind).
NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres pgKind),
        NullsOrderType ('Postgres pgKind))))
orderByOperators NamingCase
GraphqlCase

-- | Do NOT use this function directly, this should be used via
--  @orderByOperatorsHasuraCase@ or @orderByOperatorsGraphqlCase@
orderByOperators ::
  NamingCase ->
  (G.Name, NonEmpty (Definition P.EnumValueInfo, (BasicOrderType ('Postgres pgKind), NullsOrderType ('Postgres pgKind))))
orderByOperators :: forall (pgKind :: PostgresKind).
NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres pgKind),
        NullsOrderType ('Postgres pgKind))))
orderByOperators NamingCase
tCase =
  (Name
Name._order_by,)
    (NonEmpty (Definition EnumValueInfo, (OrderType, NullsOrder))
 -> (Name,
     NonEmpty
       (Definition EnumValueInfo,
        (BasicOrderType ('Postgres pgKind),
         NullsOrderType ('Postgres pgKind)))))
-> NonEmpty (Definition EnumValueInfo, (OrderType, NullsOrder))
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType ('Postgres pgKind),
        NullsOrderType ('Postgres pgKind))))
forall a b. (a -> b) -> a -> b
$ [(Definition EnumValueInfo, (OrderType, NullsOrder))]
-> NonEmpty (Definition EnumValueInfo, (OrderType, NullsOrder))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
      [ ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._asc) Description
"in ascending order, nulls last",
          (OrderType
Postgres.OTAsc, NullsOrder
Postgres.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._asc_nulls_first) Description
"in ascending order, nulls first",
          (OrderType
Postgres.OTAsc, NullsOrder
Postgres.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._asc_nulls_last) Description
"in ascending order, nulls last",
          (OrderType
Postgres.OTAsc, NullsOrder
Postgres.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._desc) Description
"in descending order, nulls first",
          (OrderType
Postgres.OTDesc, NullsOrder
Postgres.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._desc_nulls_first) Description
"in descending order, nulls first",
          (OrderType
Postgres.OTDesc, NullsOrder
Postgres.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall {origin}.
Name -> Description -> Definition origin EnumValueInfo
define (NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
Name._desc_nulls_last) Description
"in descending order, nulls last",
          (OrderType
Postgres.OTDesc, NullsOrder
Postgres.NullsLast)
        )
      ]
  where
    define :: Name -> Description -> Definition origin EnumValueInfo
define Name
name Description
desc = Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> EnumValueInfo
-> Definition origin EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
desc) Maybe origin
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo

comparisonExps ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  ColumnType ('Postgres pgKind) ->
  SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
comparisonExps :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
comparisonExps = Name
-> (ColumnType ('Postgres pgKind)
    -> SchemaT
         r
         m
         (Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]))
-> ColumnType ('Postgres pgKind)
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)])
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> (a -> m (p n b)) -> a -> m (p n b)
memoize 'comparisonExps \ColumnType ('Postgres pgKind)
columnType -> do
  SourceInfo ('Postgres pgKind)
sourceInfo :: SourceInfo ('Postgres pgKind) <- (r -> SourceInfo ('Postgres pgKind))
-> SchemaT r m (SourceInfo ('Postgres pgKind))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo ('Postgres pgKind)
forall a t. Has a t => t -> a
getter
  let customization :: ResolvedSourceCustomization
customization = SourceInfo ('Postgres pgKind) -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo ('Postgres pgKind)
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization

  -- see Note [Columns in comparison expression are never nullable]
  DangerouslyCollapseBooleans
collapseIfNull <- (SchemaOptions -> DangerouslyCollapseBooleans)
-> SchemaT r m DangerouslyCollapseBooleans
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> DangerouslyCollapseBooleans
Options.soDangerousBooleanCollapse

  -- parsers used for comparison arguments
  Parser
  'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
geogInputParser <- SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))))
geographyWithinDistanceInput
  Parser
  'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
geomInputParser <- SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))))
geometryWithinDistanceInput
  Parser
  'Input
  n
  (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
ignInputParser <- SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))))
intersectsGeomNbandInput
  Parser
  'Input
  n
  (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
ingInputParser <- SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))))
intersectsNbandGeomInput
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser ColumnType ('Postgres pgKind)
columnType (Bool -> Nullability
G.Nullability Bool
False)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
nullableTextParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText) (Bool -> Nullability
G.Nullability Bool
True)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
textParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText) (Bool -> Nullability
G.Nullability Bool
False)
  -- `lquery` represents a regular-expression-like pattern for matching `ltree` values.
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
lqueryParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGLquery) (Bool -> Nullability
G.Nullability Bool
False)
  -- `ltxtquery` represents a full-text-search-like pattern for matching `ltree` values.
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
ltxtqueryParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGLtxtquery) (Bool -> Nullability
G.Nullability Bool
False)
  Maybe
  (Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
maybeCastParser <- ColumnType ('Postgres pgKind)
-> NamingCase
-> SchemaT
     r
     m
     (Maybe
        (Parser
           'Input
           n
           (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
castExp ColumnType ('Postgres pgKind)
columnType NamingCase
tCase
  -- we need to give comparison exps for `thing[]` a different name to `thing`
  let nameSuffix :: Name
nameSuffix = case Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Type MetadataObjId 'Both
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> Type origin k
P.pType Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser of
        P.TList {} ->
          Name
Name.__array Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__comparison_exp
        Type MetadataObjId 'Both
_ -> Name
Name.__comparison_exp
  let name :: Name
name = NamingCase -> Name -> Name
applyTypeNameCaseCust NamingCase
tCase (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
nameSuffix
      desc :: Description
desc =
        Text -> Description
G.Description
          (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"Boolean expression to compare columns of type "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser
          Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". All fields are combined with logical 'AND'."
      textListParser :: Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
textListParser = (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ColumnValue ('Postgres pgKind))
-> [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
-> [ColumnValue ('Postgres pgKind)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ColumnValue ('Postgres pgKind)
forall a. ValueWithOrigin a -> a
IR.openValueOrigin ([ValueWithOrigin (ColumnValue ('Postgres pgKind))]
 -> [ColumnValue ('Postgres pgKind)])
-> Parser
     MetadataObjId
     'Both
     n
     [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser
     MetadataObjId
     'Both
     n
     [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
textParser
      columnListParser :: Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
columnListParser = (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ColumnValue ('Postgres pgKind))
-> [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
-> [ColumnValue ('Postgres pgKind)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ColumnValue ('Postgres pgKind)
forall a. ValueWithOrigin a -> a
IR.openValueOrigin ([ValueWithOrigin (ColumnValue ('Postgres pgKind))]
 -> [ColumnValue ('Postgres pgKind)])
-> Parser
     MetadataObjId
     'Both
     n
     [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser
     MetadataObjId
     'Both
     n
     [ValueWithOrigin (ColumnValue ('Postgres pgKind))]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser
  -- Naming conventions
  pure
    $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId n [ComparisonExp ('Postgres pgKind)]
-> Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
name (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
desc)
    (InputFieldsParser
   MetadataObjId n [ComparisonExp ('Postgres pgKind)]
 -> Parser
      MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId n [ComparisonExp ('Postgres pgKind)]
-> Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$ ([Maybe (ComparisonExp ('Postgres pgKind))]
 -> [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))]
-> InputFieldsParser
     MetadataObjId n [ComparisonExp ('Postgres pgKind)]
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (ComparisonExp ('Postgres pgKind))]
-> [ComparisonExp ('Postgres pgKind)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
    (InputFieldsParser
   MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))]
 -> InputFieldsParser
      MetadataObjId n [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))]
-> InputFieldsParser
     MetadataObjId n [ComparisonExp ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$ [InputFieldsParser
   MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
    ([InputFieldsParser
    MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
 -> InputFieldsParser
      MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))])
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp ('Postgres pgKind))]
forall a b. (a -> b) -> a -> b
$ [[InputFieldsParser
    MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ ((Parser
    MetadataObjId
    'Input
    n
    (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
  -> [InputFieldsParser
        MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
 -> Maybe
      (Parser
         MetadataObjId
         'Input
         n
         (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
 -> [InputFieldsParser
       MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
-> Maybe
     (Parser
        MetadataObjId
        'Input
        n
        (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
-> (Parser
      MetadataObjId
      'Input
      n
      (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
    -> [InputFieldsParser
          MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([InputFieldsParser
   MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> (Parser
      MetadataObjId
      'Input
      n
      (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
    -> [InputFieldsParser
          MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
-> Maybe
     (Parser
        MetadataObjId
        'Input
        n
        (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []) Maybe
  (Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
maybeCastParser ((Parser
    MetadataObjId
    'Input
    n
    (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
  -> [InputFieldsParser
        MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
 -> [InputFieldsParser
       MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
-> (Parser
      MetadataObjId
      'Input
      n
      (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
    -> [InputFieldsParser
          MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))])
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. (a -> b) -> a -> b
$ \Parser
  MetadataObjId
  'Input
  n
  (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
castParser ->
          [ Name
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
Name.__cast Maybe Description
forall a. Maybe a
Nothing (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
CastExp backend field -> OpExpG backend field
ACast (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  MetadataObjId
  'Input
  n
  (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
castParser)
          ],
        -- Common ops for all types
        NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall (n :: * -> *) (k :: Kind) (b :: BackendType).
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> Parser k n (UnpreparedValue b)
-> Parser k n (UnpreparedValue b)
-> [InputFieldsParser n (Maybe (OpExpG b (UnpreparedValue b)))]
equalityOperators
          NamingCase
tCase
          DangerouslyCollapseBooleans
collapseIfNull
          (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser)
          (ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListParameter ColumnType ('Postgres pgKind)
columnType ([ColumnValue ('Postgres pgKind)]
 -> UnpreparedValue ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
columnListParser),
        -- Comparison ops for non Raster types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
/= PGScalarType
PGRaster) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall (n :: * -> *) (k :: Kind) (b :: BackendType).
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> Parser k n (UnpreparedValue b)
-> [InputFieldsParser n (Maybe (OpExpG b (UnpreparedValue b)))]
comparisonOperators
            NamingCase
tCase
            DangerouslyCollapseBooleans
collapseIfNull
            (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
        -- Ops for Raster types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGRaster) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "intersects", "rast"]))
                 Maybe Description
forall a. Maybe a
Nothing
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTIntersectsRast (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "intersects", "nband", "geom"]))
                 Maybe Description
forall a. Maybe a
Nothing
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. STIntersectsNbandGeommin a -> BooleanOperators a
ASTIntersectsNbandGeom (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Input
  n
  (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
ingInputParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "intersects", "geom", "nband"]))
                 Maybe Description
forall a. Maybe a
Nothing
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. STIntersectsGeomminNband a -> BooleanOperators a
ASTIntersectsGeomNband (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Input
  n
  (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
ignInputParser)
             ],
        -- Ops for String like types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
isStringType ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__like)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given pattern")
                 (UnpreparedValue ('Postgres pgKind)
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALIKE (UnpreparedValue ('Postgres pgKind)
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__nlike)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given pattern")
                 (UnpreparedValue ('Postgres pgKind)
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANLIKE (UnpreparedValue ('Postgres pgKind)
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__ilike)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given case-insensitive pattern")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AILIKE (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__nilike)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given case-insensitive pattern")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ANILIKE (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__similar)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given SQL regular expression")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASIMILAR (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__nsimilar)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given SQL regular expression")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ANSIMILAR (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__regex)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given POSIX regular expression, case sensitive")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AREGEX (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__iregex)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column match the given POSIX regular expression, case insensitive")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AIREGEX (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__nregex)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given POSIX regular expression, case sensitive")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ANREGEX (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__niregex)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column NOT match the given POSIX regular expression, case insensitive")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ANIREGEX (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser)
             ],
        -- Ops for array types
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (\case PGArray PGScalarType
_ -> Bool
True; ScalarType ('Postgres pgKind)
_ -> Bool
False) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__contains)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the array contain the given value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AContains (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_contained", "in"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the array contained in the given array value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AContainedIn (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser)
             ],
        -- Ops for JSONB type
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__contains)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column contain the given json value at the top level")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AContains (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_contained", "in"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column contained in the given json value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AContainedIn (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_has", "key"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the string exist as a top-level key in the column")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AHasKey (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
nullableTextParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_has", "keys", "any"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"do any of these strings exist as top-level keys in the column")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> ([ColumnValue ('Postgres pgKind)]
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> [ColumnValue ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AHasKeysAny (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ([ColumnValue ('Postgres pgKind)]
    -> UnpreparedValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText) ([ColumnValue ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
textListParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_has", "keys", "all"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"do all of these strings exist as top-level keys in the column")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> ([ColumnValue ('Postgres pgKind)]
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> [ColumnValue ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AHasKeysAll (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ([ColumnValue ('Postgres pgKind)]
    -> UnpreparedValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText) ([ColumnValue ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
textListParser)
             ],
        -- Ops for Geography type
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGGeography) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "intersects"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column spatially intersect the given geography value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTIntersects (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "d", "within"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column within a given distance from the given geography value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> DWithinGeogOp (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWithinGeogOp (UnpreparedValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. DWithinGeogOp a -> BooleanOperators a
ASTDWithinGeog (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
geogInputParser)
             ],
        -- Ops for Geometry type
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGGeometry) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "contains"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column contain the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTContains (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "crosses"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column cross the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTCrosses (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "equals"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column equal to given geometry value (directionality is ignored)")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTEquals (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "overlaps"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column 'spatially overlap' (intersect but not completely contain) the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTOverlaps (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "touches"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column have atleast one point in common with the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTTouches (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "within"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column contained in the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTWithin (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "intersects"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column spatially intersect the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ASTIntersects (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "3d", "intersects"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does the column spatially intersect the given geometry value in 3D")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AST3DIntersects (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "d", "within"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column within a given distance from the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. DWithinGeomOp a -> BooleanOperators a
ASTDWithinGeom (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
geomInputParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_st", "3d", "d", "within"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the column within a given 3D distance from the given geometry value")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. DWithinGeomOp a -> BooleanOperators a
AST3DDWithinGeom (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> Parser MetadataObjId 'Input n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
geomInputParser)
             ],
        -- Ops for Ltree type
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGLtree) ColumnType ('Postgres pgKind)
columnType)
          [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))]
forall a b. [a] -> [b] -> [b]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__ancestor)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the left argument an ancestor of right (or equal)?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AAncestor (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_ancestor", "any"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does array contain an ancestor of `ltree`?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> ([ColumnValue ('Postgres pgKind)]
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> [ColumnValue ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AAncestorAny (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ([ColumnValue ('Postgres pgKind)]
    -> UnpreparedValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral ColumnType ('Postgres pgKind)
columnType ([ColumnValue ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
columnListParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__descendant)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"is the left argument a descendant of right (or equal)?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ADescendant (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
typedParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_descendant", "any"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does array contain a descendant of `ltree`?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> ([ColumnValue ('Postgres pgKind)]
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> [ColumnValue ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
ADescendantAny (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ([ColumnValue ('Postgres pgKind)]
    -> UnpreparedValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral ColumnType ('Postgres pgKind)
columnType ([ColumnValue ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
columnListParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 (Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name.__matches)
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does `ltree` match `lquery`?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AMatches (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
lqueryParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_matches", "any"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does `ltree` match any `lquery` in array?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> ([ColumnValue ('Postgres pgKind)]
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> [ColumnValue ('Postgres pgKind)]
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AMatchesAny (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ([ColumnValue ('Postgres pgKind)]
    -> UnpreparedValue ('Postgres pgKind))
-> [ColumnValue ('Postgres pgKind)]
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGLquery) ([ColumnValue ('Postgres pgKind)]
 -> ComparisonExp ('Postgres pgKind))
-> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue ('Postgres pgKind)]
textListParser),
               NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp ('Postgres pgKind)))
forall (n :: * -> *) (k :: Kind) a.
(MonadParse n, 'Input <: k) =>
NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser k n a
-> InputFieldsParser n (Maybe a)
mkBoolOperator
                 NamingCase
tCase
                 DangerouslyCollapseBooleans
collapseIfNull
                 ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_matches", "fulltext"]))
                 (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"does `ltree` match `ltxtquery`?")
                 (BooleanOperators
  ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
BooleanOperators (UnpreparedValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> ComparisonExp ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue ('Postgres pgKind)
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall a. a -> BooleanOperators a
AMatchesFulltext (UnpreparedValue ('Postgres pgKind)
 -> BooleanOperators (UnpreparedValue ('Postgres pgKind)))
-> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
    -> UnpreparedValue ('Postgres pgKind))
-> ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> BooleanOperators (UnpreparedValue ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> ComparisonExp ('Postgres pgKind))
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Parser 'Both n (ComparisonExp ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
ltxtqueryParser)
             ]
      ]
  where
    mkListLiteral :: ColumnType ('Postgres pgKind) -> [ColumnValue ('Postgres pgKind)] -> IR.UnpreparedValue ('Postgres pgKind)
    mkListLiteral :: ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListLiteral ColumnType ('Postgres pgKind)
columnType [ColumnValue ('Postgres pgKind)]
columnValues =
      SQLExpression ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType). SQLExpression b -> UnpreparedValue b
IR.UVLiteral
        (SQLExpression ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind))
-> SQLExpression ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ SQLExp -> TypeAnn -> SQLExp
SETyAnn
          ([SQLExp] -> SQLExp
SEArray ([SQLExp] -> SQLExp) -> [SQLExp] -> SQLExp
forall a b. (a -> b) -> a -> b
$ PGScalarValue -> SQLExp
txtEncoder (PGScalarValue -> SQLExp)
-> (ColumnValue ('Postgres pgKind) -> PGScalarValue)
-> ColumnValue ('Postgres pgKind)
-> SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnValue ('Postgres pgKind) -> ScalarValue ('Postgres pgKind)
ColumnValue ('Postgres pgKind) -> PGScalarValue
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue (ColumnValue ('Postgres pgKind) -> SQLExp)
-> [ColumnValue ('Postgres pgKind)] -> [SQLExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnValue ('Postgres pgKind)]
columnValues)
          (CollectableType PGScalarType -> TypeAnn
mkTypeAnn (CollectableType PGScalarType -> TypeAnn)
-> CollectableType PGScalarType -> TypeAnn
forall a b. (a -> b) -> a -> b
$ PGScalarType -> CollectableType PGScalarType
forall a. a -> CollectableType a
CollectableTypeArray (PGScalarType -> CollectableType PGScalarType)
-> PGScalarType -> CollectableType PGScalarType
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres pgKind) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend ColumnType ('Postgres pgKind)
columnType)
    mkListParameter :: ColumnType ('Postgres pgKind) -> [ColumnValue ('Postgres pgKind)] -> IR.UnpreparedValue ('Postgres pgKind)
    mkListParameter :: ColumnType ('Postgres pgKind)
-> [ColumnValue ('Postgres pgKind)]
-> UnpreparedValue ('Postgres pgKind)
mkListParameter ColumnType ('Postgres pgKind)
columnType [ColumnValue ('Postgres pgKind)]
columnValues = do
      let scalarType :: PGScalarType
scalarType = ColumnType ('Postgres pgKind) -> PGScalarType
forall (pgKind :: PostgresKind).
ColumnType ('Postgres pgKind) -> PGScalarType
unsafePGColumnToBackend ColumnType ('Postgres pgKind)
columnType
      Provenance
-> ColumnValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
Provenance -> ColumnValue b -> UnpreparedValue b
IR.UVParameter Provenance
IR.FreshVar
        (ColumnValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind))
-> ColumnValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ ColumnType ('Postgres pgKind)
-> ScalarValue ('Postgres pgKind) -> ColumnValue ('Postgres pgKind)
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue
          (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ PGScalarType -> PGScalarType
Postgres.PGArray PGScalarType
scalarType)
          ([PGScalarValue] -> PGScalarValue
Postgres.PGValArray ([PGScalarValue] -> PGScalarValue)
-> [PGScalarValue] -> PGScalarValue
forall a b. (a -> b) -> a -> b
$ ColumnValue ('Postgres pgKind) -> ScalarValue ('Postgres pgKind)
ColumnValue ('Postgres pgKind) -> PGScalarValue
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue (ColumnValue ('Postgres pgKind) -> PGScalarValue)
-> [ColumnValue ('Postgres pgKind)] -> [PGScalarValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnValue ('Postgres pgKind)]
columnValues)

    castExp :: ColumnType ('Postgres pgKind) -> NamingCase -> SchemaT r m (Maybe (Parser 'Input n (CastExp ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind)))))
    castExp :: ColumnType ('Postgres pgKind)
-> NamingCase
-> SchemaT
     r
     m
     (Maybe
        (Parser
           'Input
           n
           (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
castExp ColumnType ('Postgres pgKind)
sourceType NamingCase
tCase = do
      let maybeScalars :: Maybe (PGScalarType, PGScalarType)
maybeScalars = case ColumnType ('Postgres pgKind)
sourceType of
            ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeography -> (PGScalarType, PGScalarType) -> Maybe (PGScalarType, PGScalarType)
forall a. a -> Maybe a
Just (PGScalarType
PGGeography, PGScalarType
PGGeometry)
            ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeometry -> (PGScalarType, PGScalarType) -> Maybe (PGScalarType, PGScalarType)
forall a. a -> Maybe a
Just (PGScalarType
PGGeometry, PGScalarType
PGGeography)
            ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGJSONB -> (PGScalarType, PGScalarType) -> Maybe (PGScalarType, PGScalarType)
forall a. a -> Maybe a
Just (PGScalarType
PGJSONB, PGScalarType
PGText)
            ColumnType ('Postgres pgKind)
_ -> Maybe (PGScalarType, PGScalarType)
forall a. Maybe a
Nothing

      Maybe (PGScalarType, PGScalarType)
-> ((PGScalarType, PGScalarType)
    -> SchemaT
         r
         m
         (Parser
            'Input
            n
            (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (Parser
           'Input
           n
           (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (PGScalarType, PGScalarType)
maybeScalars (((PGScalarType, PGScalarType)
  -> SchemaT
       r
       m
       (Parser
          'Input
          n
          (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
 -> SchemaT
      r
      m
      (Maybe
         (Parser
            'Input
            n
            (CastExp
               ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))))
-> ((PGScalarType, PGScalarType)
    -> SchemaT
         r
         m
         (Parser
            'Input
            n
            (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
-> SchemaT
     r
     m
     (Maybe
        (Parser
           'Input
           n
           (CastExp ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))))
forall a b. (a -> b) -> a -> b
$ \(PGScalarType
sourceScalar, PGScalarType
targetScalar) -> do
        GQLNameIdentifier
scalarTypeName <- Name -> GQLNameIdentifier
C.fromAutogeneratedName (Name -> GQLNameIdentifier)
-> SchemaT r m Name -> SchemaT r m GQLNameIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
sourceScalar
        Name
targetName <- PGScalarType -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => PGScalarType -> m Name
mkScalarTypeName PGScalarType
targetScalar
        Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]
targetOpExps <- ColumnType ('Postgres pgKind)
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)])
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> SchemaT r m (Parser 'Input n [ComparisonExp ('Postgres pgKind)])
comparisonExps (ColumnType ('Postgres pgKind)
 -> SchemaT
      r
      m
      (Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]))
-> ColumnType ('Postgres pgKind)
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)])
forall a b. (a -> b) -> a -> b
$ ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
targetScalar
        let field :: InputFieldsParser
  MetadataObjId
  n
  (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
field = Name
-> Maybe Description
-> Parser
     MetadataObjId
     'Input
     n
     (PGScalarType, [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
targetName Maybe Description
forall a. Maybe a
Nothing (Parser
   MetadataObjId
   'Input
   n
   (PGScalarType, [ComparisonExp ('Postgres pgKind)])
 -> InputFieldsParser
      MetadataObjId
      n
      (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)])))
-> Parser
     MetadataObjId
     'Input
     n
     (PGScalarType, [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
forall a b. (a -> b) -> a -> b
$ (PGScalarType
targetScalar,) ([ComparisonExp ('Postgres pgKind)]
 -> (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
-> Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]
-> Parser
     MetadataObjId
     'Input
     n
     (PGScalarType, [ComparisonExp ('Postgres pgKind)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Input n [ComparisonExp ('Postgres pgKind)]
targetOpExps
            sourceName :: Name
sourceName = NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier
scalarTypeName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["cast", "exp"])))
        Parser
  MetadataObjId
  'Input
  n
  (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Input
        n
        (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser
   MetadataObjId
   'Input
   n
   (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
 -> SchemaT
      r
      m
      (Parser
         MetadataObjId
         'Input
         n
         (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])))
-> Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Input
        n
        (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
sourceName Maybe Description
forall a. Maybe a
Nothing (InputFieldsParser
   MetadataObjId
   n
   (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
 -> Parser
      MetadataObjId
      'Input
      n
      (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]))
-> InputFieldsParser
     MetadataObjId
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> Parser
     MetadataObjId
     'Input
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
forall a b. (a -> b) -> a -> b
$ [(PGScalarType, [ComparisonExp ('Postgres pgKind)])]
-> HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(PGScalarType, [ComparisonExp ('Postgres pgKind)])]
 -> HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)])
    -> [(PGScalarType, [ComparisonExp ('Postgres pgKind)])])
-> Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)])
-> HashMap PGScalarType [ComparisonExp ('Postgres pgKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)])
-> [(PGScalarType, [ComparisonExp ('Postgres pgKind)])]
forall a. Maybe a -> [a]
maybeToList (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)])
 -> HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
-> InputFieldsParser
     MetadataObjId
     n
     (HashMap PGScalarType [ComparisonExp ('Postgres pgKind)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldsParser
  MetadataObjId
  n
  (Maybe (PGScalarType, [ComparisonExp ('Postgres pgKind)]))
field

geographyWithinDistanceInput ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SchemaT r m (Parser 'Input n (DWithinGeogOp (IR.UnpreparedValue ('Postgres pgKind))))
geographyWithinDistanceInput :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))))
geographyWithinDistanceInput = do
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geographyParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeography) (Bool -> Nullability
G.Nullability Bool
False)
  -- FIXME
  -- It doesn't make sense for this value to be nullable; it only is for
  -- backwards compatibility; if an explicit Null value is given, it will be
  -- forwarded to the underlying SQL function, that in turns treat a null value
  -- as an error. We can fix this by rejecting explicit null values, by marking
  -- this field non-nullable in a future release.
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
booleanParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGBoolean) (Bool -> Nullability
G.Nullability Bool
True)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
floatParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGFloat) (Bool -> Nullability
G.Nullability Bool
False)
  pure
    $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
Name._st_d_within_geography_input Maybe Description
forall a. Maybe a
Nothing
    (InputFieldsParser
   MetadataObjId
   n
   (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
 -> Parser
      'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input n (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ UnpreparedValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
-> DWithinGeogOp (UnpreparedValue ('Postgres pgKind))
forall field. field -> field -> field -> DWithinGeogOp field
DWithinGeogOp
    (UnpreparedValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind)
 -> DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue ('Postgres pgKind)
      -> UnpreparedValue ('Postgres pgKind)
      -> DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._distance Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
floatParser)
    InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue ('Postgres pgKind)
   -> UnpreparedValue ('Postgres pgKind)
   -> DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue ('Postgres pgKind)
      -> DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._from Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geographyParser)
    InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue ('Postgres pgKind)
   -> DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeogOp (UnpreparedValue ('Postgres pgKind)))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Value Void
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Value Void
-> Parser origin k m a
-> InputFieldsParser origin m a
P.fieldWithDefault Name
Name._use_spheroid Maybe Description
forall a. Maybe a
Nothing (Bool -> Value Void
forall var. Bool -> Value var
G.VBoolean Bool
True) Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
booleanParser)

geometryWithinDistanceInput ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SchemaT r m (Parser 'Input n (DWithinGeomOp (IR.UnpreparedValue ('Postgres pgKind))))
geometryWithinDistanceInput :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))))
geometryWithinDistanceInput = do
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeometry) (Bool -> Nullability
G.Nullability Bool
False)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
floatParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGFloat) (Bool -> Nullability
G.Nullability Bool
False)
  pure
    $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
Name._st_d_within_input Maybe Description
forall a. Maybe a
Nothing
    (InputFieldsParser
   MetadataObjId
   n
   (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
 -> Parser
      'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input n (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ UnpreparedValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
-> DWithinGeomOp (UnpreparedValue ('Postgres pgKind))
forall field. field -> field -> DWithinGeomOp field
DWithinGeomOp
    (UnpreparedValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind)
 -> DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue ('Postgres pgKind)
      -> DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._distance Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
floatParser)
    InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue ('Postgres pgKind)
   -> DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (DWithinGeomOp (UnpreparedValue ('Postgres pgKind)))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._from Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser)

intersectsNbandGeomInput ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SchemaT r m (Parser 'Input n (STIntersectsNbandGeommin (IR.UnpreparedValue ('Postgres pgKind))))
intersectsNbandGeomInput :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))))
intersectsNbandGeomInput = do
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeometry) (Bool -> Nullability
G.Nullability Bool
False)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
integerParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGInteger) (Bool -> Nullability
G.Nullability Bool
False)
  pure
    $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
Name._st_intersects_nband_geom_input Maybe Description
forall a. Maybe a
Nothing
    (InputFieldsParser
   MetadataObjId
   n
   (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
 -> Parser
      'Input
      n
      (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ UnpreparedValue ('Postgres pgKind)
-> UnpreparedValue ('Postgres pgKind)
-> STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind))
forall field. field -> field -> STIntersectsNbandGeommin field
STIntersectsNbandGeommin
    (UnpreparedValue ('Postgres pgKind)
 -> UnpreparedValue ('Postgres pgKind)
 -> STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue ('Postgres pgKind)
      -> STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._nband Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
integerParser)
    InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue ('Postgres pgKind)
   -> STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsNbandGeommin (UnpreparedValue ('Postgres pgKind)))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._geommin Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser)

intersectsGeomNbandInput ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SchemaT r m (Parser 'Input n (STIntersectsGeomminNband (IR.UnpreparedValue ('Postgres pgKind))))
intersectsGeomNbandInput :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
SchemaT
  r
  m
  (Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))))
intersectsGeomNbandInput = do
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGGeometry) (Bool -> Nullability
G.Nullability Bool
False)
  Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
integerParser <- ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (pgKind :: PostgresKind) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema ('Postgres pgKind) r m n =>
ColumnType ('Postgres pgKind)
-> Nullability
-> SchemaT
     r
     m
     (Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
columnParser (ScalarType ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType ('Postgres pgKind)
PGScalarType
PGInteger) (Bool -> Nullability
G.Nullability Bool
False)
  pure
    $ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
Name._st_intersects_geom_nband_input Maybe Description
forall a. Maybe a
Nothing
    (InputFieldsParser
   MetadataObjId
   n
   (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
 -> Parser
      'Input
      n
      (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
-> Parser
     'Input
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ UnpreparedValue ('Postgres pgKind)
-> Maybe (UnpreparedValue ('Postgres pgKind))
-> STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind))
forall field.
field -> Maybe field -> STIntersectsGeomminNband field
STIntersectsGeomminNband
    (UnpreparedValue ('Postgres pgKind)
 -> Maybe (UnpreparedValue ('Postgres pgKind))
 -> STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (UnpreparedValue ('Postgres pgKind))
      -> STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (UnpreparedValue ('Postgres pgKind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._geommin Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
geometryParser)
    InputFieldsParser
  MetadataObjId
  n
  (Maybe (UnpreparedValue ('Postgres pgKind))
   -> STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId n (Maybe (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId
     n
     (STIntersectsGeomminNband (UnpreparedValue ('Postgres pgKind)))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ValueWithOrigin (ColumnValue ('Postgres pgKind))
 -> UnpreparedValue ('Postgres pgKind))
-> Maybe (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> Maybe (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue ('Postgres pgKind))
-> UnpreparedValue ('Postgres pgKind)
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (Maybe (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
 -> Maybe (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
-> InputFieldsParser
     MetadataObjId n (Maybe (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser
     'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (ValueWithOrigin (ColumnValue ('Postgres pgKind))))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
Name._nband Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue ('Postgres pgKind)))
integerParser)

countTypeInput ::
  (MonadParse n) =>
  Maybe (Parser 'Both n (Column ('Postgres pgKind), AnnRedactionExpUnpreparedValue ('Postgres pgKind))) ->
  InputFieldsParser n (IR.CountDistinct -> CountType ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind)))
countTypeInput :: forall (n :: * -> *) (pgKind :: PostgresKind).
MonadParse n =>
Maybe
  (Parser
     'Both
     n
     (Column ('Postgres pgKind),
      AnnRedactionExpUnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
countTypeInput = \case
  Just Parser
  'Both
  n
  (Column ('Postgres pgKind),
   AnnRedactionExpUnpreparedValue ('Postgres pgKind))
columnEnum -> do
    Maybe [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
columns <- Name
-> Maybe Description
-> Parser
     MetadataObjId
     'Both
     n
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe
        [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))])
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
Name._columns Maybe Description
forall a. Maybe a
Nothing (Parser
  MetadataObjId
  'Both
  n
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> Parser
     MetadataObjId
     'Both
     n
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list Parser
  'Both
  n
  (Column ('Postgres pgKind),
   AnnRedactionExpUnpreparedValue ('Postgres pgKind))
Parser
  MetadataObjId
  'Both
  n
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
columnEnum)
    pure $ (CountDistinct
 -> Maybe
      [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
 -> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind)))
-> Maybe
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountDistinct
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct
-> Maybe
     [(Column ('Postgres pgKind),
       AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
CountDistinct
-> Maybe
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind).
CountDistinct
-> Maybe
     [(Column ('Postgres pgKind),
       AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
mkCountType Maybe [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
columns
  Maybe
  (Parser
     'Both
     n
     (Column ('Postgres pgKind),
      AnnRedactionExpUnpreparedValue ('Postgres pgKind)))
Nothing -> (CountDistinct
 -> CountType
      ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CountDistinct
  -> CountType
       ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
 -> InputFieldsParser
      n
      (CountDistinct
       -> CountType
            ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))))
-> (CountDistinct
    -> CountType
         ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
-> InputFieldsParser
     n
     (CountDistinct
      -> CountType
           ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ (CountDistinct
 -> Maybe
      [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
 -> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind)))
-> Maybe
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountDistinct
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct
-> Maybe
     [(Column ('Postgres pgKind),
       AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
CountDistinct
-> Maybe
     [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind).
CountDistinct
-> Maybe
     [(Column ('Postgres pgKind),
       AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
mkCountType Maybe [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
forall a. Maybe a
Nothing
  where
    mkCountType :: IR.CountDistinct -> Maybe [(Column ('Postgres pgKind), AnnRedactionExpUnpreparedValue ('Postgres pgKind))] -> CountType ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind))
    mkCountType :: forall (pgKind :: PostgresKind).
CountDistinct
-> Maybe
     [(Column ('Postgres pgKind),
       AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     ('Postgres pgKind) (UnpreparedValue ('Postgres pgKind))
mkCountType CountDistinct
_ Maybe
  [(Column ('Postgres pgKind),
    AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
Nothing = CountType
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
CountType (PGCol, AnnRedactionExp ('Postgres pgKind) v)
-> CountAggregate pgKind v
CountAggregate CountType
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
forall columnType. CountType columnType
Postgres.CTStar
    mkCountType CountDistinct
IR.SelectCountDistinct (Just [(Column ('Postgres pgKind),
  AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
cols) = CountType
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
CountType (PGCol, AnnRedactionExp ('Postgres pgKind) v)
-> CountAggregate pgKind v
CountAggregate (CountType
   (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
 -> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind)))
-> CountType
     (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
forall columnType. [columnType] -> CountType columnType
Postgres.CTDistinct [(Column ('Postgres pgKind),
  AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
[(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
cols
    mkCountType CountDistinct
IR.SelectCountNonDistinct (Just [(Column ('Postgres pgKind),
  AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
cols) = CountType
  (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) v.
CountType (PGCol, AnnRedactionExp ('Postgres pgKind) v)
-> CountAggregate pgKind v
CountAggregate (CountType
   (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
 -> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind)))
-> CountType
     (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
-> CountAggregate pgKind (UnpreparedValue ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ [(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
-> CountType
     (PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))
forall columnType. [columnType] -> CountType columnType
Postgres.CTSimple [(Column ('Postgres pgKind),
  AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
[(PGCol, AnnRedactionExpUnpreparedValue ('Postgres pgKind))]
cols

-- | Update operator that prepends a value to a column containing jsonb arrays.
--
-- Note: Currently this is Postgres specific because json columns have not been ported
-- to other backends yet.
prependOp ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SU.UpdateOperator ('Postgres pgKind) r m n (IR.UnpreparedValue ('Postgres pgKind))
prependOp :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
prependOp = SU.UpdateOperator {GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
..}
  where
    updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn = (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) (ColumnType ('Postgres pgKind) -> Bool)
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ColumnInfo ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

    updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorParser GQLNameIdentifier
tableGQLName QualifiedTable
_tableName NonEmpty (ColumnInfo ('Postgres pgKind))
columns = do
      let typedParser :: ColumnInfo b
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
typedParser ColumnInfo b
columnInfo =
            (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both n (UnpreparedValue b)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter
              (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both n (UnpreparedValue b))
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
BS.columnParser
                (ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo)
                (Bool -> Nullability
G.Nullability (Bool -> Nullability) -> Bool -> Nullability
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Bool
forall (b :: BackendType). ColumnInfo b -> Bool
ciIsNullable ColumnInfo b
columnInfo)

          desc :: Description
desc = Description
"prepend existing jsonb value of filtered columns with new jsonb value"

      GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo ('Postgres pgKind)
    -> SchemaT
         r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind))))
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> Description
-> Description
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
forall (n :: * -> *) r (m :: * -> *) (b :: BackendType) a.
MonadBuildSchema b r m n =>
GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo b -> SchemaT r m (Parser 'Both n a))
-> NonEmpty (ColumnInfo b)
-> Description
-> Description
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) a))
SU.updateOperator
        GQLNameIdentifier
tableGQLName
        (Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "prepend"))
        (Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "_prepend"))
        ColumnInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind)))
forall {b :: BackendType} {m :: * -> *} {n :: * -> *} {r}.
(BackendSchema b, MonadError QErr m, MonadMemoize m, MonadParse n,
 Has (SourceInfo b) r, Has SchemaContext r, Has SchemaOptions r) =>
ColumnInfo b
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
typedParser
        NonEmpty (ColumnInfo ('Postgres pgKind))
columns
        Description
desc
        Description
desc

-- | Update operator that appends a value to a column containing jsonb arrays.
--
-- Note: Currently this is Postgres specific because json columns have not been ported
-- to other backends yet.
appendOp ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SU.UpdateOperator ('Postgres pgKind) r m n (IR.UnpreparedValue ('Postgres pgKind))
appendOp :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
appendOp = SU.UpdateOperator {GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
..}
  where
    updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn = (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) (ColumnType ('Postgres pgKind) -> Bool)
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ColumnInfo ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

    updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorParser GQLNameIdentifier
tableGQLName QualifiedTable
_tableName NonEmpty (ColumnInfo ('Postgres pgKind))
columns = do
      let typedParser :: ColumnInfo b
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
typedParser ColumnInfo b
columnInfo =
            (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both n (UnpreparedValue b)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter
              (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both n (UnpreparedValue b))
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
BS.columnParser
                (ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo)
                (Bool -> Nullability
G.Nullability (Bool -> Nullability) -> Bool -> Nullability
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Bool
forall (b :: BackendType). ColumnInfo b -> Bool
ciIsNullable ColumnInfo b
columnInfo)

          desc :: Description
desc = Description
"append existing jsonb value of filtered columns with new jsonb value"
      GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo ('Postgres pgKind)
    -> SchemaT
         r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind))))
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> Description
-> Description
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
forall (n :: * -> *) r (m :: * -> *) (b :: BackendType) a.
MonadBuildSchema b r m n =>
GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo b -> SchemaT r m (Parser 'Both n a))
-> NonEmpty (ColumnInfo b)
-> Description
-> Description
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) a))
SU.updateOperator
        GQLNameIdentifier
tableGQLName
        (Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "append"))
        (Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "_append"))
        ColumnInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind)))
forall {b :: BackendType} {m :: * -> *} {n :: * -> *} {r}.
(BackendSchema b, MonadError QErr m, MonadMemoize m, MonadParse n,
 Has (SourceInfo b) r, Has SchemaContext r, Has SchemaOptions r) =>
ColumnInfo b
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
typedParser
        NonEmpty (ColumnInfo ('Postgres pgKind))
columns
        Description
desc
        Description
desc

-- | Update operator that deletes a value at a specified key from a column
-- containing jsonb objects.
--
-- Note: Currently this is Postgres specific because json columns have not been ported
-- to other backends yet.
deleteKeyOp ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SU.UpdateOperator ('Postgres pgKind) r m n (IR.UnpreparedValue ('Postgres pgKind))
deleteKeyOp :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
deleteKeyOp = SU.UpdateOperator {GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
..}
  where
    updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn = (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) (ColumnType ('Postgres pgKind) -> Bool)
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ColumnInfo ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

    updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorParser GQLNameIdentifier
tableGQLName QualifiedTable
_tableName NonEmpty (ColumnInfo ('Postgres pgKind))
columns = do
      let nullableTextParser :: p -> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
nullableTextParser p
_ = (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both n (UnpreparedValue b)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both n (UnpreparedValue b))
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
BS.columnParser (ScalarType b -> ColumnType b
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType b
PGScalarType
PGText) (Bool -> Nullability
G.Nullability Bool
True)
          desc :: Description
desc = Description
"delete key/value pair or string element. key/value pairs are matched based on their key value"

      GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo ('Postgres pgKind)
    -> SchemaT
         r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind))))
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> Description
-> Description
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
forall (n :: * -> *) r (m :: * -> *) (b :: BackendType) a.
MonadBuildSchema b r m n =>
GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo b -> SchemaT r m (Parser 'Both n a))
-> NonEmpty (ColumnInfo b)
-> Description
-> Description
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) a))
SU.updateOperator
        GQLNameIdentifier
tableGQLName
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["delete", "key"]))
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_delete", "key"]))
        ColumnInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind)))
forall {b :: BackendType} {m :: * -> *} {n :: * -> *} {r} {p}.
(ScalarType b ~ PGScalarType, BackendSchema b, MonadError QErr m,
 MonadMemoize m, MonadParse n, Has (SourceInfo b) r,
 Has SchemaContext r, Has SchemaOptions r) =>
p -> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
nullableTextParser
        NonEmpty (ColumnInfo ('Postgres pgKind))
columns
        Description
desc
        Description
desc

-- | Update operator that deletes a value at a specific index from a column
-- containing jsonb arrays.
--
-- Note: Currently this is Postgres specific because json columns have not been ported
-- to other backends yet.
deleteElemOp ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SU.UpdateOperator ('Postgres pgKind) r m n (IR.UnpreparedValue ('Postgres pgKind))
deleteElemOp :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
deleteElemOp = SU.UpdateOperator {GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
..}
  where
    updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn = (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) (ColumnType ('Postgres pgKind) -> Bool)
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ColumnInfo ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

    updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
updateOperatorParser GQLNameIdentifier
tableGQLName QualifiedTable
_tableName NonEmpty (ColumnInfo ('Postgres pgKind))
columns = do
      let nonNullableIntParser :: p -> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
nonNullableIntParser p
_ = (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both n (UnpreparedValue b)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both n (UnpreparedValue b))
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
-> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
BS.columnParser (ScalarType b -> ColumnType b
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType b
PGScalarType
PGInteger) (Bool -> Nullability
G.Nullability Bool
False)
          desc :: Description
desc =
            Description
"delete the array element with specified index (negative integers count from the end). "
              Description -> Description -> Description
forall a. Semigroup a => a -> a -> a
<> Description
"throws an error if top level container is not an array"

      GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo ('Postgres pgKind)
    -> SchemaT
         r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind))))
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> Description
-> Description
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))))
forall (n :: * -> *) r (m :: * -> *) (b :: BackendType) a.
MonadBuildSchema b r m n =>
GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo b -> SchemaT r m (Parser 'Both n a))
-> NonEmpty (ColumnInfo b)
-> Description
-> Description
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) a))
SU.updateOperator
        GQLNameIdentifier
tableGQLName
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["delete", "elem"]))
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_delete", "elem"]))
        ColumnInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n (UnpreparedValue ('Postgres pgKind)))
forall {b :: BackendType} {m :: * -> *} {n :: * -> *} {r} {p}.
(ScalarType b ~ PGScalarType, BackendSchema b, MonadError QErr m,
 MonadMemoize m, MonadParse n, Has (SourceInfo b) r,
 Has SchemaContext r, Has SchemaOptions r) =>
p -> SchemaT r m (Parser MetadataObjId 'Both n (UnpreparedValue b))
nonNullableIntParser
        NonEmpty (ColumnInfo ('Postgres pgKind))
columns
        Description
desc
        Description
desc

-- | Update operator that deletes a field at a certan path from a column
-- containing jsonb objects.
--
-- Note: Currently this is Postgres specific because json columns have not been ported
-- to other backends yet.
deleteAtPathOp ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  SU.UpdateOperator ('Postgres pgKind) r m n [IR.UnpreparedValue ('Postgres pgKind)]
deleteAtPathOp :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n [UnpreparedValue ('Postgres pgKind)]
deleteAtPathOp = SU.UpdateOperator {GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> TableName ('Postgres pgKind)
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
..}
  where
    updateOperatorApplicableColumn :: ColumnInfo ('Postgres pgKind) -> Bool
updateOperatorApplicableColumn = (ScalarType ('Postgres pgKind) -> Bool)
-> ColumnType ('Postgres pgKind) -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSONB) (ColumnType ('Postgres pgKind) -> Bool)
-> (ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind))
-> ColumnInfo ('Postgres pgKind)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo ('Postgres pgKind) -> ColumnType ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType

    updateOperatorParser :: GQLNameIdentifier
-> QualifiedTable
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
updateOperatorParser GQLNameIdentifier
tableGQLName QualifiedTable
_tableName NonEmpty (ColumnInfo ('Postgres pgKind))
columns = do
      let nonNullableTextListParser :: p -> SchemaT r m (Parser MetadataObjId 'Both m [UnpreparedValue b])
nonNullableTextListParser p
_ = Parser MetadataObjId 'Both m (UnpreparedValue b)
-> Parser MetadataObjId 'Both m [UnpreparedValue b]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list (Parser MetadataObjId 'Both m (UnpreparedValue b)
 -> Parser MetadataObjId 'Both m [UnpreparedValue b])
-> (Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b))
    -> Parser MetadataObjId 'Both m (UnpreparedValue b))
-> Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both m [UnpreparedValue b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both m (UnpreparedValue b)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both m a -> Parser MetadataObjId 'Both m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both m [UnpreparedValue b])
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b)))
-> SchemaT r m (Parser MetadataObjId 'Both m [UnpreparedValue b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> SchemaT
     r
     m
     (Parser MetadataObjId 'Both m (ValueWithOrigin (ColumnValue b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendSchema b, MonadBuildSchema b r m n) =>
ColumnType b
-> Nullability
-> SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
BS.columnParser (ScalarType b -> ColumnType b
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType b
PGScalarType
PGText) (Bool -> Nullability
G.Nullability Bool
False)
          desc :: Description
desc = Description
"delete the field or element with specified path (for JSON arrays, negative integers count from the end)"

      GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo ('Postgres pgKind)
    -> SchemaT
         r m (Parser 'Both n [UnpreparedValue ('Postgres pgKind)]))
-> NonEmpty (ColumnInfo ('Postgres pgKind))
-> Description
-> Description
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind)) [UnpreparedValue ('Postgres pgKind)]))
forall (n :: * -> *) r (m :: * -> *) (b :: BackendType) a.
MonadBuildSchema b r m n =>
GQLNameIdentifier
-> GQLNameIdentifier
-> GQLNameIdentifier
-> (ColumnInfo b -> SchemaT r m (Parser 'Both n a))
-> NonEmpty (ColumnInfo b)
-> Description
-> Description
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) a))
SU.updateOperator
        GQLNameIdentifier
tableGQLName
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["delete", "at", "path"]))
        ((Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["_delete", "at", "path"]))
        ColumnInfo ('Postgres pgKind)
-> SchemaT
     r m (Parser 'Both n [UnpreparedValue ('Postgres pgKind)])
forall {b :: BackendType} {m :: * -> *} {m :: * -> *} {r} {p}.
(ScalarType b ~ PGScalarType, MonadParse m, BackendSchema b,
 MonadError QErr m, MonadMemoize m, Has (SourceInfo b) r,
 Has SchemaContext r, Has SchemaOptions r) =>
p -> SchemaT r m (Parser MetadataObjId 'Both m [UnpreparedValue b])
nonNullableTextListParser
        NonEmpty (ColumnInfo ('Postgres pgKind))
columns
        Description
desc
        Description
desc

-- | The update operators that we support on Postgres.
pgkParseUpdateOperators ::
  forall pgKind m n r.
  (MonadBuildSchema ('Postgres pgKind) r m n) =>
  TableInfo ('Postgres pgKind) ->
  UpdPermInfo ('Postgres pgKind) ->
  SchemaT r m (InputFieldsParser n (HashMap (Column ('Postgres pgKind)) (UpdateOpExpression (IR.UnpreparedValue ('Postgres pgKind)))))
pgkParseUpdateOperators :: forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
TableInfo ('Postgres pgKind)
-> UpdPermInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))))
pgkParseUpdateOperators TableInfo ('Postgres pgKind)
tableInfo UpdPermInfo ('Postgres pgKind)
updatePermissions = do
  HashMap
  (Column ('Postgres pgKind))
  (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> [UpdateOperator
      ('Postgres pgKind)
      r
      m
      n
      (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))]
-> TableInfo ('Postgres pgKind)
-> SchemaT
     r
     m
     (InputFieldsParser
        n
        (HashMap
           (Column ('Postgres pgKind))
           (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *) op.
MonadBuildSchema b r m n =>
HashMap (Column b) op
-> [UpdateOperator b r m n op]
-> TableInfo b
-> SchemaT r m (InputFieldsParser n (HashMap (Column b) op))
SU.buildUpdateOperators
    (UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateSet (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> HashMap PGCol (UnpreparedValue ('Postgres pgKind))
-> HashMap
     PGCol (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdPermInfo ('Postgres pgKind)
-> HashMap
     (Column ('Postgres pgKind)) (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType).
UpdPermInfo b -> HashMap (Column b) (UnpreparedValue b)
SU.presetColumns UpdPermInfo ('Postgres pgKind)
updatePermissions)
    [ UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateSet (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) (n :: * -> *) r (m :: * -> *).
MonadBuildSchema b r m n =>
UpdateOperator b r m n (UnpreparedValue b)
SU.setOp,
      UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateInc (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (b :: BackendType) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema b r m n =>
UpdateOperator b r m n (UnpreparedValue b)
SU.incOp,
      UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdatePrepend (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
prependOp,
      UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateAppend (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
appendOp,
      UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateDeleteKey (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
deleteKeyOp,
      UnpreparedValue ('Postgres pgKind)
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. v -> UpdateOpExpression v
PGIR.UpdateDeleteElem (UnpreparedValue ('Postgres pgKind)
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n (UnpreparedValue ('Postgres pgKind))
deleteElemOp,
      [UnpreparedValue ('Postgres pgKind)]
-> UpdateOpExpression (UnpreparedValue ('Postgres pgKind))
forall v. [v] -> UpdateOpExpression v
PGIR.UpdateDeleteAtPath ([UnpreparedValue ('Postgres pgKind)]
 -> UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
-> UpdateOperator
     ('Postgres pgKind) r m n [UnpreparedValue ('Postgres pgKind)]
-> UpdateOperator
     ('Postgres pgKind)
     r
     m
     n
     (UpdateOpExpression (UnpreparedValue ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UpdateOperator
  ('Postgres pgKind) r m n [UnpreparedValue ('Postgres pgKind)]
forall (pgKind :: PostgresKind) (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema ('Postgres pgKind) r m n =>
UpdateOperator
  ('Postgres pgKind) r m n [UnpreparedValue ('Postgres pgKind)]
deleteAtPathOp
    ]
    TableInfo ('Postgres pgKind)
tableInfo