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

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

import Data.Aeson qualified as J
import Data.Text.Casing qualified as C
import Database.MySQL.Base.Types qualified as MySQL
import Hasura.Backends.MySQL.Types qualified as MySQL
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.DDL.Headers ()
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G

instance Backend 'MySQL where
  type BackendConfig 'MySQL = ()
  type SourceConfig 'MySQL = MySQL.SourceConfig
  type SourceConnConfiguration 'MySQL = MySQL.ConnSourceConfig
  type TableName 'MySQL = MySQL.TableName
  type FunctionName 'MySQL = MySQL.FunctionName
  type RawFunctionInfo 'MySQL = Void -- MySQL.FunctionName
  type FunctionArgument 'MySQL = Void
  type ConstraintName 'MySQL = MySQL.ConstraintName
  type BasicOrderType 'MySQL = MySQL.Order
  type NullsOrderType 'MySQL = MySQL.NullsOrder
  type CountType 'MySQL = MySQL.Countable MySQL.Column
  type Column 'MySQL = MySQL.Column
  type ScalarValue 'MySQL = MySQL.ScalarValue
  type ScalarType 'MySQL = MySQL.ScalarType -- DB.Type
  type SQLExpression 'MySQL = MySQL.Expression
  type ScalarSelectionArguments 'MySQL = Void
  type BooleanOperators 'MySQL = Const Void
  type ComputedFieldDefinition 'MySQL = Void
  type FunctionArgumentExp 'MySQL = Const Void
  type ComputedFieldImplicitArguments 'MySQL = Void
  type ComputedFieldReturn 'MySQL = Void
  type XComputedField 'MySQL = Void
  type XRelay 'MySQL = Void
  type XNodesAgg 'MySQL = XEnable
  type ExtraTableMetadata 'MySQL = ()
  type XNestedInserts 'MySQL = XDisable
  type XStreamingSubscription 'MySQL = XDisable

  isComparableType :: ScalarType 'MySQL -> Bool
  isComparableType :: ScalarType 'MySQL -> Bool
isComparableType = Backend 'MySQL => ScalarType 'MySQL -> Bool
forall (b :: BackendType). Backend b => ScalarType b -> Bool
isNumType @'MySQL -- TODO: For now we only allow comparisons for numeric types

  isNumType :: ScalarType 'MySQL -> Bool
  isNumType :: ScalarType 'MySQL -> Bool
isNumType = \case
    ScalarType 'MySQL
MySQL.Decimal -> Bool
True
    ScalarType 'MySQL
MySQL.Tiny -> Bool
True
    ScalarType 'MySQL
MySQL.Short -> Bool
True
    ScalarType 'MySQL
MySQL.Long -> Bool
True
    ScalarType 'MySQL
MySQL.Float -> Bool
True
    ScalarType 'MySQL
MySQL.Double -> Bool
True
    ScalarType 'MySQL
MySQL.Null -> Bool
False
    ScalarType 'MySQL
MySQL.Timestamp -> Bool
False
    ScalarType 'MySQL
MySQL.LongLong -> Bool
True
    ScalarType 'MySQL
MySQL.Int24 -> Bool
True
    ScalarType 'MySQL
MySQL.Date -> Bool
False
    ScalarType 'MySQL
MySQL.Time -> Bool
False
    ScalarType 'MySQL
MySQL.DateTime -> Bool
False
    ScalarType 'MySQL
MySQL.Year -> Bool
False
    ScalarType 'MySQL
MySQL.NewDate -> Bool
False
    ScalarType 'MySQL
MySQL.VarChar -> Bool
False
    ScalarType 'MySQL
MySQL.Bit -> Bool
False
    ScalarType 'MySQL
MySQL.NewDecimal -> Bool
True
    ScalarType 'MySQL
MySQL.Enum -> Bool
False
    ScalarType 'MySQL
MySQL.Set -> Bool
False
    ScalarType 'MySQL
MySQL.TinyBlob -> Bool
False
    ScalarType 'MySQL
MySQL.MediumBlob -> Bool
False
    ScalarType 'MySQL
MySQL.LongBlob -> Bool
False
    ScalarType 'MySQL
MySQL.Blob -> Bool
False
    ScalarType 'MySQL
MySQL.VarString -> Bool
False
    ScalarType 'MySQL
MySQL.String -> Bool
False
    ScalarType 'MySQL
MySQL.Geometry -> Bool
False
    ScalarType 'MySQL
