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

module Hasura.Backends.BigQuery.Instances.Schema () where

import Data.Aeson qualified as J
import Data.Has
import Data.HashMap.Strict qualified as Map
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Hasura.Backends.BigQuery.Name
import Hasura.Backends.BigQuery.Types qualified as BigQuery
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (toErrorMessage)
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp
import Hasura.GraphQL.Schema.Build qualified as GSB
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.NamingCase
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Parser
  ( FieldParser,
    InputFieldsParser,
    Kind (..),
    MonadMemoize,
    MonadParse,
    Parser,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.GraphQL.Schema.Typename
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Source (SourceInfo)
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G

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

instance BackendSchema 'BigQuery where
  -- top level parsers
  buildTableQueryAndSubscriptionFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m ([FieldParser
         n
         (QueryDB
            'BigQuery
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'BigQuery))],
      [FieldParser
         n
         (QueryDB
            'BigQuery
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'BigQuery))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
buildTableQueryAndSubscriptionFields = MkRootFieldName
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m ([FieldParser
         n
         (QueryDB
            'BigQuery
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'BigQuery))],
      [FieldParser
         n
         (QueryDB
            'BigQuery
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue 'BigQuery))],
      Maybe (Name, Parser 'Output n (ApolloFederationParserFunction n)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> 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
  buildTableRelayQueryFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> NESeq (ColumnInfo 'BigQuery)
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildTableRelayQueryFields MkRootFieldName
_ SourceInfo 'BigQuery
_ TableName 'BigQuery
_ TableInfo 'BigQuery
_ GQLNameIdentifier
_ NESeq (ColumnInfo 'BigQuery)
_ = [FieldParser
   n
   (QueryDB
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildTableStreamingSubscriptionFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildTableStreamingSubscriptionFields = MkRootFieldName
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, AggregationPredicatesSchema b,
 BackendTableSelectSchema b) =>
MkRootFieldName
-> SourceInfo b
-> TableName b
-> TableInfo b
-> GQLNameIdentifier
-> m [FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
GSB.buildTableStreamingSubscriptionFields
  buildTableInsertMutationFields :: MkRootFieldName
-> Scenario
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnotatedInsert
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildTableInsertMutationFields MkRootFieldName
_ Scenario
_ SourceInfo 'BigQuery
_ TableName 'BigQuery
_ TableInfo 'BigQuery
_ GQLNameIdentifier
_ = [FieldParser
   n
   (AnnotatedInsert
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (AnnotatedInsert
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildTableUpdateMutationFields :: MkRootFieldName
-> Scenario
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnotatedUpdateG
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildTableUpdateMutationFields MkRootFieldName
_ Scenario
_ SourceInfo 'BigQuery
_ TableName 'BigQuery
_ TableInfo 'BigQuery
_ GQLNameIdentifier
_ = [FieldParser
   n
   (AnnotatedUpdateG
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (AnnotatedUpdateG
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildTableDeleteMutationFields :: MkRootFieldName
-> Scenario
-> SourceInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> GQLNameIdentifier
-> m [FieldParser
        n
        (AnnDelG
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildTableDeleteMutationFields MkRootFieldName
_ Scenario
_ SourceInfo 'BigQuery
_ TableName 'BigQuery
_ TableInfo 'BigQuery
_ GQLNameIdentifier
_ = [FieldParser
   n
   (AnnDelG
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (AnnDelG
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildFunctionQueryFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> FunctionName 'BigQuery
-> FunctionInfo 'BigQuery
-> TableName 'BigQuery
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildFunctionQueryFields MkRootFieldName
_ SourceInfo 'BigQuery
_ FunctionName 'BigQuery
_ FunctionInfo 'BigQuery
_ TableName 'BigQuery
_ = [FieldParser
   n
   (QueryDB
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildFunctionRelayQueryFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> FunctionName 'BigQuery
-> FunctionInfo 'BigQuery
-> TableName 'BigQuery
-> NESeq (ColumnInfo 'BigQuery)
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildFunctionRelayQueryFields MkRootFieldName
_ SourceInfo 'BigQuery
_ FunctionName 'BigQuery
_ FunctionInfo 'BigQuery
_ TableName 'BigQuery
_ NESeq (ColumnInfo 'BigQuery)
_ = [FieldParser
   n
   (QueryDB
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (QueryDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  buildFunctionMutationFields :: MkRootFieldName
-> SourceInfo 'BigQuery
-> FunctionName 'BigQuery
-> FunctionInfo 'BigQuery
-> TableName 'BigQuery
-> m [FieldParser
        n
        (MutationDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
buildFunctionMutationFields MkRootFieldName
_ SourceInfo 'BigQuery
_ FunctionName 'BigQuery
_ FunctionInfo 'BigQuery
_ TableName 'BigQuery
_ = [FieldParser
   n
   (MutationDB
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))]
-> m [FieldParser
        n
        (MutationDB
           'BigQuery
           (RemoteRelationshipField UnpreparedValue)
           (UnpreparedValue 'BigQuery))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  -- backend extensions
  relayExtension :: Maybe (XRelay 'BigQuery)
relayExtension = Maybe (XRelay 'BigQuery)
forall a. Maybe a
Nothing
  nodesAggExtension :: Maybe (XNodesAgg 'BigQuery)
nodesAggExtension = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  streamSubscriptionExtension :: Maybe (XStreamingSubscription 'BigQuery)
streamSubscriptionExtension = Maybe (XStreamingSubscription 'BigQuery)
forall a. Maybe a
Nothing

  -- individual components
  columnParser :: ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
columnParser = ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (n :: * -> *) (m :: * -> *) r.
(MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
bqColumnParser
  scalarSelectionArgumentsParser :: ColumnType 'BigQuery
-> InputFieldsParser n (Maybe (ScalarSelectionArguments 'BigQuery))
scalarSelectionArgumentsParser ColumnType 'BigQuery
_ = Maybe Void -> InputFieldsParser MetadataObjId n (Maybe Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Void
forall a. Maybe a
Nothing
  orderByOperators :: SourceInfo 'BigQuery
-> NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'BigQuery, NullsOrderType 'BigQuery)))
orderByOperators SourceInfo 'BigQuery
_sourceInfo = NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'BigQuery, NullsOrderType 'BigQuery)))
bqOrderByOperators
  comparisonExps :: ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
comparisonExps = ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
forall (m :: * -> *) (n :: * -> *) r.
MonadBuildSchema 'BigQuery r m n =>
ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
bqComparisonExps
  countTypeInput :: Maybe (Parser 'Both n (Column 'BigQuery))
-> InputFieldsParser n (CountDistinct -> CountType 'BigQuery)
countTypeInput = Maybe (Parser 'Both n (Column 'BigQuery))
-> InputFieldsParser n (CountDistinct -> CountType 'BigQuery)
forall (n :: * -> *).
MonadParse n =>
Maybe (Parser 'Both n (Column 'BigQuery))
-> InputFieldsParser n (CountDistinct -> CountType 'BigQuery)
bqCountTypeInput
  aggregateOrderByCountType :: ScalarType 'BigQuery
aggregateOrderByCountType = ScalarType 'BigQuery
ScalarType
BigQuery.IntegerScalarType
  computedField :: SourceInfo 'BigQuery
-> ComputedFieldInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
computedField = SourceInfo 'BigQuery
-> ComputedFieldInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema 'BigQuery r m n =>
SourceInfo 'BigQuery
-> ComputedFieldInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
bqComputedField

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

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

bqColumnParser ::
  (MonadParse n, MonadError QErr m, MonadReader r m, Has MkTypename r, Has NamingCase r) =>
  ColumnType 'BigQuery ->
  G.Nullability ->
  m (Parser 'Both n (IR.ValueWithOrigin (ColumnValue 'BigQuery)))
bqColumnParser :: ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
bqColumnParser ColumnType 'BigQuery
columnType (G.Nullability Bool
isNullable) =
  Parser 'Both n (ColumnValue 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin (Parser 'Both n (ColumnValue 'BigQuery)
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
-> (Parser MetadataObjId 'Both n Value
    -> Parser 'Both n (ColumnValue 'BigQuery))
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> ColumnValue 'BigQuery)
-> Parser MetadataObjId 'Both n Value
-> Parser 'Both n (ColumnValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnType 'BigQuery
-> ScalarValue 'BigQuery -> ColumnValue 'BigQuery
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType 'BigQuery
columnType) (Parser MetadataObjId 'Both n Value
 -> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
-> m (Parser MetadataObjId 'Both n Value)
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ColumnType 'BigQuery
columnType of
    ColumnScalar ScalarType 'BigQuery
scalarType -> case ScalarType 'BigQuery
scalarType of
      -- bytestrings
      -- we only accept string literals
      ScalarType 'BigQuery
BigQuery.BytesScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
BigQuery.StringValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *). MonadParse m => Name -> Parser 'Both m Text
stringBased Name
_Bytes
      -- text
      ScalarType 'BigQuery
BigQuery.StringScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
BigQuery.StringValue (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
      -- floating point values
      -- TODO: we do not perform size checks here, meaning we would accept an
      -- out-of-bounds value as long as it can be represented by a GraphQL float; this
      -- will in all likelihood error on the BigQuery side. Do we want to handle those
      -- properly here?
      ScalarType 'BigQuery
BigQuery.FloatScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Float64 -> Value
BigQuery.FloatValue (Float64 -> Value) -> (Double -> Float64) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float64
BigQuery.doubleToFloat64 (Double -> Value)
-> Parser MetadataObjId 'Both n Double
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Double
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Double
P.float
      ScalarType 'BigQuery
BigQuery.IntegerScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Value
BigQuery.IntegerValue (Int64 -> Value) -> (Int32 -> Int64) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
BigQuery.intToInt64 (Int64 -> Int64) -> (Int32 -> Int64) -> Int32 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Value)
-> Parser MetadataObjId 'Both n Int32
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.int
      ScalarType 'BigQuery
BigQuery.DecimalScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Decimal -> Value
BigQuery.DecimalValue (Decimal -> Value)
-> (Scientific -> Decimal) -> Scientific -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Decimal
BigQuery.Decimal (Text -> Decimal) -> (Scientific -> Text) -> Scientific -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Text
BigQuery.scientificToText (Scientific -> Value)
-> Parser MetadataObjId 'Both n Scientific
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Scientific
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Scientific
P.scientific
      ScalarType 'BigQuery
BigQuery.BigDecimalScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ BigDecimal -> Value
BigQuery.BigDecimalValue (BigDecimal -> Value)
-> (Scientific -> BigDecimal) -> Scientific -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BigDecimal
BigQuery.BigDecimal (Text -> BigDecimal)
-> (Scientific -> Text) -> Scientific -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Text
BigQuery.scientificToText (Scientific -> Value)
-> Parser MetadataObjId 'Both n Scientific
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Scientific
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Scientific
P.scientific
      -- boolean type
      ScalarType 'BigQuery
BigQuery.BoolScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BigQuery.BoolValue (Bool -> Value)
-> Parser MetadataObjId 'Both n Bool
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n Bool
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Bool
P.boolean
      ScalarType 'BigQuery
BigQuery.DateScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Date -> Value
BigQuery.DateValue (Date -> Value) -> (Text -> Date) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Date
BigQuery.Date (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *). MonadParse m => Name -> Parser 'Both m Text
stringBased Name
_Date
      ScalarType 'BigQuery
BigQuery.TimeScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Time -> Value
BigQuery.TimeValue (Time -> Value) -> (Text -> Time) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Time
BigQuery.Time (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *). MonadParse m => Name -> Parser 'Both m Text
stringBased Name
_Time
      ScalarType 'BigQuery
BigQuery.DatetimeScalarType -> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Datetime -> Value
BigQuery.DatetimeValue (Datetime -> Value) -> (Text -> Datetime) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Datetime
BigQuery.Datetime (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *). MonadParse m => Name -> Parser 'Both m Text
stringBased Name
_Datetime
      ScalarType 'BigQuery
BigQuery.GeographyScalarType ->
        Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Geography -> Value
BigQuery.GeographyValue (Geography -> Value) -> (Text -> Geography) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Geography
BigQuery.Geography (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *) a origin.
(MonadParse m, FromJSON a) =>
Name -> Parser origin 'Both m a
throughJSON Name
_Geography
      ScalarType 'BigQuery
BigQuery.TimestampScalarType ->
        Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Both n Value
 -> m (Parser MetadataObjId 'Both n Value))
-> Parser MetadataObjId 'Both n Value
-> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType 'BigQuery
ScalarType
scalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Timestamp -> Value
BigQuery.TimestampValue (Timestamp -> Value) -> (Text -> Timestamp) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Timestamp
BigQuery.Timestamp (Text -> Value)
-> Parser MetadataObjId 'Both n Text
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Parser MetadataObjId 'Both n Text
forall (m :: * -> *). MonadParse m => Name -> Parser 'Both m Text
stringBased Name
_Timestamp
      ScalarType 'BigQuery
ty -> QErr -> m (Parser MetadataObjId 'Both n Value)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m (Parser MetadataObjId 'Both n Value))
-> QErr -> m (Parser MetadataObjId 'Both n Value)
forall a b. (a -> b) -> a -> b
$ Text -> QErr
internalError (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Type currently unsupported for BigQuery: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScalarType -> String
forall a. Show a => a -> String
show ScalarType 'BigQuery
ScalarType
ty
    ColumnEnumReference enumRef :: EnumReference 'BigQuery
enumRef@(EnumReference TableName 'BigQuery
_ EnumValues
enumValues Maybe Name
_) ->
      case [(EnumValue, EnumValueInfo)]
-> Maybe (NonEmpty (EnumValue, EnumValueInfo))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (EnumValues -> [(EnumValue, EnumValueInfo)]
forall k v. HashMap k v -> [(k, v)]
Map.toList EnumValues
enumValues) of
        Just NonEmpty (EnumValue, EnumValueInfo)
enumValuesList -> do
          Name
enumName <- EnumReference 'BigQuery -> m Name
forall (b :: BackendType) (m :: * -> *) r.
(Backend b, MonadReader r m, Has MkTypename r, MonadError QErr m,
 Has NamingCase r) =>
EnumReference b -> m Name
mkEnumTypeName EnumReference 'BigQuery
enumRef
          pure $ ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType
BigQuery.StringScalarType (Parser MetadataObjId 'Both n Value
 -> Parser MetadataObjId 'Both n Value)
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty (Definition EnumValueInfo, Value)
-> Parser MetadataObjId 'Both n Value
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
enumName Maybe Description
forall a. Maybe a
Nothing ((EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue 'BigQuery)
(EnumValue, EnumValueInfo) -> (Definition EnumValueInfo, Value)
mkEnumValue ((EnumValue, EnumValueInfo) -> (Definition EnumValueInfo, Value))
-> NonEmpty (EnumValue, EnumValueInfo)
-> NonEmpty (Definition EnumValueInfo, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (EnumValue, EnumValueInfo)
enumValuesList)
        Maybe (NonEmpty (EnumValue, EnumValueInfo))
Nothing -> Code -> Text -> m (Parser MetadataObjId 'Both n Value)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"empty enum values"
  where
    possiblyNullable :: ScalarType
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
possiblyNullable ScalarType
_scalarType
      | Bool
isNullable = (Maybe Value -> Value)
-> Parser MetadataObjId 'Both n (Maybe Value)
-> Parser MetadataObjId 'Both n Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
BigQuery.NullValue) (Parser MetadataObjId 'Both n (Maybe Value)
 -> Parser MetadataObjId 'Both n Value)
-> (Parser MetadataObjId 'Both n Value
    -> Parser MetadataObjId 'Both n (Maybe Value))
-> Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Both n Value
-> Parser MetadataObjId 'Both n (Maybe Value)
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 'Both n Value
-> Parser MetadataObjId 'Both n Value
forall a. a -> a
id
    mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue 'BigQuery)
    mkEnumValue :: (EnumValue, EnumValueInfo)
-> (Definition EnumValueInfo, ScalarValue 'BigQuery)
mkEnumValue (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 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 -> Value
BigQuery.StringValue (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
value
      )
    throughJSON :: Name -> Parser origin 'Both m a
throughJSON Name
scalarName =
      let schemaType :: Type origin 'Both
schemaType = Nullability
-> Definition origin (TypeInfo origin 'Both) -> Type origin 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
P.TNamed Nullability
P.NonNullable (Definition origin (TypeInfo origin 'Both) -> Type origin 'Both)
-> Definition origin (TypeInfo origin 'Both) -> Type origin 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> TypeInfo origin 'Both
-> Definition origin (TypeInfo origin 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
scalarName Maybe Description
forall a. Maybe a
Nothing Maybe origin
forall a. Maybe a
Nothing [] TypeInfo origin 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar
       in Parser :: forall origin (k :: Kind) (m :: * -> *) a.
Type origin k -> (ParserInput k -> m a) -> Parser origin k m a
P.Parser
            { pType :: Type origin 'Both
pType = Type origin 'Both
schemaType,
              pParser :: ParserInput 'Both -> m a
pParser =
                GType -> InputValue Variable -> m Value
forall (m :: * -> *).
MonadParse m =>
GType -> InputValue Variable -> m Value
P.valueToJSON (Type origin 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
P.toGraphQLType Type origin 'Both
schemaType)
                  (InputValue Variable -> m Value)
-> (Value -> m a) -> InputValue Variable -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (QErr -> m a) -> (a -> m a) -> Either QErr a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseErrorCode -> ErrorMessage -> m a
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
P.parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> m a) -> (QErr -> ErrorMessage) -> QErr -> m a
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) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr a -> m a) -> (Value -> Either QErr a) -> Value -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser a) -> Value -> Either QErr a
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON
            }
    stringBased :: MonadParse m => G.Name -> Parser 'Both m Text
    stringBased :: Name -> Parser 'Both m Text
stringBased Name
scalarName =
      Parser Any 'Both m Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string {pType :: Type MetadataObjId 'Both
P.pType = 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
scalarName Maybe Description
forall a. Maybe a
Nothing Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
P.TIScalar}

bqOrderByOperators ::
  NamingCase ->
  ( G.Name,
    NonEmpty
      ( P.Definition P.EnumValueInfo,
        (BasicOrderType 'BigQuery, NullsOrderType 'BigQuery)
      )
  )
bqOrderByOperators :: NamingCase
-> (Name,
    NonEmpty
      (Definition EnumValueInfo,
       (BasicOrderType 'BigQuery, NullsOrderType 'BigQuery)))
bqOrderByOperators NamingCase
_tCase =
  (Name
Name._order_by,) (NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
 -> (Name,
     NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))))
-> NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
-> (Name, NonEmpty (Definition EnumValueInfo, (Order, NullsOrder)))
forall a b. (a -> b) -> a -> b
$
    -- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
    [(Definition EnumValueInfo, (Order, NullsOrder))]
-> NonEmpty (Definition EnumValueInfo, (Order, NullsOrder))
forall a. [a] -> NonEmpty a
NE.fromList
      [ ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc Description
"in ascending order, nulls first",
          (Order
BigQuery.AscOrder, NullsOrder
BigQuery.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc_nulls_first Description
"in ascending order, nulls first",
          (Order
BigQuery.AscOrder, NullsOrder
BigQuery.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._asc_nulls_last Description
"in ascending order, nulls last",
          (Order
BigQuery.AscOrder, NullsOrder
BigQuery.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc Description
"in descending order, nulls last",
          (Order
BigQuery.DescOrder, NullsOrder
BigQuery.NullsLast)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc_nulls_first Description
"in descending order, nulls first",
          (Order
BigQuery.DescOrder, NullsOrder
BigQuery.NullsFirst)
        ),
        ( Name -> Description -> Definition EnumValueInfo
forall origin.
Name -> Description -> Definition origin EnumValueInfo
define Name
Name._desc_nulls_last Description
"in descending order, nulls last",
          (Order
BigQuery.DescOrder, NullsOrder
BigQuery.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

bqComparisonExps ::
  forall m n r.
  (MonadBuildSchema 'BigQuery r m n) =>
  ColumnType 'BigQuery ->
  m (Parser 'Input n [ComparisonExp 'BigQuery])
bqComparisonExps :: ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
bqComparisonExps = Name
-> (ColumnType 'BigQuery
    -> m (Parser 'Input n [ComparisonExp 'BigQuery]))
-> ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
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)
P.memoize 'comparisonExps ((ColumnType 'BigQuery
  -> m (Parser 'Input n [ComparisonExp 'BigQuery]))
 -> ColumnType 'BigQuery
 -> m (Parser 'Input n [ComparisonExp 'BigQuery]))
-> (ColumnType 'BigQuery
    -> m (Parser 'Input n [ComparisonExp 'BigQuery]))
-> ColumnType 'BigQuery
-> m (Parser 'Input n [ComparisonExp 'BigQuery])
forall a b. (a -> b) -> a -> b
$ \ColumnType 'BigQuery
columnType -> do
  DangerouslyCollapseBooleans
collapseIfNull <- (SchemaOptions -> DangerouslyCollapseBooleans)
-> m DangerouslyCollapseBooleans
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> DangerouslyCollapseBooleans
Options.soDangerousBooleanCollapse

  Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery))
dWithinGeogOpParser <- m (Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery)))
forall (m :: * -> *) (n :: * -> *) r.
(MonadMemoize m, MonadBuildSchema 'BigQuery r m n) =>
m (Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery)))
geographyWithinDistanceInput
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  -- see Note [Columns in comparison expression are never nullable]
  Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser ColumnType 'BigQuery
columnType (Bool -> Nullability
G.Nullability Bool
False)
  -- textParser <- columnParser (ColumnScalar @'BigQuery BigQuery.StringScalarType) (G.Nullability False)
  let name :: Name
name = Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)) -> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__BigQuery_comparison_exp
      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 'BigQuery)) -> Name
forall a. HasName a => a -> Name
P.getName Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser
            Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". All fields are combined with logical 'AND'."
      -- textListParser = fmap openValueOrigin <$> P.list textParser
      columnListParser :: Parser MetadataObjId 'Both n [ColumnValue 'BigQuery]
columnListParser = (ValueWithOrigin (ColumnValue 'BigQuery) -> ColumnValue 'BigQuery)
-> [ValueWithOrigin (ColumnValue 'BigQuery)]
-> [ColumnValue 'BigQuery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue 'BigQuery) -> ColumnValue 'BigQuery
forall a. ValueWithOrigin a -> a
IR.openValueOrigin ([ValueWithOrigin (ColumnValue 'BigQuery)]
 -> [ColumnValue 'BigQuery])
-> Parser
     MetadataObjId 'Both n [ValueWithOrigin (ColumnValue 'BigQuery)]
-> Parser MetadataObjId 'Both n [ColumnValue 'BigQuery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser
     MetadataObjId 'Both n [ValueWithOrigin (ColumnValue 'BigQuery)]
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 'BigQuery))
typedParser
      mkListLiteral :: [ColumnValue 'BigQuery] -> IR.UnpreparedValue 'BigQuery
      mkListLiteral :: [ColumnValue 'BigQuery] -> UnpreparedValue 'BigQuery
mkListLiteral =
        Expression -> UnpreparedValue 'BigQuery
forall (b :: BackendType). SQLExpression b -> UnpreparedValue b
IR.UVLiteral (Expression -> UnpreparedValue 'BigQuery)
-> ([ColumnValue 'BigQuery] -> Expression)
-> [ColumnValue 'BigQuery]
-> UnpreparedValue 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expression] -> Expression
BigQuery.ListExpression ([Expression] -> Expression)
-> ([ColumnValue 'BigQuery] -> [Expression])
-> [ColumnValue 'BigQuery]
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnValue 'BigQuery -> Expression)
-> [ColumnValue 'BigQuery] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Expression
BigQuery.ValueExpression (Value -> Expression)
-> (ColumnValue 'BigQuery -> Value)
-> ColumnValue 'BigQuery
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnValue 'BigQuery -> Value
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue)
  pure $
    Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n [ComparisonExp 'BigQuery]
-> Parser 'Input n [ComparisonExp 'BigQuery]
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 'BigQuery]
 -> Parser 'Input n [ComparisonExp 'BigQuery])
-> InputFieldsParser MetadataObjId n [ComparisonExp 'BigQuery]
-> Parser 'Input n [ComparisonExp 'BigQuery]
forall a b. (a -> b) -> a -> b
$
      ([Maybe (ComparisonExp 'BigQuery)] -> [ComparisonExp 'BigQuery])
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp 'BigQuery)]
-> InputFieldsParser MetadataObjId n [ComparisonExp 'BigQuery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (ComparisonExp 'BigQuery)] -> [ComparisonExp 'BigQuery]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (InputFieldsParser
   MetadataObjId n [Maybe (ComparisonExp 'BigQuery)]
 -> InputFieldsParser MetadataObjId n [ComparisonExp 'BigQuery])
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp 'BigQuery)]
-> InputFieldsParser MetadataObjId n [ComparisonExp 'BigQuery]
forall a b. (a -> b) -> a -> b
$
        [InputFieldsParser
   MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp 'BigQuery)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([InputFieldsParser
    MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
 -> InputFieldsParser
      MetadataObjId n [Maybe (ComparisonExp 'BigQuery)])
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> InputFieldsParser
     MetadataObjId n [Maybe (ComparisonExp 'BigQuery)]
forall a b. (a -> b) -> a -> b
$
          [[InputFieldsParser
    MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ -- from https://cloud.google.com/bigquery/docs/reference/standard-sql/data-types:
              -- GEOGRAPHY comparisons are not supported. To compare GEOGRAPHY values, use ST_Equals.
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'BigQuery -> Bool) -> ColumnType 'BigQuery -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
/= ScalarType
BigQuery.GeographyScalarType) ColumnType 'BigQuery
columnType)
                [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue 'BigQuery)
-> Parser 'Both n (UnpreparedValue 'BigQuery)
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
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 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> UnpreparedValue 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser)
                  ([ColumnValue 'BigQuery] -> UnpreparedValue 'BigQuery
mkListLiteral ([ColumnValue 'BigQuery] -> UnpreparedValue 'BigQuery)
-> Parser MetadataObjId 'Both n [ColumnValue 'BigQuery]
-> Parser 'Both n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetadataObjId 'Both n [ColumnValue 'BigQuery]
columnListParser),
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'BigQuery -> Bool) -> ColumnType 'BigQuery -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
/= ScalarType
BigQuery.GeographyScalarType) ColumnType 'BigQuery
columnType)
                [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NamingCase
-> DangerouslyCollapseBooleans
-> Parser 'Both n (UnpreparedValue 'BigQuery)
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
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 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> UnpreparedValue 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
              -- Ops for String type
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'BigQuery -> Bool) -> ColumnType 'BigQuery -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarType
BigQuery.StringScalarType) ColumnType 'BigQuery
columnType)
                [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 'BigQuery -> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALIKE (UnpreparedValue 'BigQuery -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 'BigQuery -> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANLIKE (UnpreparedValue 'BigQuery -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser)
                   ],
              -- Ops for Bytes type
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'BigQuery -> Bool) -> ColumnType 'BigQuery -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarType
BigQuery.BytesScalarType) ColumnType 'BigQuery
columnType)
                [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 'BigQuery -> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
field -> OpExpG backend field
ALIKE (UnpreparedValue 'BigQuery -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 'BigQuery -> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
field -> OpExpG backend field
ANLIKE (UnpreparedValue 'BigQuery -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser)
                   ],
              -- Ops for Geography type
              Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((ScalarType 'BigQuery -> Bool) -> ColumnType 'BigQuery -> Bool
forall (b :: BackendType).
(ScalarType b -> Bool) -> ColumnType b -> Bool
isScalarColumnWhere (ScalarType -> ScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarType
BigQuery.GeographyScalarType) ColumnType 'BigQuery
columnType)
                [()]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
-> [InputFieldsParser
      MetadataObjId n (Maybe (ComparisonExp 'BigQuery))]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 geography value")
                       (BooleanOperators (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'BigQuery
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. a -> BooleanOperators a
BigQuery.ASTContains (UnpreparedValue 'BigQuery
 -> BooleanOperators (UnpreparedValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 geography value (directionality is ignored)")
                       (BooleanOperators (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'BigQuery
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. a -> BooleanOperators a
BigQuery.ASTEquals (UnpreparedValue 'BigQuery
 -> BooleanOperators (UnpreparedValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 at least one point in common with the given geography value")
                       (BooleanOperators (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'BigQuery
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. a -> BooleanOperators a
BigQuery.ASTTouches (UnpreparedValue 'BigQuery
 -> BooleanOperators (UnpreparedValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 geography value")
                       (BooleanOperators (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'BigQuery
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. a -> BooleanOperators a
BigQuery.ASTWithin (UnpreparedValue 'BigQuery
 -> BooleanOperators (UnpreparedValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Both n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpreparedValue 'BigQuery
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. a -> BooleanOperators a
BigQuery.ASTIntersects (UnpreparedValue 'BigQuery
 -> BooleanOperators (UnpreparedValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> UnpreparedValue 'BigQuery)
-> ValueWithOrigin (ColumnValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> Parser 'Both n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser),
                     NamingCase
-> DangerouslyCollapseBooleans
-> GQLNameIdentifier
-> Maybe Description
-> Parser 'Input n (ComparisonExp 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (Maybe (ComparisonExp 'BigQuery))
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 (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall (backend :: BackendType) field.
BooleanOperators backend field -> OpExpG backend field
ABackendSpecific (BooleanOperators (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> (DWithinGeogOp (UnpreparedValue 'BigQuery)
    -> BooleanOperators (UnpreparedValue 'BigQuery))
-> DWithinGeogOp (UnpreparedValue 'BigQuery)
-> ComparisonExp 'BigQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWithinGeogOp (UnpreparedValue 'BigQuery)
-> BooleanOperators (UnpreparedValue 'BigQuery)
forall a. DWithinGeogOp a -> BooleanOperators a
BigQuery.ASTDWithin (DWithinGeogOp (UnpreparedValue 'BigQuery)
 -> ComparisonExp 'BigQuery)
-> Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery))
-> Parser 'Input n (ComparisonExp 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery))
dWithinGeogOpParser)
                   ]
            ]

bqCountTypeInput ::
  MonadParse n =>
  Maybe (Parser 'Both n (Column 'BigQuery)) ->
  InputFieldsParser n (IR.CountDistinct -> CountType 'BigQuery)
bqCountTypeInput :: Maybe (Parser 'Both n (Column 'BigQuery))
-> InputFieldsParser n (CountDistinct -> CountType 'BigQuery)
bqCountTypeInput = \case
  Just Parser 'Both n (Column 'BigQuery)
columnEnum -> do
    Maybe [ColumnName]
columns <- Name
-> Maybe Description
-> Parser MetadataObjId 'Both n [ColumnName]
-> InputFieldsParser MetadataObjId n (Maybe [ColumnName])
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 [ColumnName]
 -> InputFieldsParser MetadataObjId n (Maybe [ColumnName]))
-> Parser MetadataObjId 'Both n [ColumnName]
-> InputFieldsParser MetadataObjId n (Maybe [ColumnName])
forall a b. (a -> b) -> a -> b
$ Parser MetadataObjId 'Both n ColumnName
-> Parser MetadataObjId 'Both n [ColumnName]
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 'BigQuery)
Parser MetadataObjId 'Both n ColumnName
columnEnum
    pure $ (CountDistinct -> Maybe [ColumnName] -> Countable ColumnName)
-> Maybe [ColumnName] -> CountDistinct -> Countable ColumnName
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct -> Maybe [Column 'BigQuery] -> CountType 'BigQuery
CountDistinct -> Maybe [ColumnName] -> Countable ColumnName
mkCountType Maybe [ColumnName]
columns
  Maybe (Parser 'Both n (Column 'BigQuery))
Nothing -> (CountDistinct -> Countable ColumnName)
-> InputFieldsParser
     MetadataObjId n (CountDistinct -> Countable ColumnName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CountDistinct -> Countable ColumnName)
 -> InputFieldsParser
      MetadataObjId n (CountDistinct -> Countable ColumnName))
-> (CountDistinct -> Countable ColumnName)
-> InputFieldsParser
     MetadataObjId n (CountDistinct -> Countable ColumnName)
forall a b. (a -> b) -> a -> b
$ (CountDistinct -> Maybe [ColumnName] -> Countable ColumnName)
-> Maybe [ColumnName] -> CountDistinct -> Countable ColumnName
forall a b c. (a -> b -> c) -> b -> a -> c
flip CountDistinct -> Maybe [Column 'BigQuery] -> CountType 'BigQuery
CountDistinct -> Maybe [ColumnName] -> Countable ColumnName
mkCountType Maybe [ColumnName]
forall a. Maybe a
Nothing
  where
    mkCountType :: IR.CountDistinct -> Maybe [Column 'BigQuery] -> CountType 'BigQuery
    mkCountType :: CountDistinct -> Maybe [Column 'BigQuery] -> CountType 'BigQuery
mkCountType CountDistinct
_ Maybe [Column 'BigQuery]
Nothing = CountType 'BigQuery
forall fieldname. Countable fieldname
BigQuery.StarCountable
    mkCountType CountDistinct
IR.SelectCountDistinct (Just [Column 'BigQuery]
cols) =
      Countable ColumnName
-> (NonEmpty ColumnName -> Countable ColumnName)
-> Maybe (NonEmpty ColumnName)
-> Countable ColumnName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Countable ColumnName
forall fieldname. Countable fieldname
BigQuery.StarCountable NonEmpty ColumnName -> Countable ColumnName
forall fieldname. NonEmpty fieldname -> Countable fieldname
BigQuery.DistinctCountable (Maybe (NonEmpty ColumnName) -> Countable ColumnName)
-> Maybe (NonEmpty ColumnName) -> Countable ColumnName
forall a b. (a -> b) -> a -> b
$ [ColumnName] -> Maybe (NonEmpty ColumnName)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Column 'BigQuery]
[ColumnName]
cols
    mkCountType CountDistinct
IR.SelectCountNonDistinct (Just [Column 'BigQuery]
cols) =
      Countable ColumnName
-> (NonEmpty ColumnName -> Countable ColumnName)
-> Maybe (NonEmpty ColumnName)
-> Countable ColumnName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Countable ColumnName
forall fieldname. Countable fieldname
BigQuery.StarCountable NonEmpty ColumnName -> Countable ColumnName
forall fieldname. NonEmpty fieldname -> Countable fieldname
BigQuery.NonNullFieldCountable (Maybe (NonEmpty ColumnName) -> Countable ColumnName)
-> Maybe (NonEmpty ColumnName) -> Countable ColumnName
forall a b. (a -> b) -> a -> b
$ [ColumnName] -> Maybe (NonEmpty ColumnName)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Column 'BigQuery]
[ColumnName]
cols

geographyWithinDistanceInput ::
  forall m n r.
  (MonadMemoize m, MonadBuildSchema 'BigQuery r m n) =>
  m (Parser 'Input n (DWithinGeogOp (IR.UnpreparedValue 'BigQuery)))
geographyWithinDistanceInput :: m (Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery)))
geographyWithinDistanceInput = do
  Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
geographyParser <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType 'BigQuery
ScalarType
BigQuery.GeographyScalarType) (Bool -> Nullability
G.Nullability Bool
False)
  -- practically BigQuery (as of 2021-11-19) doesn't support TRUE as use_spheroid parameter for ST_DWITHIN
  Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
booleanParser <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType 'BigQuery
ScalarType
BigQuery.BoolScalarType) (Bool -> Nullability
G.Nullability Bool
True)
  Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
floatParser <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType 'BigQuery
ScalarType
BigQuery.FloatScalarType) (Bool -> Nullability
G.Nullability Bool
False)
  pure $
    Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId n (DWithinGeogOp (UnpreparedValue 'BigQuery))
-> Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
Name._st_dwithin_input Maybe Description
forall a. Maybe a
Nothing (InputFieldsParser
   MetadataObjId n (DWithinGeogOp (UnpreparedValue 'BigQuery))
 -> Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery)))
-> InputFieldsParser
     MetadataObjId n (DWithinGeogOp (UnpreparedValue 'BigQuery))
-> Parser 'Input n (DWithinGeogOp (UnpreparedValue 'BigQuery))
forall a b. (a -> b) -> a -> b
$
      UnpreparedValue 'BigQuery
-> UnpreparedValue 'BigQuery
-> UnpreparedValue 'BigQuery
-> DWithinGeogOp (UnpreparedValue 'BigQuery)
forall field. field -> field -> field -> DWithinGeogOp field
DWithinGeogOp (UnpreparedValue 'BigQuery
 -> UnpreparedValue 'BigQuery
 -> UnpreparedValue 'BigQuery
 -> DWithinGeogOp (UnpreparedValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue 'BigQuery
      -> UnpreparedValue 'BigQuery
      -> DWithinGeogOp (UnpreparedValue 'BigQuery))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
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 'BigQuery))
floatParser)
        InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue 'BigQuery
   -> UnpreparedValue 'BigQuery
   -> DWithinGeogOp (UnpreparedValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId
     n
     (UnpreparedValue 'BigQuery
      -> DWithinGeogOp (UnpreparedValue 'BigQuery))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
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 'BigQuery))
geographyParser)
        InputFieldsParser
  MetadataObjId
  n
  (UnpreparedValue 'BigQuery
   -> DWithinGeogOp (UnpreparedValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (DWithinGeogOp (UnpreparedValue 'BigQuery))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter (ValueWithOrigin (ColumnValue 'BigQuery)
 -> UnpreparedValue 'BigQuery)
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser MetadataObjId n (UnpreparedValue 'BigQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Value Void
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
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
False) Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
booleanParser)

-- | Computed field parser.
bqComputedField ::
  forall r m n.
  MonadBuildSchema 'BigQuery r m n =>
  SourceInfo 'BigQuery ->
  ComputedFieldInfo 'BigQuery ->
  TableName 'BigQuery ->
  TableInfo 'BigQuery ->
  m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
bqComputedField :: SourceInfo 'BigQuery
-> ComputedFieldInfo 'BigQuery
-> TableName 'BigQuery
-> TableInfo 'BigQuery
-> m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
bqComputedField SourceInfo 'BigQuery
sourceName ComputedFieldInfo {Maybe Text
ComputedFieldReturn 'BigQuery
XComputedField 'BigQuery
ComputedFieldFunction 'BigQuery
ComputedFieldName
_cfiDescription :: forall (b :: BackendType). ComputedFieldInfo b -> Maybe Text
_cfiReturnType :: forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldReturn b
_cfiFunction :: forall (b :: BackendType).
ComputedFieldInfo b -> ComputedFieldFunction b
_cfiName :: forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiXComputedFieldInfo :: forall (b :: BackendType). ComputedFieldInfo b -> XComputedField b
_cfiDescription :: Maybe Text
_cfiReturnType :: ComputedFieldReturn 'BigQuery
_cfiFunction :: ComputedFieldFunction 'BigQuery
_cfiName :: ComputedFieldName
_cfiXComputedFieldInfo :: XComputedField 'BigQuery
..} TableName 'BigQuery
tableName TableInfo 'BigQuery
tableInfo = MaybeT m (FieldParser n (AnnotatedField 'BigQuery))
-> m (Maybe (FieldParser n (AnnotatedField 'BigQuery)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers) -> MaybeT m StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  Name
fieldName <- m Name -> MaybeT m Name
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Name -> MaybeT m Name) -> m Name -> MaybeT m Name
forall a b. (a -> b) -> a -> b
$ Text -> m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> m Name) -> Text -> m Name
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
_cfiName
  InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
functionArgsParser <- m (InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
-> MaybeT
     m
     (InputFieldsParser
        MetadataObjId
        n
        (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (InputFieldsParser
      MetadataObjId
      n
      (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
 -> MaybeT
      m
      (InputFieldsParser
         MetadataObjId
         n
         (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))))
-> m (InputFieldsParser
        MetadataObjId
        n
        (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
-> MaybeT
     m
     (InputFieldsParser
        MetadataObjId
        n
        (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
forall a b. (a -> b) -> a -> b
$ ComputedFieldFunction 'BigQuery
-> m (InputFieldsParser
        n (FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)))
computedFieldFunctionArgs ComputedFieldFunction 'BigQuery
_cfiFunction
  case ComputedFieldReturn 'BigQuery
_cfiReturnType of
    BigQuery.ReturnExistingTable returnTable -> do
      TableInfo 'BigQuery
returnTableInfo <- m (TableInfo 'BigQuery) -> MaybeT m (TableInfo 'BigQuery)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TableInfo 'BigQuery) -> MaybeT m (TableInfo 'BigQuery))
-> m (TableInfo 'BigQuery) -> MaybeT m (TableInfo 'BigQuery)
forall a b. (a -> b) -> a -> b
$ SourceInfo 'BigQuery
-> TableName 'BigQuery -> m (TableInfo 'BigQuery)
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
SourceInfo b -> TableName b -> m (TableInfo b)
askTableInfo SourceInfo 'BigQuery
sourceName TableName 'BigQuery
TableName
returnTable
      SelPermInfo 'BigQuery
returnTablePermissions <- Maybe (SelPermInfo 'BigQuery) -> MaybeT m (SelPermInfo 'BigQuery)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo 'BigQuery) -> MaybeT m (SelPermInfo 'BigQuery))
-> Maybe (SelPermInfo 'BigQuery)
-> MaybeT m (SelPermInfo 'BigQuery)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo 'BigQuery -> Maybe (SelPermInfo 'BigQuery)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo 'BigQuery
returnTableInfo
      Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
selectionSetParser <- m (Maybe
     (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
-> MaybeT
     m (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
 -> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
-> Maybe
     (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
-> Maybe
     (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.multiple (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
 -> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
-> (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
    -> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.nonNullableParser) (Maybe (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
 -> Maybe
      (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
-> m (Maybe
        (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
-> m (Maybe
        (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceInfo 'BigQuery
-> TableInfo 'BigQuery
-> m (Maybe
        (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionSet SourceInfo 'BigQuery
sourceName TableInfo 'BigQuery
returnTableInfo)
      InputFieldsParser
  n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
selectArgsParser <- m (InputFieldsParser
     n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
-> MaybeT
     m
     (InputFieldsParser
        n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (InputFieldsParser
      n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
 -> MaybeT
      m
      (InputFieldsParser
         n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))))
-> m (InputFieldsParser
        n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
-> MaybeT
     m
     (InputFieldsParser
        n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
forall a b. (a -> b) -> a -> b
$ SourceInfo 'BigQuery
-> TableInfo 'BigQuery
-> m (InputFieldsParser
        n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b
-> m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
tableArguments SourceInfo 'BigQuery
sourceName TableInfo 'BigQuery
returnTableInfo
      let fieldArgsParser :: InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
   SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
fieldArgsParser = (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
 -> SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
 -> (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
     SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)))
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> InputFieldsParser
     n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
      SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
functionArgsParser InputFieldsParser
  n (SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
selectArgsParser
      pure $
        Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
      SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> FieldParser
     MetadataObjId
     n
     ((FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
       SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)),
      AnnotatedFields 'BigQuery)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection Name
fieldName Maybe Description
fieldDescription InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
   SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery))
fieldArgsParser Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
selectionSetParser
          FieldParser
  MetadataObjId
  n
  ((FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
    SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)),
   AnnotatedFields 'BigQuery)
-> (((FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
      SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)),
     AnnotatedFields 'BigQuery)
    -> AnnotatedField 'BigQuery)
-> FieldParser n (AnnotatedField 'BigQuery)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
functionArgs', SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
args), AnnotatedFields 'BigQuery
fields) ->
            XComputedField 'BigQuery
-> ComputedFieldName
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
-> AnnotatedField 'BigQuery
forall (b :: BackendType) r v.
XComputedField b
-> ComputedFieldName
-> ComputedFieldSelect b r v
-> AnnFieldG b r v
IR.AFComputedField XComputedField 'BigQuery
_cfiXComputedFieldInfo ComputedFieldName
_cfiName (ComputedFieldSelect
   'BigQuery
   (RemoteRelationshipField UnpreparedValue)
   (UnpreparedValue 'BigQuery)
 -> AnnotatedField 'BigQuery)
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
-> AnnotatedField 'BigQuery
forall a b. (a -> b) -> a -> b
$
              JsonAggSelect
-> SelectExp 'BigQuery
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
forall (b :: BackendType) r v.
JsonAggSelect
-> AnnSimpleSelectG b r v -> ComputedFieldSelect b r v
IR.CFSTable JsonAggSelect
JASMultipleRows (SelectExp 'BigQuery
 -> ComputedFieldSelect
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))
-> SelectExp 'BigQuery
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
forall a b. (a -> b) -> a -> b
$
                AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
IR.AnnSelectG
                  { $sel:_asnFields:AnnSelectG :: AnnotatedFields 'BigQuery
IR._asnFields = AnnotatedFields 'BigQuery
fields,
                    $sel:_asnFrom:AnnSelectG :: SelectFromG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnFrom = FunctionName 'BigQuery
-> FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)
-> Maybe [(Column 'BigQuery, ScalarType 'BigQuery)]
-> SelectFromG 'BigQuery (UnpreparedValue 'BigQuery)
forall (b :: BackendType) v.
FunctionName b
-> FunctionArgsExp b v
-> Maybe [(Column b, ScalarType b)]
-> SelectFromG b v
IR.FromFunction (ComputedFieldFunction 'BigQuery -> FunctionName 'BigQuery
forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
_cffName ComputedFieldFunction 'BigQuery
_cfiFunction) FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)
FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
functionArgs' Maybe [(Column 'BigQuery, ScalarType 'BigQuery)]
forall a. Maybe a
Nothing,
                    $sel:_asnPerm:AnnSelectG :: TablePermG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnPerm = SelPermInfo 'BigQuery
-> TablePermG 'BigQuery (UnpreparedValue 'BigQuery)
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo 'BigQuery
returnTablePermissions,
                    $sel:_asnArgs:AnnSelectG :: SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnArgs = SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
args,
                    $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
                    $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = Maybe NamingCase
forall a. Maybe a
Nothing
                  }
    BigQuery.ReturnTableSchema returnFields -> do
      -- Check if the computed field is available in the select permission
      SelPermInfo 'BigQuery
selectPermissions <- Maybe (SelPermInfo 'BigQuery) -> MaybeT m (SelPermInfo 'BigQuery)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo 'BigQuery) -> MaybeT m (SelPermInfo 'BigQuery))
-> Maybe (SelPermInfo 'BigQuery)
-> MaybeT m (SelPermInfo 'BigQuery)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo 'BigQuery -> Maybe (SelPermInfo 'BigQuery)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo 'BigQuery
tableInfo
      Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT m ()) -> Bool -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldName
-> HashMap
     ComputedFieldName
     (Maybe (AnnColumnCaseBoolExpPartialSQL 'BigQuery))
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
Map.member ComputedFieldName
_cfiName (HashMap
   ComputedFieldName
   (Maybe (AnnColumnCaseBoolExpPartialSQL 'BigQuery))
 -> Bool)
-> HashMap
     ComputedFieldName
     (Maybe (AnnColumnCaseBoolExpPartialSQL 'BigQuery))
-> Bool
forall a b. (a -> b) -> a -> b
$ SelPermInfo 'BigQuery
-> HashMap
     ComputedFieldName
     (Maybe (AnnColumnCaseBoolExpPartialSQL 'BigQuery))
forall (b :: BackendType).
SelPermInfo b
-> HashMap
     ComputedFieldName (Maybe (AnnColumnCaseBoolExpPartialSQL b))
spiComputedFields SelPermInfo 'BigQuery
selectPermissions
      Name
objectTypeName <-
        Name -> MaybeT m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> MaybeT m Name) -> MaybeT m Name -> MaybeT m Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
          Name
computedFieldGQLName <- Text -> MaybeT m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> MaybeT m Name) -> Text -> MaybeT m Name
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
_cfiName
          pure $ Name
computedFieldGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__ Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__fields
      Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
selectionSetParser <- do
        [FieldParser n (AnnotatedField 'BigQuery)]
fieldParsers <- m [FieldParser n (AnnotatedField 'BigQuery)]
-> MaybeT m [FieldParser n (AnnotatedField 'BigQuery)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FieldParser n (AnnotatedField 'BigQuery)]
 -> MaybeT m [FieldParser n (AnnotatedField 'BigQuery)])
-> m [FieldParser n (AnnotatedField 'BigQuery)]
-> MaybeT m [FieldParser n (AnnotatedField 'BigQuery)]
forall a b. (a -> b) -> a -> b
$ [(ColumnName, Name, ScalarType)]
-> ((ColumnName, Name, ScalarType)
    -> m (FieldParser n (AnnotatedField 'BigQuery)))
-> m [FieldParser n (AnnotatedField 'BigQuery)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(ColumnName, Name, ScalarType)]
returnFields (ColumnName, Name, ScalarType)
-> m (FieldParser n (AnnotatedField 'BigQuery))
selectArbitraryField
        let description :: Description
description = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"column fields returning by " Text -> ComputedFieldName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ComputedFieldName
_cfiName
        Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> MaybeT
     m (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
 -> MaybeT
      m (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)))
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> MaybeT
     m (Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery))
forall a b. (a -> b) -> a -> b
$
          Name
-> Maybe Description
-> [FieldParser n (AnnotatedField 'BigQuery)]
-> [Parser MetadataObjId 'Output n Any]
-> Parser
     MetadataObjId
     'Output
     n
     (InsOrdHashMap Name (ParsedSelection (AnnotatedField 'BigQuery)))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> [Parser origin 'Output m b]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSetObject Name
objectTypeName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
description) [FieldParser n (AnnotatedField 'BigQuery)]
fieldParsers []
            Parser
  MetadataObjId
  'Output
  n
  (InsOrdHashMap Name (ParsedSelection (AnnotatedField 'BigQuery)))
-> (InsOrdHashMap Name (ParsedSelection (AnnotatedField 'BigQuery))
    -> AnnotatedFields 'BigQuery)
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> AnnotatedField 'BigQuery)
-> InsOrdHashMap Name (ParsedSelection (AnnotatedField 'BigQuery))
-> AnnotatedFields 'BigQuery
forall a.
(Text -> a) -> InsOrdHashMap Name (ParsedSelection a) -> Fields a
parsedSelectionsToFields Text -> AnnotatedField 'BigQuery
forall (b :: BackendType) r v. Text -> AnnFieldG b r v
IR.AFExpression
      pure $
        Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
-> FieldParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
      AnnotatedFields 'BigQuery)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection Name
fieldName Maybe Description
fieldDescription InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
functionArgsParser Parser MetadataObjId 'Output n (AnnotatedFields 'BigQuery)
selectionSetParser
          FieldParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
   AnnotatedFields 'BigQuery)
-> ((FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)),
     AnnotatedFields 'BigQuery)
    -> AnnotatedField 'BigQuery)
-> FieldParser n (AnnotatedField 'BigQuery)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
functionArgs', AnnotatedFields 'BigQuery
fields) ->
            XComputedField 'BigQuery
-> ComputedFieldName
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
-> AnnotatedField 'BigQuery
forall (b :: BackendType) r v.
XComputedField b
-> ComputedFieldName
-> ComputedFieldSelect b r v
-> AnnFieldG b r v
IR.AFComputedField XComputedField 'BigQuery
_cfiXComputedFieldInfo ComputedFieldName
_cfiName (ComputedFieldSelect
   'BigQuery
   (RemoteRelationshipField UnpreparedValue)
   (UnpreparedValue 'BigQuery)
 -> AnnotatedField 'BigQuery)
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
-> AnnotatedField 'BigQuery
forall a b. (a -> b) -> a -> b
$
              JsonAggSelect
-> SelectExp 'BigQuery
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
forall (b :: BackendType) r v.
JsonAggSelect
-> AnnSimpleSelectG b r v -> ComputedFieldSelect b r v
IR.CFSTable JsonAggSelect
JASMultipleRows (SelectExp 'BigQuery
 -> ComputedFieldSelect
      'BigQuery
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue 'BigQuery))
-> SelectExp 'BigQuery
-> ComputedFieldSelect
     'BigQuery
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue 'BigQuery)
forall a b. (a -> b) -> a -> b
$
                AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
IR.AnnSelectG
                  { $sel:_asnFields:AnnSelectG :: AnnotatedFields 'BigQuery
IR._asnFields = AnnotatedFields 'BigQuery
fields,
                    $sel:_asnFrom:AnnSelectG :: SelectFromG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnFrom = FunctionName 'BigQuery
-> FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)
-> Maybe [(Column 'BigQuery, ScalarType 'BigQuery)]
-> SelectFromG 'BigQuery (UnpreparedValue 'BigQuery)
forall (b :: BackendType) v.
FunctionName b
-> FunctionArgsExp b v
-> Maybe [(Column b, ScalarType b)]
-> SelectFromG b v
IR.FromFunction (ComputedFieldFunction 'BigQuery -> FunctionName 'BigQuery
forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
_cffName ComputedFieldFunction 'BigQuery
_cfiFunction) FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)
FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
functionArgs' Maybe [(Column 'BigQuery, ScalarType 'BigQuery)]
forall a. Maybe a
Nothing,
                    $sel:_asnPerm:AnnSelectG :: TablePermG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnPerm = TablePermG 'BigQuery (UnpreparedValue 'BigQuery)
forall (backend :: BackendType) v. TablePermG backend v
IR.noTablePermissions,
                    $sel:_asnArgs:AnnSelectG :: SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
IR._asnArgs = SelectArgsG 'BigQuery (UnpreparedValue 'BigQuery)
forall (backend :: BackendType) v. SelectArgsG backend v
IR.noSelectArgs,
                    $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
                    $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = Maybe NamingCase
forall a. Maybe a
Nothing
                  }
  where
    fieldDescription :: Maybe G.Description
    fieldDescription :: Maybe Description
fieldDescription = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_cfiDescription

    selectArbitraryField ::
      (BigQuery.ColumnName, G.Name, BigQuery.ScalarType) ->
      m (FieldParser n (AnnotatedField 'BigQuery))
    selectArbitraryField :: (ColumnName, Name, ScalarType)
-> m (FieldParser n (AnnotatedField 'BigQuery))
selectArbitraryField (ColumnName
columnName, Name
graphQLName, ScalarType
columnType) = do
      Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
field <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser @'BigQuery (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType 'BigQuery
ScalarType
columnType) (Bool -> Nullability
G.Nullability Bool
True)
      pure $
        Name
-> Maybe Description
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> FieldParser MetadataObjId n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
graphQLName Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
field
          FieldParser MetadataObjId n ()
-> AnnotatedField 'BigQuery
-> FieldParser n (AnnotatedField 'BigQuery)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Column 'BigQuery
-> ColumnType 'BigQuery
-> Maybe
     (AnnColumnCaseBoolExp 'BigQuery (UnpreparedValue 'BigQuery))
-> Maybe (ScalarSelectionArguments 'BigQuery)
-> AnnotatedField 'BigQuery
forall (backend :: BackendType) v r.
Column backend
-> ColumnType backend
-> Maybe (AnnColumnCaseBoolExp backend v)
-> Maybe (ScalarSelectionArguments backend)
-> AnnFieldG backend r v
IR.mkAnnColumnField Column 'BigQuery
ColumnName
columnName (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType 'BigQuery
ScalarType
columnType) Maybe (AnnColumnCaseBoolExp 'BigQuery (UnpreparedValue 'BigQuery))
forall a. Maybe a
Nothing Maybe (ScalarSelectionArguments 'BigQuery)
forall a. Maybe a
Nothing

    computedFieldFunctionArgs ::
      ComputedFieldFunction 'BigQuery ->
      m (InputFieldsParser n (FunctionArgsExp 'BigQuery (IR.UnpreparedValue 'BigQuery)))
    computedFieldFunctionArgs :: ComputedFieldFunction 'BigQuery
-> m (InputFieldsParser
        n (FunctionArgsExp 'BigQuery (UnpreparedValue 'BigQuery)))
computedFieldFunctionArgs ComputedFieldFunction {Maybe PGDescription
Seq (FunctionArgument 'BigQuery)
FunctionName 'BigQuery
ComputedFieldImplicitArguments 'BigQuery
_cffDescription :: forall (b :: BackendType).
ComputedFieldFunction b -> Maybe PGDescription
_cffComputedFieldImplicitArgs :: forall (b :: BackendType).
ComputedFieldFunction b -> ComputedFieldImplicitArguments b
_cffInputArgs :: forall (b :: BackendType).
ComputedFieldFunction b -> Seq (FunctionArgument b)
_cffDescription :: Maybe PGDescription
_cffComputedFieldImplicitArgs :: ComputedFieldImplicitArguments 'BigQuery
_cffInputArgs :: Seq (FunctionArgument 'BigQuery)
_cffName :: FunctionName 'BigQuery
_cffName :: forall (b :: BackendType).
ComputedFieldFunction b -> FunctionName b
..} = do
      let fieldName :: Name
fieldName = Name
Name._args
          fieldDesc :: Description
fieldDesc =
            Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$
              Text
"input parameters for computed field "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
_cfiName ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" defined on table " Text -> TableName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName 'BigQuery
TableName
tableName

      Name
objectName <-
        Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> m Name -> m Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
          Name
computedFieldGQLName <- Text -> m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> m Name) -> Text -> m Name
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
_cfiName
          Name
tableGQLName <- TableInfo 'BigQuery -> m Name
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName @'BigQuery TableInfo 'BigQuery
tableInfo
          pure $ Name
computedFieldGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__ Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__args

      let userInputArgs :: [FunctionArgument]
userInputArgs = (FunctionArgument -> Bool)
-> [FunctionArgument] -> [FunctionArgument]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (FunctionArgument -> Bool) -> FunctionArgument -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunctionArgName -> HashMap FunctionArgName ColumnName -> Bool)
-> HashMap FunctionArgName ColumnName -> FunctionArgName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FunctionArgName -> HashMap FunctionArgName ColumnName -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
Map.member HashMap FunctionArgName ColumnName
ComputedFieldImplicitArguments 'BigQuery
_cffComputedFieldImplicitArgs (FunctionArgName -> Bool)
-> (FunctionArgument -> FunctionArgName)
-> FunctionArgument
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArgument -> FunctionArgName
BigQuery._faName) (Seq FunctionArgument -> [FunctionArgument]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (FunctionArgument 'BigQuery)
Seq FunctionArgument
_cffInputArgs)

      InputFieldsParser
  MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
argumentParsers <- [InputFieldsParser
   MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))]
-> InputFieldsParser
     MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([InputFieldsParser
    MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))]
 -> InputFieldsParser
      MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))])
-> m [InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))]
-> m (InputFieldsParser
        MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FunctionArgument]
-> (FunctionArgument
    -> m (InputFieldsParser
            MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))))
-> m [InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FunctionArgument]
userInputArgs FunctionArgument
-> m (InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery)))
parseArgument

      let objectParser :: Parser
  MetadataObjId
  'Input
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
objectParser =
            Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
-> Parser
     MetadataObjId
     'Input
     n
     [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
objectName Maybe Description
forall a. Maybe a
Nothing InputFieldsParser
  MetadataObjId n [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
argumentParsers Parser
  MetadataObjId
  'Input
  n
  [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
-> ([(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
    -> n (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
-> Parser
     MetadataObjId
     'Input
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
forall (m :: * -> *) origin (k :: Kind) a b.
Monad m =>
Parser origin k m a -> (a -> m b) -> Parser origin k m b
`P.bind` \[(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
inputArguments -> do
              let tableColumnInputs :: HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
tableColumnInputs = (ColumnName -> ArgumentExp (UnpreparedValue 'BigQuery))
-> HashMap Text ColumnName
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map ColumnName -> ArgumentExp (UnpreparedValue 'BigQuery)
forall v. ColumnName -> ArgumentExp v
BigQuery.AETableColumn (HashMap Text ColumnName
 -> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery)))
-> HashMap Text ColumnName
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
forall a b. (a -> b) -> a -> b
$ (FunctionArgName -> Text)
-> HashMap FunctionArgName ColumnName -> HashMap Text ColumnName
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
Map.mapKeys FunctionArgName -> Text
getFuncArgNameTxt HashMap FunctionArgName ColumnName
ComputedFieldImplicitArguments 'BigQuery
_cffComputedFieldImplicitArgs
              FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
-> n (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
 -> n (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
-> FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
-> n (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
forall a b. (a -> b) -> a -> b
$ [ArgumentExp (UnpreparedValue 'BigQuery)]
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
-> FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
forall a. [a] -> HashMap Text a -> FunctionArgsExpG a
FunctionArgsExp [ArgumentExp (UnpreparedValue 'BigQuery)]
forall a. Monoid a => a
mempty (HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
 -> FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
-> FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))
forall a b. (a -> b) -> a -> b
$ [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Text, ArgumentExp (UnpreparedValue 'BigQuery))]
inputArguments HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
-> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
forall a. Semigroup a => a -> a -> a
<> HashMap Text (ArgumentExp (UnpreparedValue 'BigQuery))
tableColumnInputs

      InputFieldsParser
  MetadataObjId
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> m (InputFieldsParser
        MetadataObjId
        n
        (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser
   MetadataObjId
   n
   (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
 -> m (InputFieldsParser
         MetadataObjId
         n
         (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))))
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> m (InputFieldsParser
        MetadataObjId
        n
        (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery))))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Parser
     MetadataObjId
     'Input
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
-> InputFieldsParser
     MetadataObjId
     n
     (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
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
fieldName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
fieldDesc) Parser
  MetadataObjId
  'Input
  n
  (FunctionArgsExpG (ArgumentExp (UnpreparedValue 'BigQuery)))
objectParser

    parseArgument :: BigQuery.FunctionArgument -> m (InputFieldsParser n (Text, BigQuery.ArgumentExp (IR.UnpreparedValue 'BigQuery)))
    parseArgument :: FunctionArgument
-> m (InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery)))
parseArgument FunctionArgument
arg = do
      Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser <- ColumnType 'BigQuery
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser (ScalarType 'BigQuery -> ColumnType 'BigQuery
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar (ScalarType 'BigQuery -> ColumnType 'BigQuery)
-> ScalarType 'BigQuery -> ColumnType 'BigQuery
forall a b. (a -> b) -> a -> b
$ FunctionArgument -> ScalarType
BigQuery._faType FunctionArgument
arg) (Bool -> Nullability
G.Nullability Bool
False)
      let argumentName :: Text
argumentName = FunctionArgName -> Text
getFuncArgNameTxt (FunctionArgName -> Text) -> FunctionArgName -> Text
forall a b. (a -> b) -> a -> b
$ FunctionArgument -> FunctionArgName
BigQuery._faName FunctionArgument
arg
      Name
fieldName <- Text -> m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName Text
argumentName
      let argParser :: InputFieldsParser
  MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
argParser = Name
-> Maybe Description
-> Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
-> InputFieldsParser
     MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
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
fieldName Maybe Description
forall a. Maybe a
Nothing Parser 'Both n (ValueWithOrigin (ColumnValue 'BigQuery))
typedParser
      InputFieldsParser
  MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))
-> m (InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser
   MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))
 -> m (InputFieldsParser
         MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))))
-> InputFieldsParser
     MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))
-> m (InputFieldsParser
        MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery)))
forall a b. (a -> b) -> a -> b
$ InputFieldsParser
  MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
argParser InputFieldsParser
  MetadataObjId n (ValueWithOrigin (ColumnValue 'BigQuery))
-> (ValueWithOrigin (ColumnValue 'BigQuery)
    -> n (Text, ArgumentExp (UnpreparedValue 'BigQuery)))
-> InputFieldsParser
     MetadataObjId n (Text, ArgumentExp (UnpreparedValue 'BigQuery))
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` \ValueWithOrigin (ColumnValue 'BigQuery)
inputValue -> (Text, ArgumentExp (UnpreparedValue 'BigQuery))
-> n (Text, ArgumentExp (UnpreparedValue 'BigQuery))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text
argumentName, UnpreparedValue 'BigQuery
-> ArgumentExp (UnpreparedValue 'BigQuery)
forall v. v -> ArgumentExp v
BigQuery.AEInput (UnpreparedValue 'BigQuery
 -> ArgumentExp (UnpreparedValue 'BigQuery))
-> UnpreparedValue 'BigQuery
-> ArgumentExp (UnpreparedValue 'BigQuery)
forall a b. (a -> b) -> a -> b
$ ValueWithOrigin (ColumnValue 'BigQuery)
-> UnpreparedValue 'BigQuery
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter ValueWithOrigin (ColumnValue 'BigQuery)
inputValue))