mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
37c65d4395
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6286 GitOrigin-RevId: ef861e6070e667322fb2657166d3d343d6cab4bc
524 lines
19 KiB
Haskell
524 lines
19 KiB
Haskell
{-# LANGUAGE Arrows #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
-- | Dispatch over backends.
|
|
--
|
|
-- = Creating and consuming 'AnyBackend'
|
|
--
|
|
-- Creating a new value of type 'AnyBackend' is done via 'mkAnyBackend'.
|
|
--
|
|
-- Consuming a value of type 'AnyBackend' is done via either 'runAnyBackend' or
|
|
-- any of the dispatch functions ('dispatchAnyBackend', 'dispatchAnyBackend'',
|
|
-- 'dispatchAnyBackend''').
|
|
--
|
|
-- For implementation details, or when trying to understand this module, start
|
|
-- from 'AnyBackend'.
|
|
--
|
|
-- = Backend Architecture
|
|
--
|
|
-- Our multiple backend architecture uses type classes and associated types
|
|
-- in order to share code, such as parsing graphql queries, building
|
|
-- schemas and metadata, while still accounting for the differences between
|
|
-- backends.
|
|
--
|
|
-- Each backend implements the @Backend@ type class from "Hasura.RQL.Types.Backend"
|
|
-- as well as instances for other classes such as @BackendSchema@ from
|
|
-- "Hasura.GraphQL.Schema.Backend", and define the associated types and
|
|
-- functions, such as @ScalarType@ and @parseScalarValue@, which fit the backend.
|
|
--
|
|
-- Whenever one of these associated types (@ScalarType@, @Column@, etc.) are
|
|
-- used, we need to either push the 'BackendType' to our caller (and making our
|
|
-- type @BackendType -> Type@), or use 'AnyBackend' (and allow our type to be
|
|
-- 'Type'). This is particularly useful when we need to store a container of
|
|
-- any backend.
|
|
--
|
|
-- In order to actually program abstractly using type classes, we need the
|
|
-- type class instances to be available for us to use. This module is a trick
|
|
-- to enumerate all supported backends and their respective instances to convince
|
|
-- GHC that they can be used.
|
|
--
|
|
-- = Example usage
|
|
--
|
|
-- As an example of using this module, consider wanting to write a function
|
|
-- that calculates metrics for each source. For example, we want to count
|
|
-- the number of tables each source has.
|
|
--
|
|
-- The @SchemaCache@ (defined in "Hasura.RQL.Types.SchemaCache") holds a hash map
|
|
-- from each source to their information.
|
|
-- The source information is parameterized by the 'BackendType' and is hidden
|
|
-- using an existential type inside 'AnyBackend'. It essentially looks like this:
|
|
--
|
|
-- > data SourceInfo b = ...
|
|
-- >
|
|
-- > type SourceCache = HashMap SourceName (AnyBackend SourceInfo)
|
|
--
|
|
-- Our metrics calculation function cares which backend it receives, but only
|
|
-- for its type class instances so it can call the relevant functions:
|
|
--
|
|
-- > telemetryForSource :: forall (b :: BackendType). SourceInfo b -> TelemetryPayload
|
|
--
|
|
-- In order to apply this function to all backends and return the telemetry payload for each,
|
|
-- we need to map over the hash map and dispatch the function over the relevant backend.
|
|
-- we can do this with 'runBackend':
|
|
--
|
|
-- > telemetries =
|
|
-- > map
|
|
-- > (`runBackend` telemetryForSource)
|
|
-- > (scSources schemaCache)
|
|
--
|
|
-- If we want to be able to extract some information about the backend type
|
|
-- inside @telemetryForSource@, we can do this using 'backendTag':
|
|
--
|
|
-- > let telemetryForSource :: forall (b :: BackendType). HasTag b => SourceInfo b -> TelemetryPayload
|
|
-- > telemetryForSource =
|
|
-- > let dbKind = reify (backendTag @b)
|
|
--
|
|
-- Note that we needed to add the 'HasTag' constraint, which now means we can't use 'runBackend'
|
|
-- because our function has the wrong type (it has an extra constraint).
|
|
-- Instead, we can use 'dispatchAnyBackend' which allows us to have one constraint:
|
|
--
|
|
-- > telemetries =
|
|
-- > fmap
|
|
-- > (\sourceinfo -> (Any.dispatchAnyBackend @HasTag) sourceinfo telemetryForSource)
|
|
-- > (scSources schemaCache)
|
|
--
|
|
-- Note that we had to add the constraint name as a type application, and we had
|
|
-- to explicitly add a lambda instead of using 'flip'.
|
|
module Hasura.SQL.AnyBackend
|
|
( AnyBackend,
|
|
SatisfiesForAllBackends,
|
|
liftTag,
|
|
mkAnyBackend,
|
|
mapBackend,
|
|
traverseBackend,
|
|
dispatchAnyBackend,
|
|
dispatchAnyBackend',
|
|
dispatchAnyBackend'',
|
|
dispatchAnyBackendArrow,
|
|
dispatchAnyBackendWithTwoConstraints,
|
|
mergeAnyBackend,
|
|
unpackAnyBackend,
|
|
composeAnyBackend,
|
|
runBackend,
|
|
parseAnyBackendFromJSON,
|
|
debugAnyBackendToJSON,
|
|
backendSourceKindFromText,
|
|
parseBackendSourceKindFromJSON,
|
|
)
|
|
where
|
|
|
|
import Control.Applicative
|
|
import Control.Arrow.Extended (ArrowChoice)
|
|
import Data.Aeson
|
|
import Data.Aeson.Types (Parser)
|
|
import Data.Kind (Constraint, Type)
|
|
import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
|
|
import Hasura.Incremental (Cacheable)
|
|
import Hasura.Prelude
|
|
import Hasura.SQL.Backend
|
|
import Hasura.SQL.Tag
|
|
import Language.GraphQL.Draft.Syntax qualified as GQL
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Types and constraints
|
|
|
|
-- | Allows storing types of kind @BackendType -> Type@ heterogenously.
|
|
--
|
|
-- Adding a new constructor to 'BackendType' will automatically create a new
|
|
-- constructor here.
|
|
--
|
|
-- Given some type defined as @data T (b :: BackendType) = ...@, we can define
|
|
-- @AnyBackend T@ without mentioning any 'BackendType'.
|
|
--
|
|
-- This is useful for having generic containers of potentially different types
|
|
-- of T. For instance, @SourceCache@ is defined as a
|
|
-- @HashMap SourceName (AnyBackend SourceInfo)@.
|
|
data AnyBackend (i :: BackendType -> Type)
|
|
= PostgresVanillaValue (i ('Postgres 'Vanilla))
|
|
| PostgresCitusValue (i ('Postgres 'Citus))
|
|
| PostgresCockroachValue (i ('Postgres 'Cockroach))
|
|
| MSSQLValue (i 'MSSQL)
|
|
| BigQueryValue (i 'BigQuery)
|
|
| MySQLValue (i 'MySQL)
|
|
| DataConnectorValue (i 'DataConnector)
|
|
deriving (Generic)
|
|
|
|
-- | Generates a constraint for all backends.
|
|
type AllBackendsSatisfy (c :: BackendType -> Constraint) =
|
|
( c ('Postgres 'Vanilla),
|
|
c ('Postgres 'Citus),
|
|
c ('Postgres 'Cockroach),
|
|
c 'MSSQL,
|
|
c 'BigQuery,
|
|
c 'MySQL,
|
|
c 'DataConnector
|
|
)
|
|
|
|
-- | Generates a constraint for a generic type over all backends.
|
|
type SatisfiesForAllBackends
|
|
(i :: BackendType -> Type)
|
|
(c :: Type -> Constraint) =
|
|
( c (i ('Postgres 'Vanilla)),
|
|
c (i ('Postgres 'Citus)),
|
|
c (i ('Postgres 'Cockroach)),
|
|
c (i 'MSSQL),
|
|
c (i 'BigQuery),
|
|
c (i 'MySQL),
|
|
c (i 'DataConnector)
|
|
)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Functions on AnyBackend
|
|
|
|
-- | How to obtain a tag from a runtime value.
|
|
liftTag :: BackendType -> AnyBackend BackendTag
|
|
liftTag (Postgres Vanilla) = PostgresVanillaValue PostgresVanillaTag
|
|
liftTag (Postgres Citus) = PostgresCitusValue PostgresCitusTag
|
|
liftTag (Postgres Cockroach) = PostgresCockroachValue PostgresCockroachTag
|
|
liftTag MSSQL = MSSQLValue MSSQLTag
|
|
liftTag BigQuery = BigQueryValue BigQueryTag
|
|
liftTag MySQL = MySQLValue MySQLTag
|
|
liftTag DataConnector = DataConnectorValue DataConnectorTag
|
|
|
|
-- | Transforms an @AnyBackend i@ into an @AnyBackend j@.
|
|
mapBackend ::
|
|
forall
|
|
(i :: BackendType -> Type)
|
|
(j :: BackendType -> Type).
|
|
AnyBackend i ->
|
|
(forall b. i b -> j b) ->
|
|
AnyBackend j
|
|
mapBackend e f = case e of
|
|
PostgresVanillaValue x -> PostgresVanillaValue (f x)
|
|
PostgresCitusValue x -> PostgresCitusValue (f x)
|
|
PostgresCockroachValue x -> PostgresCockroachValue (f x)
|
|
MSSQLValue x -> MSSQLValue (f x)
|
|
BigQueryValue x -> BigQueryValue (f x)
|
|
MySQLValue x -> MySQLValue (f x)
|
|
DataConnectorValue x -> DataConnectorValue (f x)
|
|
|
|
-- | Traverse an @AnyBackend i@ into an @f (AnyBackend j)@.
|
|
traverseBackend ::
|
|
forall
|
|
(c :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(j :: BackendType -> Type)
|
|
f.
|
|
(AllBackendsSatisfy c, Functor f) =>
|
|
AnyBackend i ->
|
|
(forall b. c b => i b -> f (j b)) ->
|
|
f (AnyBackend j)
|
|
traverseBackend e f = case e of
|
|
PostgresVanillaValue x -> PostgresVanillaValue <$> f x
|
|
PostgresCitusValue x -> PostgresCitusValue <$> f x
|
|
PostgresCockroachValue x -> PostgresCockroachValue <$> f x
|
|
MSSQLValue x -> MSSQLValue <$> f x
|
|
BigQueryValue x -> BigQueryValue <$> f x
|
|
MySQLValue x -> MySQLValue <$> f x
|
|
DataConnectorValue x -> DataConnectorValue <$> f x
|
|
|
|
-- | Creates a new @AnyBackend i@ for a given backend @b@ by wrapping the given @i b@.
|
|
mkAnyBackend ::
|
|
forall
|
|
(b :: BackendType)
|
|
(i :: BackendType -> Type).
|
|
HasTag b =>
|
|
i b ->
|
|
AnyBackend i
|
|
mkAnyBackend x = case backendTag @b of
|
|
PostgresVanillaTag -> PostgresVanillaValue x
|
|
PostgresCitusTag -> PostgresCitusValue x
|
|
PostgresCockroachTag -> PostgresCockroachValue x
|
|
MSSQLTag -> MSSQLValue x
|
|
BigQueryTag -> BigQueryValue x
|
|
MySQLTag -> MySQLValue x
|
|
DataConnectorTag -> DataConnectorValue x
|
|
|
|
-- | Dispatch a function to the value inside the @AnyBackend@, that does not
|
|
-- require bringing into scope a new class constraint.
|
|
runBackend ::
|
|
forall
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
AnyBackend i ->
|
|
(forall (b :: BackendType). i b -> r) ->
|
|
r
|
|
runBackend b f = case b of
|
|
PostgresVanillaValue x -> f x
|
|
PostgresCitusValue x -> f x
|
|
PostgresCockroachValue x -> f x
|
|
MSSQLValue x -> f x
|
|
BigQueryValue x -> f x
|
|
MySQLValue x -> f x
|
|
DataConnectorValue x -> f x
|
|
|
|
-- | Dispatch an existential using an universally quantified function while
|
|
-- also resolving a different constraint.
|
|
-- Use this to dispatch Backend* instances.
|
|
-- This is essentially a wrapper around @runAnyBackend f . repackAnyBackend \@c@.
|
|
dispatchAnyBackend ::
|
|
forall
|
|
(c :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
AllBackendsSatisfy c =>
|
|
AnyBackend i ->
|
|
(forall (b :: BackendType). c b => i b -> r) ->
|
|
r
|
|
dispatchAnyBackend e f = case e of
|
|
PostgresVanillaValue x -> f x
|
|
PostgresCitusValue x -> f x
|
|
PostgresCockroachValue x -> f x
|
|
MSSQLValue x -> f x
|
|
BigQueryValue x -> f x
|
|
MySQLValue x -> f x
|
|
DataConnectorValue x -> f x
|
|
|
|
dispatchAnyBackendWithTwoConstraints ::
|
|
forall
|
|
(c1 :: BackendType -> Constraint)
|
|
(c2 :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
AllBackendsSatisfy c1 =>
|
|
AllBackendsSatisfy c2 =>
|
|
AnyBackend i ->
|
|
(forall (b :: BackendType). c1 b => c2 b => i b -> r) ->
|
|
r
|
|
dispatchAnyBackendWithTwoConstraints e f = case e of
|
|
PostgresVanillaValue x -> f x
|
|
PostgresCitusValue x -> f x
|
|
PostgresCockroachValue x -> f x
|
|
MSSQLValue x -> f x
|
|
BigQueryValue x -> f x
|
|
MySQLValue x -> f x
|
|
DataConnectorValue x -> f x
|
|
|
|
-- | Unlike 'dispatchAnyBackend', the expected constraint has a different kind.
|
|
-- Use for classes like 'Show', 'ToJSON', etc.
|
|
dispatchAnyBackend' ::
|
|
forall
|
|
(c :: Type -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
i `SatisfiesForAllBackends` c =>
|
|
AnyBackend i ->
|
|
(forall (b :: BackendType). c (i b) => i b -> r) ->
|
|
r
|
|
dispatchAnyBackend' e f = case e of
|
|
PostgresVanillaValue x -> f x
|
|
PostgresCitusValue x -> f x
|
|
PostgresCockroachValue x -> f x
|
|
MSSQLValue x -> f x
|
|
BigQueryValue x -> f x
|
|
MySQLValue x -> f x
|
|
DataConnectorValue x -> f x
|
|
|
|
-- | This allows you to apply a constraint to the Backend instances (c2)
|
|
-- as well as a constraint on the higher-kinded @i b@ type (c1)
|
|
dispatchAnyBackend'' ::
|
|
forall
|
|
(c1 :: Type -> Constraint)
|
|
(c2 :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
i `SatisfiesForAllBackends` c1 =>
|
|
AllBackendsSatisfy c2 =>
|
|
AnyBackend i ->
|
|
(forall (b :: BackendType). c2 b => c1 (i b) => i b -> r) ->
|
|
r
|
|
dispatchAnyBackend'' e f = case e of
|
|
PostgresVanillaValue x -> f x
|
|
PostgresCitusValue x -> f x
|
|
PostgresCockroachValue x -> f x
|
|
MSSQLValue x -> f x
|
|
BigQueryValue x -> f x
|
|
MySQLValue x -> f x
|
|
DataConnectorValue x -> f x
|
|
|
|
-- | Sometimes we need to run operations on two backends of the same type.
|
|
-- If the backends don't contain the same type, the given @r@ value is returned.
|
|
-- Otherwise, the function is called with the two wrapped values.
|
|
composeAnyBackend ::
|
|
forall
|
|
(c :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type).
|
|
AllBackendsSatisfy c =>
|
|
(forall (b :: BackendType). c b => i b -> i b -> r) ->
|
|
AnyBackend i ->
|
|
AnyBackend i ->
|
|
r ->
|
|
r
|
|
composeAnyBackend f e1 e2 owise = case (e1, e2) of
|
|
(PostgresVanillaValue x, PostgresVanillaValue y) -> f x y
|
|
(PostgresCitusValue x, PostgresCitusValue y) -> f x y
|
|
(PostgresCockroachValue x, PostgresCockroachValue y) -> f x y
|
|
(MSSQLValue x, MSSQLValue y) -> f x y
|
|
(BigQueryValue x, BigQueryValue y) -> f x y
|
|
(MySQLValue x, MySQLValue y) -> f x y
|
|
(DataConnectorValue x, DataConnectorValue y) -> f x y
|
|
(value1, value2) ->
|
|
if mapBackend value1 (Const . const ()) == mapBackend value2 (Const . const ())
|
|
then error "Programming error: missing case in composeAnyBackend"
|
|
else owise
|
|
|
|
-- | Merge two matching backends, falling back on a default.
|
|
mergeAnyBackend ::
|
|
forall
|
|
(c :: Type -> Constraint)
|
|
(i :: BackendType -> Type).
|
|
i `SatisfiesForAllBackends` c =>
|
|
(forall (b :: BackendType). c (i b) => i b -> i b -> i b) ->
|
|
AnyBackend i ->
|
|
AnyBackend i ->
|
|
AnyBackend i ->
|
|
AnyBackend i
|
|
mergeAnyBackend f e1 e2 owise = case (e1, e2) of
|
|
(PostgresVanillaValue x, PostgresVanillaValue y) -> PostgresVanillaValue (f x y)
|
|
(PostgresCitusValue x, PostgresCitusValue y) -> PostgresCitusValue (f x y)
|
|
(PostgresCockroachValue x, PostgresCockroachValue y) -> PostgresCockroachValue (f x y)
|
|
(MSSQLValue x, MSSQLValue y) -> MSSQLValue (f x y)
|
|
(BigQueryValue x, BigQueryValue y) -> BigQueryValue (f x y)
|
|
(MySQLValue x, MySQLValue y) -> MySQLValue (f x y)
|
|
(DataConnectorValue x, DataConnectorValue y) -> DataConnectorValue (f x y)
|
|
(value1, value2) ->
|
|
if mapBackend value1 (Const . const ()) == mapBackend value2 (Const . const ())
|
|
then error "Programming error: missing case in mergeAnyBackend"
|
|
else owise
|
|
|
|
-- | Try to unpack the type of an existential.
|
|
-- Returns @Just x@ upon a succesful match, @Nothing@ otherwise.
|
|
unpackAnyBackend ::
|
|
forall
|
|
(b :: BackendType)
|
|
(i :: BackendType -> Type).
|
|
HasTag b =>
|
|
AnyBackend i ->
|
|
Maybe (i b)
|
|
unpackAnyBackend exists = case (backendTag @b, exists) of
|
|
(PostgresVanillaTag, PostgresVanillaValue x) -> Just x
|
|
(PostgresCitusTag, PostgresCitusValue x) -> Just x
|
|
(PostgresCockroachTag, PostgresCockroachValue x) -> Just x
|
|
(MSSQLTag, MSSQLValue x) -> Just x
|
|
(BigQueryTag, BigQueryValue x) -> Just x
|
|
(MySQLTag, MySQLValue x) -> Just x
|
|
(DataConnectorTag, DataConnectorValue x) -> Just x
|
|
(tag, value) ->
|
|
if mapBackend (mkAnyBackend tag) (Const . const ()) == mapBackend value (Const . const ())
|
|
then error "Programming error: missing case in unpackAnyBackend"
|
|
else Nothing
|
|
|
|
--------------------------------------------------------------------------------
|
|
--
|
|
|
|
-- * Special case for arrows
|
|
|
|
-- | Dispatch variant for use with arrow syntax.
|
|
--
|
|
-- NOTE: The below function accepts two constraints, if the arrow
|
|
-- you want to dispatch only has one constraint then repeat the constraint twice.
|
|
-- For example:
|
|
--
|
|
-- > AB.dispatchAnyBackendArrow @BackendMetadata @BackendMetadata (proc (sourceMetadata, invalidationKeys)
|
|
dispatchAnyBackendArrow ::
|
|
forall
|
|
(c1 :: BackendType -> Constraint)
|
|
(c2 :: BackendType -> Constraint)
|
|
(i :: BackendType -> Type)
|
|
(r :: Type)
|
|
(arr :: Type -> Type -> Type)
|
|
x.
|
|
(ArrowChoice arr, AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
|
|
(forall b. c1 b => c2 b => arr (i b, x) r) ->
|
|
arr (AnyBackend i, x) r
|
|
dispatchAnyBackendArrow arrow = proc (ab, x) -> do
|
|
case ab of
|
|
PostgresVanillaValue val ->
|
|
arrow @('Postgres 'Vanilla) -< (val, x)
|
|
PostgresCitusValue val ->
|
|
arrow @('Postgres 'Citus) -< (val, x)
|
|
PostgresCockroachValue val ->
|
|
arrow @('Postgres 'Cockroach) -< (val, x)
|
|
MSSQLValue val ->
|
|
arrow @'MSSQL -< (val, x)
|
|
BigQueryValue val ->
|
|
arrow @'BigQuery -< (val, x)
|
|
MySQLValue val ->
|
|
arrow @'MySQL -< (val, x)
|
|
DataConnectorValue val ->
|
|
arrow @'DataConnector -< (val, x)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * JSON functions
|
|
|
|
-- | Attempts to parse an 'AnyBackend' from a JSON value, using the provided
|
|
-- backend information.
|
|
parseAnyBackendFromJSON ::
|
|
i `SatisfiesForAllBackends` FromJSON =>
|
|
BackendType ->
|
|
Value ->
|
|
Parser (AnyBackend i)
|
|
parseAnyBackendFromJSON backendKind value = case backendKind of
|
|
Postgres Vanilla -> PostgresVanillaValue <$> parseJSON value
|
|
Postgres Citus -> PostgresCitusValue <$> parseJSON value
|
|
Postgres Cockroach -> PostgresCockroachValue <$> parseJSON value
|
|
MSSQL -> MSSQLValue <$> parseJSON value
|
|
BigQuery -> BigQueryValue <$> parseJSON value
|
|
MySQL -> MySQLValue <$> parseJSON value
|
|
DataConnector -> DataConnectorValue <$> parseJSON value
|
|
|
|
-- | Outputs a debug JSON value from an 'AnyBackend'. This function must only be
|
|
-- used for debug purposes, as it has no way of inserting the backend kind in
|
|
-- the output, since there's no guarantee that the output will be an object.
|
|
debugAnyBackendToJSON ::
|
|
i `SatisfiesForAllBackends` ToJSON =>
|
|
AnyBackend i ->
|
|
Value
|
|
debugAnyBackendToJSON e = dispatchAnyBackend' @ToJSON e toJSON
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- * Instances for 'AnyBackend'
|
|
|
|
deriving instance i `SatisfiesForAllBackends` Show => Show (AnyBackend i)
|
|
|
|
deriving instance i `SatisfiesForAllBackends` Eq => Eq (AnyBackend i)
|
|
|
|
deriving instance i `SatisfiesForAllBackends` Ord => Ord (AnyBackend i)
|
|
|
|
instance i `SatisfiesForAllBackends` Hashable => Hashable (AnyBackend i)
|
|
|
|
instance i `SatisfiesForAllBackends` Cacheable => Cacheable (AnyBackend i)
|
|
|
|
backendSourceKindFromText :: Text -> Maybe (AnyBackend BackendSourceKind)
|
|
backendSourceKindFromText text =
|
|
PostgresVanillaValue <$> staticKindFromText PostgresVanillaKind
|
|
<|> PostgresCitusValue <$> staticKindFromText PostgresCitusKind
|
|
<|> PostgresCockroachValue <$> staticKindFromText PostgresCockroachKind
|
|
<|> MSSQLValue <$> staticKindFromText MSSQLKind
|
|
<|> BigQueryValue <$> staticKindFromText BigQueryKind
|
|
<|> MySQLValue <$> staticKindFromText MySQLKind
|
|
-- IMPORTANT: This must be the last thing here, since it will accept (almost) any string
|
|
<|> DataConnectorValue . DataConnectorKind . DataConnectorName <$> GQL.mkName text
|
|
where
|
|
staticKindFromText :: BackendSourceKind b -> Maybe (BackendSourceKind b)
|
|
staticKindFromText kind =
|
|
if text `elem` backendTextNames (backendTypeFromBackendSourceKind kind)
|
|
then Just kind
|
|
else Nothing
|
|
|
|
parseBackendSourceKindFromJSON :: Value -> Parser (AnyBackend BackendSourceKind)
|
|
parseBackendSourceKindFromJSON value =
|
|
PostgresVanillaValue <$> parseJSON @(BackendSourceKind ('Postgres 'Vanilla)) value
|
|
<|> PostgresCitusValue <$> parseJSON @(BackendSourceKind ('Postgres 'Citus)) value
|
|
<|> PostgresCockroachValue <$> parseJSON @(BackendSourceKind ('Postgres 'Cockroach)) value
|
|
<|> MSSQLValue <$> parseJSON @(BackendSourceKind ('MSSQL)) value
|
|
<|> BigQueryValue <$> parseJSON @(BackendSourceKind ('BigQuery)) value
|
|
<|> MySQLValue <$> parseJSON @(BackendSourceKind ('MySQL)) value
|
|
-- IMPORTANT: This must the last thing here, since it will accept (almost) any string
|
|
<|> DataConnectorValue <$> parseJSON @(BackendSourceKind ('DataConnector)) value
|