hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-18 13:02:11 +03:00
Code Issues Projects Releases Wiki Activity
cdac24c79f
graphql-engine/server/src-lib/Hasura/Backends/DataConnector/Adapter/Backend.hs
Auke Booij cdac24c79f server: delete the Cacheable type class in favor of Eq 
What is the `Cacheable` type class about?
```haskell
class Eq a => Cacheable a where
  unchanged :: Accesses -> a -> a -> Bool
  default unchanged :: (Generic a, GCacheable (Rep a)) => Accesses -> a -> a -> Bool
  unchanged accesses a b = gunchanged (from a) (from b) accesses
```
Its only method is an alternative to `(==)`. The added value of `unchanged` (and the additional `Accesses` argument) arises _only_ for one type, namely `Dependency`. Indeed, the `Cacheable (Dependency a)` instance is non-trivial, whereas every other `Cacheable` instance is completely boilerplate (and indeed either generated from `Generic`, or simply `unchanged _ = (==)`). The `Cacheable (Dependency a)` instance is the only one where the `Accesses` argument is not just passed onwards.

The only callsite of the `unchanged` method is in the `ArrowCache (Rule m)` method. That is to say that the `Cacheable` type class is used to decide when we can re-use parts of the schema cache between Metadata operations.

So what is the `Cacheable (Dependency a)` instance about? Normally, the output of a `Rule m a b` is re-used when the new input (of type `a`) is equal to the old one. But sometimes, that's too coarse: it might be that a certain `Rule m a b` only depends on a small part of its input of type `a`. A `Dependency` allows us to spell out what parts of `a` are being depended on, and these parts are recorded as values of types `Access a` in the state `Accesses`.

If the input `a` changes, but not in a way that touches the recorded `Accesses`, then the output `b` of that rule can be re-used without recomputing.

So now you understand _why_ we're passing `Accesses` to the `unchanged` method: `unchanged` is an equality check in disguise that just needs some additional context.

But we don't need to pass `Accesses` as a function argument. We can use the `reflection` package to pass it as type-level context. So the core of this PR is that we change the instance declaration from
```haskell
instance (Cacheable a) => Cacheable (Dependency a) where
```
to
```haskell
 instance (Given Accesses, Eq a) => Eq (Dependency a) where
```
and use `(==)` instead of `unchanged`.

If you haven't seen `reflection` before: it's like a `MonadReader`, but it doesn't require a `Monad`.

In order to pass the current `Accesses` value, instead of simply passing the `Accesses` as a function argument, we need to instantiate the `Given Accesses` context. We use the `give` method from the `reflection` package for that.
```haskell
give :: forall r. Accesses -> (Given Accesses => r) -> r

unchanged :: (Given Accesses => Eq a) => Accesses -> a -> a -> Bool
unchanged accesses a b = give accesses (a == b)
```
With these three components in place, we can delete the `Cacheable` type class entirely.

The remainder of this PR is just to remove the `Cacheable` type class and its instances.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6877
GitOrigin-RevId: 7125f5e11d856e7672ab810a23d5bf5ad176e77f
2022-11-21 16:35:37 +00:00

