mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
ee995aacc1
The intent is to generalize `columnParser` to the point where it is the same across all backends, and then remove the interface in favor of a single implementation. This extracts out `enumParser` and `possiblyNullable` as the two main areas that differ across backends. We may split `possiblyNullable` further so that we can extract some of that logic out into a common function too. With these changes, the various `columnParser` implementations become semantically equivalent. They still do different things, and so reconciling them will require further changes. Co-Authored-By: Antoine Leblanc <antoine@hasura.io> PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5841 GitOrigin-RevId: eec1770931eed5d72da70c97d7d0f00e33fa15d2
232 lines
10 KiB
Haskell
232 lines
10 KiB
Haskell
{-# LANGUAGE ApplicativeDo #-}
|
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.Backends.MySQL.Instances.Schema () where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
import Data.Text.Extended
|
|
import Database.MySQL.Base.Types qualified as MySQL
|
|
import Hasura.Backends.MySQL.Types qualified as MySQL
|
|
import Hasura.Base.Error
|
|
import Hasura.Base.ErrorMessage (toErrorMessage)
|
|
import Hasura.GraphQL.Schema.Backend
|
|
import Hasura.GraphQL.Schema.Build qualified as GSB
|
|
import Hasura.GraphQL.Schema.Common
|
|
import Hasura.GraphQL.Schema.NamingCase
|
|
import Hasura.GraphQL.Schema.Parser
|
|
( InputFieldsParser,
|
|
Kind (..),
|
|
MonadParse,
|
|
Parser,
|
|
)
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.GraphQL.Schema.Select
|
|
import Hasura.Name qualified as Name
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR
|
|
import Hasura.RQL.IR.Select qualified as IR
|
|
import Hasura.RQL.Types.Backend as RQL
|
|
import Hasura.RQL.Types.Column as RQL
|
|
import Hasura.RQL.Types.SchemaCache as RQL
|
|
import Hasura.RQL.Types.Source as RQL
|
|
import Hasura.SQL.Backend
|
|
import Language.GraphQL.Draft.Syntax qualified as GQL
|
|
|
|
instance BackendSchema 'MySQL where
|
|
buildTableQueryAndSubscriptionFields = GSB.buildTableQueryAndSubscriptionFields
|
|
buildTableRelayQueryFields _ _ _ _ _ _ = pure []
|
|
buildTableStreamingSubscriptionFields = GSB.buildTableStreamingSubscriptionFields
|
|
buildTableInsertMutationFields _ _ _ _ _ _ = pure []
|
|
buildTableUpdateMutationFields _ _ _ _ _ _ = pure []
|
|
buildTableDeleteMutationFields _ _ _ _ _ _ = pure []
|
|
buildFunctionQueryFields _ _ _ _ _ = pure []
|
|
buildFunctionRelayQueryFields _ _ _ _ _ _ = pure []
|
|
buildFunctionMutationFields _ _ _ _ _ = pure []
|
|
relayExtension = Nothing
|
|
nodesAggExtension = Just ()
|
|
streamSubscriptionExtension = Nothing
|
|
columnParser = columnParser'
|
|
enumParser = enumParser'
|
|
possiblyNullable = possiblyNullable'
|
|
scalarSelectionArgumentsParser _ = pure Nothing
|
|
orderByOperators _sourceInfo = orderByOperators'
|
|
comparisonExps = const comparisonExps'
|
|
countTypeInput = mysqlCountTypeInput
|
|
aggregateOrderByCountType = error "aggregateOrderByCountType: MySQL backend does not support this operation yet."
|
|
computedField = error "computedField: MySQL backend does not support this operation yet."
|
|
|
|
instance BackendTableSelectSchema 'MySQL where
|
|
tableArguments = mysqlTableArgs
|
|
selectTable = defaultSelectTable
|
|
selectTableAggregate = defaultSelectTableAggregate
|
|
tableSelectionSet = defaultTableSelectionSet
|
|
|
|
mysqlTableArgs ::
|
|
forall r m n.
|
|
MonadBuildSchema 'MySQL r m n =>
|
|
RQL.SourceInfo 'MySQL ->
|
|
TableInfo 'MySQL ->
|
|
SchemaT r m (InputFieldsParser n (IR.SelectArgsG 'MySQL (UnpreparedValue 'MySQL)))
|
|
mysqlTableArgs sourceInfo tableInfo = do
|
|
whereParser <- tableWhereArg sourceInfo tableInfo
|
|
orderByParser <- tableOrderByArg sourceInfo tableInfo
|
|
pure do
|
|
whereArg <- whereParser
|
|
orderByArg <- orderByParser
|
|
limitArg <- tableLimitArg
|
|
offsetArg <- tableOffsetArg
|
|
pure $
|
|
IR.SelectArgs
|
|
{ IR._saWhere = whereArg,
|
|
IR._saOrderBy = orderByArg,
|
|
IR._saLimit = limitArg,
|
|
IR._saOffset = offsetArg,
|
|
IR._saDistinct = Nothing
|
|
}
|
|
|
|
bsParser :: MonadParse m => Parser 'Both m ByteString
|
|
bsParser = encodeUtf8 <$> P.string
|
|
|
|
columnParser' ::
|
|
MonadBuildSchema 'MySQL r m n =>
|
|
ColumnType 'MySQL ->
|
|
GQL.Nullability ->
|
|
SchemaT r m (Parser 'Both n (ValueWithOrigin (ColumnValue 'MySQL)))
|
|
columnParser' columnType nullability =
|
|
peelWithOrigin . fmap (ColumnValue columnType) <$> case columnType of
|
|
ColumnScalar scalarType -> case scalarType of
|
|
MySQL.Decimal -> pure $ possiblyNullable' scalarType nullability $ MySQL.DecimalValue <$> P.float
|
|
MySQL.Tiny -> pure $ possiblyNullable' scalarType nullability $ MySQL.TinyValue <$> P.int
|
|
MySQL.Short -> pure $ possiblyNullable' scalarType nullability $ MySQL.SmallValue <$> P.int
|
|
MySQL.Long -> pure $ possiblyNullable' scalarType nullability $ MySQL.IntValue <$> P.int
|
|
MySQL.Float -> pure $ possiblyNullable' scalarType nullability $ MySQL.FloatValue <$> P.float
|
|
MySQL.Double -> pure $ possiblyNullable' scalarType nullability $ MySQL.DoubleValue <$> P.float
|
|
MySQL.Null -> pure $ possiblyNullable' scalarType nullability $ MySQL.NullValue <$ P.string
|
|
MySQL.LongLong -> pure $ possiblyNullable' scalarType nullability $ MySQL.BigValue <$> P.int
|
|
MySQL.Int24 -> pure $ possiblyNullable' scalarType nullability $ MySQL.MediumValue <$> P.int
|
|
MySQL.Date -> pure $ possiblyNullable' scalarType nullability $ MySQL.DateValue <$> P.string
|
|
MySQL.Year -> pure $ possiblyNullable' scalarType nullability $ MySQL.YearValue <$> P.string
|
|
MySQL.Bit -> pure $ possiblyNullable' scalarType nullability $ MySQL.BitValue <$> P.boolean
|
|
MySQL.String -> pure $ possiblyNullable' scalarType nullability $ MySQL.VarcharValue <$> P.string
|
|
MySQL.VarChar -> pure $ possiblyNullable' scalarType nullability $ MySQL.VarcharValue <$> P.string
|
|
MySQL.DateTime -> pure $ possiblyNullable' scalarType nullability $ MySQL.DatetimeValue <$> P.string
|
|
MySQL.Blob -> pure $ possiblyNullable' scalarType nullability $ MySQL.BlobValue <$> bsParser
|
|
MySQL.Timestamp -> pure $ possiblyNullable' scalarType nullability $ MySQL.TimestampValue <$> P.string
|
|
_ -> do
|
|
name <- MySQL.mkMySQLScalarTypeName scalarType
|
|
let schemaType = P.TNamed P.NonNullable $ P.Definition name Nothing Nothing [] P.TIScalar
|
|
pure $
|
|
P.Parser
|
|
{ pType = schemaType,
|
|
pParser =
|
|
P.valueToJSON (P.toGraphQLType schemaType)
|
|
>=> either (P.parseErrorWith P.ParseFailed . toErrorMessage . qeError) pure . (MySQL.parseScalarValue scalarType)
|
|
}
|
|
ColumnEnumReference (EnumReference tableName enumValues customTableName) ->
|
|
case nonEmpty (HM.toList enumValues) of
|
|
Just enumValuesList -> enumParser' tableName enumValuesList customTableName nullability
|
|
Nothing -> throw400 ValidationFailed "empty enum values"
|
|
|
|
enumParser' ::
|
|
MonadBuildSchema 'MySQL r m n =>
|
|
TableName 'MySQL ->
|
|
NonEmpty (EnumValue, EnumValueInfo) ->
|
|
Maybe GQL.Name ->
|
|
GQL.Nullability ->
|
|
SchemaT r m (Parser 'Both n (ScalarValue 'MySQL))
|
|
enumParser' tableName enumValues customTableName nullability = do
|
|
enumName <- mkEnumTypeName @'MySQL tableName customTableName
|
|
pure $ possiblyNullable' MySQL.VarChar nullability $ P.enum enumName Nothing (mkEnumValue <$> enumValues)
|
|
where
|
|
mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, RQL.ScalarValue 'MySQL)
|
|
mkEnumValue (RQL.EnumValue value, EnumValueInfo description) =
|
|
( P.Definition value (GQL.Description <$> description) Nothing [] P.EnumValueInfo,
|
|
MySQL.VarcharValue $ GQL.unName value
|
|
)
|
|
|
|
possiblyNullable' ::
|
|
(MonadParse m) =>
|
|
ScalarType 'MySQL ->
|
|
GQL.Nullability ->
|
|
Parser 'Both m (ScalarValue 'MySQL) ->
|
|
Parser 'Both m (ScalarValue 'MySQL)
|
|
possiblyNullable' _scalarType (GQL.Nullability isNullable)
|
|
| isNullable = fmap (fromMaybe MySQL.NullValue) . P.nullable
|
|
| otherwise = id
|
|
|
|
orderByOperators' :: NamingCase -> (GQL.Name, NonEmpty (P.Definition P.EnumValueInfo, (BasicOrderType 'MySQL, NullsOrderType 'MySQL)))
|
|
orderByOperators' _tCase =
|
|
(Name._order_by,) $
|
|
-- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
|
|
NE.fromList
|
|
[ ( define Name._asc "in ascending order, nulls first",
|
|
(MySQL.Asc, MySQL.NullsFirst)
|
|
),
|
|
( define Name._asc_nulls_first "in ascending order, nulls first",
|
|
(MySQL.Asc, MySQL.NullsFirst)
|
|
),
|
|
( define Name._asc_nulls_last "in ascending order, nulls last",
|
|
(MySQL.Asc, MySQL.NullsLast)
|
|
),
|
|
( define Name._desc "in descending order, nulls last",
|
|
(MySQL.Desc, MySQL.NullsLast)
|
|
),
|
|
( define Name._desc_nulls_first "in descending order, nulls first",
|
|
(MySQL.Desc, MySQL.NullsFirst)
|
|
),
|
|
( define Name._desc_nulls_last "in descending order, nulls last",
|
|
(MySQL.Desc, MySQL.NullsLast)
|
|
)
|
|
]
|
|
where
|
|
define name desc = P.Definition name (Just desc) Nothing [] P.EnumValueInfo
|
|
|
|
-- | TODO: Make this as thorough as the one for MSSQL/PostgreSQL
|
|
comparisonExps' ::
|
|
forall m n r.
|
|
MonadBuildSchema 'MySQL r m n =>
|
|
ColumnType 'MySQL ->
|
|
SchemaT r m (Parser 'Input n [ComparisonExp 'MySQL])
|
|
comparisonExps' = P.memoize 'comparisonExps $ \columnType -> do
|
|
-- see Note [Columns in comparison expression are never nullable]
|
|
typedParser <- columnParser columnType (GQL.Nullability False)
|
|
let name = P.getName typedParser <> Name.__MySQL_comparison_exp
|
|
desc =
|
|
GQL.Description $
|
|
"Boolean expression to compare columns of type "
|
|
<> P.getName typedParser
|
|
<<> ". All fields are combined with logical 'AND'."
|
|
pure $
|
|
P.object name (Just desc) $
|
|
catMaybes
|
|
<$> sequenceA
|
|
[ P.fieldOptional Name.__is_null Nothing (bool ANISNOTNULL ANISNULL <$> P.boolean),
|
|
P.fieldOptional Name.__eq Nothing (AEQ True . mkParameter <$> typedParser),
|
|
P.fieldOptional Name.__neq Nothing (ANE True . mkParameter <$> typedParser),
|
|
P.fieldOptional Name.__gt Nothing (AGT . mkParameter <$> typedParser),
|
|
P.fieldOptional Name.__lt Nothing (ALT . mkParameter <$> typedParser),
|
|
P.fieldOptional Name.__gte Nothing (AGTE . mkParameter <$> typedParser),
|
|
P.fieldOptional Name.__lte Nothing (ALTE . mkParameter <$> typedParser)
|
|
]
|
|
|
|
mysqlCountTypeInput ::
|
|
MonadParse n =>
|
|
Maybe (Parser 'Both n (Column 'MySQL)) ->
|
|
InputFieldsParser n (IR.CountDistinct -> CountType 'MySQL)
|
|
mysqlCountTypeInput = \case
|
|
Just columnEnum -> do
|
|
columns <- P.fieldOptional Name._columns Nothing $ P.list columnEnum
|
|
pure $ flip mkCountType columns
|
|
Nothing -> pure $ flip mkCountType Nothing
|
|
where
|
|
mkCountType :: IR.CountDistinct -> Maybe [Column 'MySQL] -> CountType 'MySQL
|
|
mkCountType _ Nothing = MySQL.StarCountable
|
|
mkCountType IR.SelectCountDistinct (Just cols) =
|
|
maybe MySQL.StarCountable MySQL.DistinctCountable $ nonEmpty cols
|
|
mkCountType IR.SelectCountNonDistinct (Just cols) =
|
|
maybe MySQL.StarCountable MySQL.NonNullFieldCountable $ nonEmpty cols
|