MySQL.Json -> Bool
False

  textToScalarValue :: Maybe Text -> ScalarValue 'MySQL
  textToScalarValue :: Maybe Text -> ScalarValue 'MySQL
textToScalarValue = [Char] -> Maybe Text -> ScalarValue
forall a. HasCallStack => [Char] -> a
error [Char]
"textToScalarValue: MySQL backend does not support this operation yet."

  parseScalarValue :: ScalarType 'MySQL -> J.Value -> Either QErr (ScalarValue 'MySQL)
  parseScalarValue :: ScalarType 'MySQL -> Value -> Either QErr (ScalarValue 'MySQL)
parseScalarValue = [Char] -> ScalarType -> Value -> Either QErr ScalarValue
forall a. HasCallStack => [Char] -> a
error [Char]
"parseScalarValue: MySQL backend does not support this operation yet."

  scalarValueToJSON :: ScalarValue 'MySQL -> J.Value
  scalarValueToJSON :: ScalarValue 'MySQL -> Value
scalarValueToJSON = [Char] -> ScalarValue -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"scalarValueToJSON: MySQL backend does not support this operation yet."

  functionToTable :: FunctionName 'MySQL -> TableName 'MySQL
  functionToTable :: FunctionName 'MySQL -> TableName 'MySQL
functionToTable = [Char] -> FunctionName -> TableName
forall a. HasCallStack => [Char] -> a
error [Char]
"functionToTable: MySQL backend does not support this operation yet."

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

  tableGraphQLName :: TableName 'MySQL -> Either QErr G.Name
  tableGraphQLName :: TableName 'MySQL -> Either QErr Name
tableGraphQLName MySQL.TableName {..} =
    let gName :: Text
gName = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_") Maybe Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
     in (Text -> Maybe Name
G.mkName Text
gName)
          Maybe Name -> Either QErr Name -> Either QErr Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> Either QErr Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text
"TableName " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a valid GraphQL identifier")

  functionGraphQLName :: FunctionName 'MySQL -> Either QErr G.Name
  functionGraphQLName :: FunctionName 'MySQL -> Either QErr Name
functionGraphQLName = [Char] -> FunctionName -> Either QErr Name
forall a. HasCallStack => [Char] -> a
error [Char]
"functionGraphQLName: MySQL backend does not support this operation yet."

  snakeCaseTableName :: TableName 'MySQL -> Text
  snakeCaseTableName :: TableName 'MySQL -> Text
snakeCaseTableName MySQL.TableName {name, schema} =
    Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_") Maybe Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

  getTableIdentifier :: TableName 'MySQL -> Either QErr C.GQLNameIdentifier
  getTableIdentifier :: TableName 'MySQL -> Either QErr GQLNameIdentifier
getTableIdentifier MySQL.TableName {..} = do
    let gName :: Text
gName = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_") Maybe Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    Name
gqlTableName <-
      (Text -> Maybe Name
G.mkName Text
gName)
        Maybe Name -> Either QErr Name -> Either QErr Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> Either QErr Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text
"TableName " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a valid GraphQL identifier")
    GQLNameIdentifier -> Either QErr GQLNameIdentifier
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 'MySQL -> FunctionName 'MySQL
  computedFieldFunction :: ComputedFieldDefinition 'MySQL -> FunctionName 'MySQL
computedFieldFunction = [Char] -> Void -> FunctionName
forall a. HasCallStack => [Char] -> a
error [Char]
"computedFieldFunction: MySQL backend does not support this operation yet"

  computedFieldReturnType :: ComputedFieldReturn 'MySQL -> ComputedFieldReturnType 'MySQL
  computedFieldReturnType :: ComputedFieldReturn 'MySQL -> ComputedFieldReturnType 'MySQL
computedFieldReturnType = [Char] -> Void -> ComputedFieldReturnType 'MySQL
forall a. HasCallStack => [Char] -> a
error [Char]
"computedFieldReturnType: MySQL backend does not support this operation yet"

  fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments 'MySQL -> [FunctionArgumentExp 'MySQL v]
  fromComputedFieldImplicitArguments :: v
-> ComputedFieldImplicitArguments 'MySQL
-> [FunctionArgumentExp 'MySQL v]
fromComputedFieldImplicitArguments = [Char] -> v -> Void -> [Const Void v]
forall a. HasCallStack => [Char] -> a
error [Char]
"fromComputedFieldImplicitArguments: MySQL backend does not support this operation yet"