185 lines
8.3 KiB
Haskell
Raw Blame History

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.DataConnector.Adapter.Backend
( CustomBooleanOperator (..),
columnTypeToScalarType,
)
where
import Data.Aeson qualified as J
import Data.Aeson.Extended (ToJSONKeyValue (..))
import Data.Aeson.Key (fromText)
import Data.Aeson.Types qualified as J
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text qualified as Text
import Data.Text.Casing qualified as C
import Data.Text.Extended ((<<>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Types qualified as Adapter
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
import Hasura.Base.Error (Code (ValidationFailed), QErr, runAesonParser, throw400)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend (Backend (..), ComputedFieldReturnType, SupportedNamingCase (..), XDisable, XEnable)
import Hasura.RQL.Types.Column (ColumnType (..))
import Hasura.RQL.Types.ResizePool (ServerReplicas)
import Hasura.SQL.Backend (BackendType (DataConnector))
import Language.GraphQL.Draft.Syntax qualified as G
import Witch qualified
-- | An alias for '()' indicating that a particular associated type has not yet
-- been implemented for the 'DataConnector' backend.
--
-- '()' is used (rather than a type with an empty data constructor) because it
-- comes with many of the instances that these associated types require.
--
-- This alias should /not/ be exported from this module, and it's only defined
-- for clarity.
type Unimplemented = ()
instance Backend 'DataConnector where
type BackendConfig 'DataConnector = InsOrdHashMap DC.DataConnectorName DC.DataConnectorOptions
type BackendInfo 'DataConnector = HashMap DC.DataConnectorName DC.DataConnectorInfo
type SourceConfig 'DataConnector = DC.SourceConfig
type SourceConnConfiguration 'DataConnector = DC.ConnSourceConfig
type TableName 'DataConnector = DC.TableName
type FunctionName 'DataConnector = DC.FunctionName
type RawFunctionInfo 'DataConnector = XDisable
type FunctionArgument 'DataConnector = XDisable
type ConstraintName 'DataConnector = DC.ConstraintName
type BasicOrderType 'DataConnector = DC.OrderDirection
type NullsOrderType 'DataConnector = Unimplemented
type CountType 'DataConnector = DC.CountAggregate
type Column 'DataConnector = DC.ColumnName
type ScalarValue 'DataConnector = J.Value
type ScalarType 'DataConnector = DC.ScalarType
-- This does not actually have to be the full IR Expression, in fact it is only
-- required to represent literals, so we use a special type for that.
-- The 'SQLExpression' type family should be removed in a future refactor
type SQLExpression 'DataConnector = DC.Literal
type ScalarSelectionArguments 'DataConnector = Void
type BooleanOperators 'DataConnector = CustomBooleanOperator
type ExtraTableMetadata 'DataConnector = Unimplemented
type ComputedFieldDefinition 'DataConnector = Unimplemented
type FunctionArgumentExp 'DataConnector = Const Unimplemented
type ComputedFieldImplicitArguments 'DataConnector = Unimplemented
type ComputedFieldReturn 'DataConnector = Unimplemented
type XComputedField 'DataConnector = XDisable
type XRelay 'DataConnector = XDisable
type XNodesAgg 'DataConnector = XEnable
type XNestedInserts 'DataConnector = XDisable
type XStreamingSubscription 'DataConnector = XDisable
type HealthCheckTest 'DataConnector = Void
isComparableType :: ScalarType 'DataConnector -> Bool
isComparableType = \case
DC.NumberTy -> True
DC.StringTy -> True
DC.BoolTy -> False
DC.CustomTy _ -> False
isNumType :: ScalarType 'DataConnector -> Bool
isNumType DC.NumberTy = True
isNumType _ = False
getCustomAggregateOperators :: Adapter.SourceConfig -> HashMap G.Name (HashMap DC.ScalarType DC.ScalarType)
getCustomAggregateOperators Adapter.SourceConfig {..} =
HashMap.foldrWithKey insertOps mempty scalarTypesCapabilities
where
scalarTypesCapabilities = API.unScalarTypesCapabilities $ API._cScalarTypes _scCapabilities
insertOps typeName API.ScalarTypeCapabilities {..} m =
HashMap.foldrWithKey insertOp m $
API.unAggregateFunctions _stcAggregateFunctions
where
insertOp funtionName resultTypeName =
HashMap.insertWith HashMap.union funtionName $
HashMap.singleton (Witch.from typeName) (Witch.from resultTypeName)
textToScalarValue :: Maybe Text -> ScalarValue 'DataConnector
textToScalarValue = error "textToScalarValue: not implemented for the Data Connector backend."
parseScalarValue :: ScalarType 'DataConnector -> J.Value -> Either QErr (ScalarValue 'DataConnector)
parseScalarValue type' value = runAesonParser (parseValue type') value
scalarValueToJSON :: ScalarValue 'DataConnector -> J.Value
scalarValueToJSON = error "scalarValueToJSON: not implemented for the Data Connector backend."
functionToTable :: FunctionName 'DataConnector -> TableName 'DataConnector
functionToTable = error "functionToTable: not implemented for the Data Connector backend."
computedFieldFunction :: ComputedFieldDefinition 'DataConnector -> FunctionName 'DataConnector
computedFieldFunction = error "computedFieldFunction: not implemented for the Data Connector backend"
computedFieldReturnType :: ComputedFieldReturn 'DataConnector -> ComputedFieldReturnType 'DataConnector
computedFieldReturnType = error "computedFieldReturnType: not implemented for the Data Connector backend"
fromComputedFieldImplicitArguments :: v -> ComputedFieldImplicitArguments 'DataConnector -> [FunctionArgumentExp 'DataConnector v]
fromComputedFieldImplicitArguments = error "fromComputedFieldImplicitArguments: not implemented for the Data Connector backend"
-- phil said this was cursed
tableToFunction :: TableName 'DataConnector -> FunctionName 'DataConnector
tableToFunction = coerce
tableGraphQLName :: TableName 'DataConnector -> Either QErr G.Name
tableGraphQLName name = do
let snakedName = snakeCaseTableName @'DataConnector name
G.mkName snakedName
`onNothing` throw400 ValidationFailed ("TableName " <> snakedName <> " is not a valid GraphQL identifier")
functionGraphQLName :: FunctionName 'DataConnector -> Either QErr G.Name
functionGraphQLName = error "functionGraphQLName: not implemented for the Data Connector backend."
snakeCaseTableName :: TableName 'DataConnector -> Text
snakeCaseTableName = Text.intercalate "_" . NonEmpty.toList . DC.unTableName
getTableIdentifier :: TableName 'DataConnector -> Either QErr C.GQLNameIdentifier
getTableIdentifier name@(DC.TableName (prefix :| suffixes)) =
let identifier = do
namePrefix <- G.mkName prefix
nameSuffixes <- traverse G.mkNameSuffix suffixes
pure $ C.fromAutogeneratedTuple (namePrefix, nameSuffixes)
in identifier
`onNothing` throw400 ValidationFailed ("TableName " <> name <<> " is not a valid GraphQL identifier")
namingConventionSupport :: SupportedNamingCase
namingConventionSupport = OnlyHasuraCase
resizeSourcePools :: SourceConfig 'DataConnector -> ServerReplicas -> IO ()
resizeSourcePools _sourceConfig _serverReplicas =
-- Data connectors do not have concept of connection pools
pure ()
data CustomBooleanOperator a = CustomBooleanOperator
{ _cboName :: Text,
_cboRHS :: Maybe (Either (RootOrCurrentColumn 'DataConnector) a) -- TODO turn Either into a specific type
}
deriving stock (Eq, Generic, Foldable, Functor, Traversable, Show)
instance NFData a => NFData (CustomBooleanOperator a)
instance Hashable a => Hashable (CustomBooleanOperator a)
instance J.ToJSON a => ToJSONKeyValue (CustomBooleanOperator a) where
toJSONKeyValue CustomBooleanOperator {..} = (fromText _cboName, J.toJSON _cboRHS)
parseValue :: DC.ScalarType -> J.Value -> J.Parser J.Value
parseValue type' val =
case (type', val) of
(_, J.Null) -> pure J.Null
(DC.StringTy, value) -> J.String <$> J.parseJSON value
(DC.BoolTy, value) -> J.Bool <$> J.parseJSON value
(DC.NumberTy, value) -> J.Number <$> J.parseJSON value
-- For custom scalar types we don't know what subset of JSON values
-- they accept, so we just accept any value.
(DC.CustomTy _, value) -> pure value
columnTypeToScalarType :: ColumnType 'DataConnector -> DC.ScalarType
columnTypeToScalarType = \case
ColumnScalar scalarType -> scalarType
ColumnEnumReference _ -> DC.StringTy
Reference in New Issue View Git Blame Copy Permalink