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

-- | MSSQL Instances Types
--
-- Defines a 'Hasura.RQL.Types.Backend.Backend' type class instance for MSSQL.
module Hasura.Backends.MSSQL.Instances.Types () where

import Data.Aeson
import Data.Text.Casing (GQLNameIdentifier)
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Connection qualified as MSSQL
import Hasura.Backends.MSSQL.ToQuery ()
import Hasura.Backends.MSSQL.Types.Insert qualified as MSSQL (BackendInsert)
import Hasura.Backends.MSSQL.Types.Internal qualified as MSSQL
import Hasura.Backends.MSSQL.Types.Update qualified as MSSQL (BackendUpdate)
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G

instance Backend 'MSSQL where
  type BackendConfig 'MSSQL = ()
  type SourceConfig 'MSSQL = MSSQL.MSSQLSourceConfig
  type SourceConnConfiguration 'MSSQL = MSSQL.MSSQLConnConfiguration
  type TableName 'MSSQL = MSSQL.TableName
  type RawFunctionInfo 'MSSQL = Void

  -- It's something of a wart that we have to
  -- specify this here, as we don't support functions for MSSQL.
  type FunctionName 'MSSQL = MSSQL.FunctionName
  type FunctionArgument 'MSSQL = Void
  type ConstraintName 'MSSQL = MSSQL.ConstraintName
  type BasicOrderType 'MSSQL = MSSQL.Order
  type NullsOrderType 'MSSQL = MSSQL.NullsOrder
  type CountType 'MSSQL = MSSQL.Countable MSSQL.ColumnName
  type Column 'MSSQL = MSSQL.ColumnName
  type ScalarValue 'MSSQL = MSSQL.Value
  type ScalarType 'MSSQL = MSSQL.ScalarType
  type BooleanOperators 'MSSQL = MSSQL.BooleanOperators
  type SQLExpression 'MSSQL = MSSQL.Expression
  type ScalarSelectionArguments 'MSSQL = Void

  type BackendUpdate 'MSSQL = MSSQL.BackendUpdate

  type ComputedFieldDefinition 'MSSQL = Void
  type FunctionArgumentExp 'MSSQL = Const Void
  type ComputedFieldImplicitArguments 'MSSQL = Void
  type ComputedFieldReturn 'MSSQL = Void

  type ExtraTableMetadata 'MSSQL = [MSSQL.ColumnName] -- List of identity columns
  type BackendInsert 'MSSQL = MSSQL.BackendInsert

  type XComputedField 'MSSQL = XDisable
  type XRelay 'MSSQL = XDisable
  type XNodesAgg 'MSSQL = XEnable
  type XNestedInserts 'MSSQL = XDisable
  type XStreamingSubscription 'MSSQL = XDisable

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

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

  textToScalarValue :: Maybe Text -> ScalarValue 'MSSQL
  textToScalarValue :: Maybe Text -> ScalarValue 'MSSQL
textToScalarValue = Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
ODBC.NullValue Text -> Value
ODBC.TextValue

  parseScalarValue :: ScalarType 'MSSQL -> Value -> Either QErr (ScalarValue 'MSSQL)
  parseScalarValue :: ScalarType 'MSSQL -> Value -> Either QErr (ScalarValue 'MSSQL)
parseScalarValue = ScalarType 'MSSQL -> Value -> Either QErr (ScalarValue 'MSSQL)
ScalarType -> Value -> Either QErr Value
MSSQL.parseScalarValue

  -- TODO: Is this Postgres specific? Should it be removed from the class?
  scalarValueToJSON :: ScalarValue 'MSSQL -> Value
  scalarValueToJSON :: ScalarValue 'MSSQL -> Value
scalarValueToJSON = [Char] -> Value -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected MSSQL error: calling scalarValueToJSON. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  functionToTable :: FunctionName 'MSSQL -> TableName 'MSSQL
  functionToTable :: FunctionName 'MSSQL -> TableName 'MSSQL
functionToTable = [Char] -> FunctionName -> TableName
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected MSSQL error: calling functionToTable. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  tableToFunction :: TableName 'MSSQL -> FunctionName 'MSSQL
  tableToFunction :: TableName 'MSSQL -> FunctionName 'MSSQL
tableToFunction = Text -> FunctionName
MSSQL.FunctionName (Text -> FunctionName)
-> (TableName -> Text) -> TableName -> FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
MSSQL.tableName

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

  functionGraphQLName :: FunctionName 'MSSQL -> Either QErr G.Name
  functionGraphQLName :: FunctionName 'MSSQL -> Either QErr Name
functionGraphQLName = [Char] -> FunctionName -> Either QErr Name
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected MSSQL error: calling functionGraphQLName. Please report this error at https://github.com/hasura/graphql-engine/issues/6590"

  snakeCaseTableName :: TableName 'MSSQL -> Text
  snakeCaseTableName :: TableName 'MSSQL -> Text
snakeCaseTableName = TableName 'MSSQL -> Text
TableName -> Text
MSSQL.snakeCaseTableName

  getTableIdentifier :: TableName 'MSSQL -> Either QErr GQLNameIdentifier
  getTableIdentifier :: TableName 'MSSQL -> Either QErr GQLNameIdentifier
getTableIdentifier = TableName 'MSSQL -> Either QErr GQLNameIdentifier
TableName -> Either QErr GQLNameIdentifier
MSSQL.getTableIdentifier

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

  computedFieldFunction :: ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
  computedFieldFunction :: ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
computedFieldFunction = ComputedFieldDefinition 'MSSQL -> FunctionName 'MSSQL
forall a. Void -> a
absurd

  computedFieldReturnType :: ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
  computedFieldReturnType :: ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
computedFieldReturnType = ComputedFieldReturn 'MSSQL -> ComputedFieldReturnType 'MSSQL
forall a. Void -> a
absurd

  fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments 'MSSQL -> [FunctionArgumentExp 'MSSQL v]
  fromComputedFieldImplicitArguments :: v
-> ComputedFieldImplicitArguments 'MSSQL
-> [FunctionArgumentExp 'MSSQL v]
fromComputedFieldImplicitArguments v
_ = ComputedFieldImplicitArguments 'MSSQL
-> [FunctionArgumentExp 'MSSQL v]
forall a. Void -> a
absurd