{-# OPTIONS_GHC -fno-warn-orphans #-}

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

import Data.Aeson
import Data.Text.Casing (GQLNameIdentifier)
import Data.Text.Casing qualified as C
import Hasura.Backends.BigQuery.Meta qualified as BigQuery
import Hasura.Backends.BigQuery.Source qualified as BigQuery
import Hasura.Backends.BigQuery.ToQuery ()
import Hasura.Backends.BigQuery.Types qualified as BigQuery
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.ResizePool (ServerReplicas, SourceResizePoolSummary, noPoolsResizedSummary)
import Language.GraphQL.Draft.Syntax qualified as G

instance Backend 'BigQuery where
  type BackendConfig 'BigQuery = ()
  type BackendInfo 'BigQuery = ()
  type TableName 'BigQuery = BigQuery.TableName
  type FunctionName 'BigQuery = BigQuery.FunctionName
  type RawFunctionInfo 'BigQuery = BigQuery.RestRoutine
  type FunctionArgument 'BigQuery = BigQuery.FunctionArgument
  type ConstraintName 'BigQuery = Void
  type BasicOrderType 'BigQuery = BigQuery.Order
  type NullsOrderType 'BigQuery = BigQuery.NullsOrder
  type CountType 'BigQuery = Const (BigQuery.Countable BigQuery.ColumnName) -- TODO(redactionExp): Going to need to replace this Const with a fixed up type here
  type Column 'BigQuery = BigQuery.ColumnName
  type ScalarValue 'BigQuery = BigQuery.Value
  type ScalarType 'BigQuery = BigQuery.ScalarType
  type SQLExpression 'BigQuery = BigQuery.Expression
  type ScalarSelectionArguments 'BigQuery = Void
  type BooleanOperators 'BigQuery = BigQuery.BooleanOperators
  type ComputedFieldDefinition 'BigQuery = BigQuery.ComputedFieldDefinition
  type FunctionArgumentExp 'BigQuery = BigQuery.ArgumentExp
  type ComputedFieldImplicitArguments 'BigQuery = BigQuery.ComputedFieldImplicitArguments
  type ComputedFieldReturn 'BigQuery = BigQuery.ComputedFieldReturn
  type ExecutionStatistics 'BigQuery = BigQuery.ExecutionStatistics

  type XStreamingSubscription 'BigQuery = XDisable
  type XComputedField 'BigQuery = XEnable
  type XRelay 'BigQuery = XDisable
  type XNodesAgg 'BigQuery = XEnable
  type XEventTriggers 'BigQuery = XDisable
  type XNestedInserts 'BigQuery = XDisable
  type XStreamingSubscription 'BigQuery = XDisable

  type ExtraTableMetadata 'BigQuery = ()

  type HealthCheckTest 'BigQuery = Void

  isComparableType :: ScalarType 'BigQuery -> Bool
  isComparableType :: ScalarType 'BigQuery -> Bool
isComparableType = ScalarType 'BigQuery -> Bool
ScalarType -> Bool
BigQuery.isComparableType

  isNumType :: ScalarType 'BigQuery -> Bool
  isNumType :: ScalarType 'BigQuery -> Bool
isNumType = ScalarType 'BigQuery -> Bool
ScalarType -> Bool
BigQuery.isNumType

  textToScalarValue :: Maybe Text -> ScalarValue 'BigQuery
  textToScalarValue :: Maybe Text -> ScalarValue 'BigQuery
textToScalarValue = Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
BigQuery.NullValue Text -> Value
BigQuery.StringValue

  parseScalarValue :: ScalarTypeParsingContext 'BigQuery -> ScalarType 'BigQuery -> Value -> Either QErr (ScalarValue 'BigQuery)
  parseScalarValue :: ScalarTypeParsingContext 'BigQuery
-> ScalarType 'BigQuery
-> Value
-> Either QErr (ScalarValue 'BigQuery)
parseScalarValue = (ScalarType -> Value -> Either QErr Value)
-> () -> ScalarType -> Value -> Either QErr Value
forall a b. a -> b -> a
const ScalarType -> Value -> Either QErr Value
BigQuery.parseScalarValue

  scalarValueToJSON :: ScalarValue 'BigQuery -> Value
  scalarValueToJSON :: ScalarValue 'BigQuery -> Value
scalarValueToJSON = String -> Value -> Value
forall a. HasCallStack => String -> a
error String
"scalarValueToJSON"

  functionToTable :: FunctionName 'BigQuery -> TableName 'BigQuery
  functionToTable :: FunctionName 'BigQuery -> TableName 'BigQuery
functionToTable = String -> FunctionName -> TableName
forall a. HasCallStack => String -> a
error String
"functionToTable"

  tableToFunction :: TableName 'BigQuery -> FunctionName 'BigQuery
  tableToFunction :: TableName 'BigQuery -> FunctionName 'BigQuery
tableToFunction BigQuery.TableName {Text
tableName :: Text
tableNameSchema :: Text
$sel:tableName:TableName :: TableName -> Text
$sel:tableNameSchema:TableName :: TableName -> Text
..} =
    BigQuery.FunctionName
      { $sel:functionName:FunctionName :: Text
functionName = Text
tableName,
        $sel:functionNameSchema:FunctionName :: Maybe Text
functionNameSchema = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
tableNameSchema
      }

  tableGraphQLName :: TableName 'BigQuery -> Either QErr G.Name
  tableGraphQLName :: TableName 'BigQuery -> Either QErr Name
tableGraphQLName = TableName 'BigQuery -> Either QErr Name
TableName -> Either QErr Name
BigQuery.getGQLTableName

  functionGraphQLName :: FunctionName 'BigQuery -> Either QErr G.Name
  functionGraphQLName :: FunctionName 'BigQuery -> Either QErr Name
functionGraphQLName = String -> FunctionName -> Either QErr Name
forall a. HasCallStack => String -> a
error String
"functionGraphQLName"

  snakeCaseTableName :: TableName 'BigQuery -> Text
  snakeCaseTableName :: TableName 'BigQuery -> Text
snakeCaseTableName BigQuery.TableName {Text
$sel:tableName:TableName :: TableName -> Text
tableName :: Text
tableName, Text
$sel:tableNameSchema:TableName :: TableName -> Text
tableNameSchema :: Text
tableNameSchema} =
    Text
tableNameSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName

  getTableIdentifier :: TableName 'BigQuery -> Either QErr GQLNameIdentifier
  getTableIdentifier :: TableName 'BigQuery -> Either QErr GQLNameIdentifier
getTableIdentifier TableName 'BigQuery
tName = do
    Name
gqlTableName <- TableName -> Either QErr Name
BigQuery.getGQLTableName TableName 'BigQuery
TableName
tName
    GQLNameIdentifier -> Either QErr GQLNameIdentifier
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLNameIdentifier -> Either QErr GQLNameIdentifier)
-> GQLNameIdentifier -> Either QErr GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
gqlTableName

  namingConventionSupport :: SupportedNamingCase
  namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
OnlyHasuraCase

  computedFieldFunction :: ComputedFieldDefinition 'BigQuery -> FunctionName 'BigQuery
  computedFieldFunction :: ComputedFieldDefinition 'BigQuery -> FunctionName 'BigQuery
computedFieldFunction = ComputedFieldDefinition 'BigQuery -> FunctionName 'BigQuery
ComputedFieldDefinition -> FunctionName
BigQuery._bqcfdFunction

  computedFieldReturnType :: ComputedFieldReturn 'BigQuery -> ComputedFieldReturnType 'BigQuery
  computedFieldReturnType :: ComputedFieldReturn 'BigQuery -> ComputedFieldReturnType 'BigQuery
computedFieldReturnType = \case
    BigQuery.ReturnExistingTable TableName
tableName -> TableName 'BigQuery -> ComputedFieldReturnType 'BigQuery
forall (b :: BackendType). TableName b -> ComputedFieldReturnType b
ReturnsTable TableName 'BigQuery
TableName
tableName
    BigQuery.ReturnTableSchema [(ColumnName, Name, ScalarType)]
_ -> ComputedFieldReturnType 'BigQuery
forall (b :: BackendType). ComputedFieldReturnType b
ReturnsOthers

  fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments 'BigQuery -> [FunctionArgumentExp 'BigQuery v]
  fromComputedFieldImplicitArguments :: forall v.
v
-> ComputedFieldImplicitArguments 'BigQuery
-> [FunctionArgumentExp 'BigQuery v]
fromComputedFieldImplicitArguments v
_ ComputedFieldImplicitArguments 'BigQuery
_ =
    -- As of now, computed fields are not supported in boolean and order by expressions.
    -- We don't have to generate arguments expression from implicit arguments.
    []

  resizeSourcePools :: SourceConfig 'BigQuery -> ServerReplicas -> IO SourceResizePoolSummary
  resizeSourcePools :: SourceConfig 'BigQuery
-> ServerReplicas -> IO SourceResizePoolSummary
resizeSourcePools SourceConfig 'BigQuery
_sourceConfig ServerReplicas
_serverReplicas =
    -- BigQuery does not posses connection pooling
    SourceResizePoolSummary -> IO SourceResizePoolSummary
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceResizePoolSummary
noPoolsResizedSummary

  defaultTriggerOnReplication :: Maybe (XEventTriggers 'BigQuery, TriggerOnReplication)
defaultTriggerOnReplication = Maybe (XDisable, TriggerOnReplication)
Maybe (XEventTriggers 'BigQuery, TriggerOnReplication)
forall a. Maybe a
Nothing

instance HasSourceConfiguration 'BigQuery where
  type SourceConfig 'BigQuery = BigQuery.BigQuerySourceConfig
  type SourceConnConfiguration 'BigQuery = BigQuery.BigQueryConnSourceConfig
  sourceConfigNumReadReplicas :: SourceConfig 'BigQuery -> Int
sourceConfigNumReadReplicas = Int -> BigQuerySourceConfig -> Int
forall a b. a -> b -> a
const Int
0 -- not supported
  sourceConfigConnectonTemplateEnabled :: SourceConfig 'BigQuery -> Bool
sourceConfigConnectonTemplateEnabled = Bool -> BigQuerySourceConfig -> Bool
forall a b. a -> b -> a
const Bool
False -- not supported
  sourceConfigBackendSourceKind :: SourceConfig 'BigQuery -> BackendSourceKind 'BigQuery
sourceConfigBackendSourceKind SourceConfig 'BigQuery
_sourceConfig = BackendSourceKind 'BigQuery
BigQueryKind