{-# 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,
    lowerTag,
    mkAnyBackend,
    mapBackend,
    traverseBackend,
    dispatchAnyBackend,
    dispatchAnyBackend',
    dispatchAnyBackend'',
    dispatchAnyBackendArrow,
    dispatchAnyBackendWithTwoConstraints,
    mergeAnyBackend,
    unpackAnyBackend,
    composeAnyBackend,
    runBackend,
    parseAnyBackendFromJSON,
    anyBackendCodec,
    debugAnyBackendToJSON,
    backendSourceKindFromText,
    parseBackendSourceKindFromJSON,
  )
where

import Autodocodec (HasCodec (codec), JSONCodec, dimapCodec)
import Control.Applicative
import Control.Arrow.Extended (ArrowChoice)
import Control.Lens (preview, _Right)
import Data.Aeson
import Data.Aeson.Extended
import Data.Aeson.Key qualified as Key
import Data.Aeson.Types (Parser)
import Data.Kind (Constraint, Type)
import Hasura.Prelude
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.DataConnector (mkDataConnectorName)
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)
  | DataConnectorValue (i 'DataConnector)
  deriving ((forall x. AnyBackend i -> Rep (AnyBackend i) x)
-> (forall x. Rep (AnyBackend i) x -> AnyBackend i)
-> Generic (AnyBackend i)
forall x. Rep (AnyBackend i) x -> AnyBackend i
forall x. AnyBackend i -> Rep (AnyBackend i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (i :: BackendType -> *) x.
Rep (AnyBackend i) x -> AnyBackend i
forall (i :: BackendType -> *) x.
AnyBackend i -> Rep (AnyBackend i) x
$cfrom :: forall (i :: BackendType -> *) x.
AnyBackend i -> Rep (AnyBackend i) x
from :: forall x. AnyBackend i -> Rep (AnyBackend i) x
$cto :: forall (i :: BackendType -> *) x.
Rep (AnyBackend i) x -> AnyBackend i
to :: forall x. Rep (AnyBackend i) x -> AnyBackend i
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 '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 'DataConnector)
  )

--------------------------------------------------------------------------------

-- * Functions on AnyBackend

-- | How to obtain a tag from a runtime value.
liftTag :: BackendType -> AnyBackend BackendTag
liftTag :: BackendType -> AnyBackend BackendTag
liftTag (Postgres PostgresKind
Vanilla) = BackendTag ('Postgres 'Vanilla) -> AnyBackend BackendTag
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue BackendTag ('Postgres 'Vanilla)
PostgresVanillaTag
liftTag (Postgres PostgresKind
Citus) = BackendTag ('Postgres 'Citus) -> AnyBackend BackendTag
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue BackendTag ('Postgres 'Citus)
PostgresCitusTag
liftTag (Postgres PostgresKind
Cockroach) = BackendTag ('Postgres 'Cockroach) -> AnyBackend BackendTag
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue BackendTag ('Postgres 'Cockroach)
PostgresCockroachTag
liftTag BackendType
MSSQL = BackendTag 'MSSQL -> AnyBackend BackendTag
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue BackendTag 'MSSQL
MSSQLTag
liftTag BackendType
BigQuery = BackendTag 'BigQuery -> AnyBackend BackendTag
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue BackendTag 'BigQuery
BigQueryTag
liftTag BackendType
DataConnector = BackendTag 'DataConnector -> AnyBackend BackendTag
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue BackendTag 'DataConnector
DataConnectorTag

-- | Obtain a @BackendType@ from a runtime value.
lowerTag :: AnyBackend i -> BackendType
lowerTag :: forall (i :: BackendType -> *). AnyBackend i -> BackendType
lowerTag (PostgresVanillaValue i ('Postgres 'Vanilla)
_) = PostgresKind -> BackendType
Postgres PostgresKind
Vanilla
lowerTag (PostgresCitusValue i ('Postgres 'Citus)
_) = PostgresKind -> BackendType
Postgres PostgresKind
Citus
lowerTag (PostgresCockroachValue i ('Postgres 'Cockroach)
_) = PostgresKind -> BackendType
Postgres PostgresKind
Cockroach
lowerTag (MSSQLValue i 'MSSQL
_) = BackendType
MSSQL
lowerTag (BigQueryValue i 'BigQuery
_) = BackendType
BigQuery
lowerTag (DataConnectorValue i 'DataConnector
_) = BackendType
DataConnector

-- | 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 :: forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
e forall (b :: BackendType). i b -> j b
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> j ('Postgres 'Vanilla) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (i ('Postgres 'Vanilla) -> j ('Postgres 'Vanilla)
forall (b :: BackendType). i b -> j b
f i ('Postgres 'Vanilla)
x)
  PostgresCitusValue i ('Postgres 'Citus)
x -> j ('Postgres 'Citus) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (i ('Postgres 'Citus) -> j ('Postgres 'Citus)
forall (b :: BackendType). i b -> j b
f i ('Postgres 'Citus)
x)
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> j ('Postgres 'Cockroach) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (i ('Postgres 'Cockroach) -> j ('Postgres 'Cockroach)
forall (b :: BackendType). i b -> j b
f i ('Postgres 'Cockroach)
x)
  MSSQLValue i 'MSSQL
x -> j 'MSSQL -> AnyBackend j
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (i 'MSSQL -> j 'MSSQL
forall (b :: BackendType). i b -> j b
f i 'MSSQL
x)
  BigQueryValue i 'BigQuery
x -> j 'BigQuery -> AnyBackend j
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (i 'BigQuery -> j 'BigQuery
forall (b :: BackendType). i b -> j b
f i 'BigQuery
x)
  DataConnectorValue i 'DataConnector
x -> j 'DataConnector -> AnyBackend j
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (i 'DataConnector -> j 'DataConnector
forall (b :: BackendType). i b -> j b
f i 'DataConnector
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 :: forall (c :: BackendType -> Constraint) (i :: BackendType -> *)
       (j :: BackendType -> *) (f :: * -> *).
(AllBackendsSatisfy c, Functor f) =>
AnyBackend i
-> (forall (b :: BackendType). c b => i b -> f (j b))
-> f (AnyBackend j)
traverseBackend AnyBackend i
e forall (b :: BackendType). c b => i b -> f (j b)
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> j ('Postgres 'Vanilla) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (j ('Postgres 'Vanilla) -> AnyBackend j)
-> f (j ('Postgres 'Vanilla)) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i ('Postgres 'Vanilla) -> f (j ('Postgres 'Vanilla))
forall (b :: BackendType). c b => i b -> f (j b)
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> j ('Postgres 'Citus) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (j ('Postgres 'Citus) -> AnyBackend j)
-> f (j ('Postgres 'Citus)) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i ('Postgres 'Citus) -> f (j ('Postgres 'Citus))
forall (b :: BackendType). c b => i b -> f (j b)
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> j ('Postgres 'Cockroach) -> AnyBackend j
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (j ('Postgres 'Cockroach) -> AnyBackend j)
-> f (j ('Postgres 'Cockroach)) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i ('Postgres 'Cockroach) -> f (j ('Postgres 'Cockroach))
forall (b :: BackendType). c b => i b -> f (j b)
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> j 'MSSQL -> AnyBackend j
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (j 'MSSQL -> AnyBackend j) -> f (j 'MSSQL) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i 'MSSQL -> f (j 'MSSQL)
forall (b :: BackendType). c b => i b -> f (j b)
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> j 'BigQuery -> AnyBackend j
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (j 'BigQuery -> AnyBackend j)
-> f (j 'BigQuery) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i 'BigQuery -> f (j 'BigQuery)
forall (b :: BackendType). c b => i b -> f (j b)
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> j 'DataConnector -> AnyBackend j
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (j 'DataConnector -> AnyBackend j)
-> f (j 'DataConnector) -> f (AnyBackend j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i 'DataConnector -> f (j 'DataConnector)
forall (b :: BackendType). c b => i b -> f (j b)
f i 'DataConnector
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 :: forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend i b
x = case forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b of
  BackendTag b
PostgresVanillaTag -> i ('Postgres 'Vanilla) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue i b
i ('Postgres 'Vanilla)
x
  BackendTag b
PostgresCitusTag -> i ('Postgres 'Citus) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue i b
i ('Postgres 'Citus)
x
  BackendTag b
PostgresCockroachTag -> i ('Postgres 'Cockroach) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue i b
i ('Postgres 'Cockroach)
x
  BackendTag b
MSSQLTag -> i 'MSSQL -> AnyBackend i
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue i b
i 'MSSQL
x
  BackendTag b
BigQueryTag -> i 'BigQuery -> AnyBackend i
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue i b
i 'BigQuery
x
  BackendTag b
DataConnectorTag -> i 'DataConnector -> AnyBackend i
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue i b
i 'DataConnector
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 :: forall (i :: BackendType -> *) r.
AnyBackend i -> (forall (b :: BackendType). i b -> r) -> r
runBackend AnyBackend i
b forall (b :: BackendType). i b -> r
f = case AnyBackend i
b of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). i b -> r
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). i b -> r
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). i b -> r
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> i 'MSSQL -> r
forall (b :: BackendType). i b -> r
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> i 'BigQuery -> r
forall (b :: BackendType). i b -> r
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> i 'DataConnector -> r
forall (b :: BackendType). i b -> r
f i 'DataConnector
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 :: forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
dispatchAnyBackend AnyBackend i
e forall (b :: BackendType). c b => i b -> r
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). c b => i b -> r
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). c b => i b -> r
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). c b => i b -> r
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> i 'MSSQL -> r
forall (b :: BackendType). c b => i b -> r
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> i 'BigQuery -> r
forall (b :: BackendType). c b => i b -> r
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> i 'DataConnector -> r
forall (b :: BackendType). c b => i b -> r
f i 'DataConnector
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 :: forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r.
(AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c1 b, c2 b) => i b -> r) -> r
dispatchAnyBackendWithTwoConstraints AnyBackend i
e forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> i 'MSSQL -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> i 'BigQuery -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> i 'DataConnector -> r
forall (b :: BackendType). (c1 b, c2 b) => i b -> r
f i 'DataConnector
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' :: forall (c :: * -> Constraint) (i :: BackendType -> *) r.
SatisfiesForAllBackends i c =>
AnyBackend i
-> (forall (b :: BackendType). c (i b) => i b -> r) -> r
dispatchAnyBackend' AnyBackend i
e forall (b :: BackendType). c (i b) => i b -> r
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). c (i b) => i b -> r
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). c (i b) => i b -> r
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). c (i b) => i b -> r
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> i 'MSSQL -> r
forall (b :: BackendType). c (i b) => i b -> r
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> i 'BigQuery -> r
forall (b :: BackendType). c (i b) => i b -> r
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> i 'DataConnector -> r
forall (b :: BackendType). c (i b) => i b -> r
f i 'DataConnector
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'' :: forall (c1 :: * -> Constraint) (c2 :: BackendType -> Constraint)
       (i :: BackendType -> *) r.
(SatisfiesForAllBackends i c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r) -> r
dispatchAnyBackend'' AnyBackend i
e forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f = case AnyBackend i
e of
  PostgresVanillaValue i ('Postgres 'Vanilla)
x -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i ('Postgres 'Vanilla)
x
  PostgresCitusValue i ('Postgres 'Citus)
x -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i ('Postgres 'Citus)
x
  PostgresCockroachValue i ('Postgres 'Cockroach)
x -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i ('Postgres 'Cockroach)
x
  MSSQLValue i 'MSSQL
x -> i 'MSSQL -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i 'MSSQL
x
  BigQueryValue i 'BigQuery
x -> i 'BigQuery -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i 'BigQuery
x
  DataConnectorValue i 'DataConnector
x -> i 'DataConnector -> r
forall (b :: BackendType). (c2 b, c1 (i b)) => i b -> r
f i 'DataConnector
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 :: forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
(forall (b :: BackendType). c b => i b -> i b -> r)
-> AnyBackend i -> AnyBackend i -> r -> r
composeAnyBackend forall (b :: BackendType). c b => i b -> i b -> r
f AnyBackend i
e1 AnyBackend i
e2 r
owise = case (AnyBackend i
e1, AnyBackend i
e2) of
  (PostgresVanillaValue i ('Postgres 'Vanilla)
x, PostgresVanillaValue i ('Postgres 'Vanilla)
y) -> i ('Postgres 'Vanilla) -> i ('Postgres 'Vanilla) -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i ('Postgres 'Vanilla)
x i ('Postgres 'Vanilla)
y
  (PostgresCitusValue i ('Postgres 'Citus)
x, PostgresCitusValue i ('Postgres 'Citus)
y) -> i ('Postgres 'Citus) -> i ('Postgres 'Citus) -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i ('Postgres 'Citus)
x i ('Postgres 'Citus)
y
  (PostgresCockroachValue i ('Postgres 'Cockroach)
x, PostgresCockroachValue i ('Postgres 'Cockroach)
y) -> i ('Postgres 'Cockroach) -> i ('Postgres 'Cockroach) -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i ('Postgres 'Cockroach)
x i ('Postgres 'Cockroach)
y
  (MSSQLValue i 'MSSQL
x, MSSQLValue i 'MSSQL
y) -> i 'MSSQL -> i 'MSSQL -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i 'MSSQL
x i 'MSSQL
y
  (BigQueryValue i 'BigQuery
x, BigQueryValue i 'BigQuery
y) -> i 'BigQuery -> i 'BigQuery -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i 'BigQuery
x i 'BigQuery
y
  (DataConnectorValue i 'DataConnector
x, DataConnectorValue i 'DataConnector
y) -> i 'DataConnector -> i 'DataConnector -> r
forall (b :: BackendType). c b => i b -> i b -> r
f i 'DataConnector
x i 'DataConnector
y
  (AnyBackend i
value1, AnyBackend i
value2) ->
    if AnyBackend i
-> (forall (b :: BackendType). i b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
value1 (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b) -> (i b -> ()) -> i b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> i b -> ()
forall a b. a -> b -> a
const ()) AnyBackend (Const ()) -> AnyBackend (Const ()) -> Bool
forall a. Eq a => a -> a -> Bool
== AnyBackend i
-> (forall (b :: BackendType). i b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
value2 (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b) -> (i b -> ()) -> i b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> i b -> ()
forall a b. a -> b -> a
const ())
      then String -> r
forall a. HasCallStack => String -> a
error String
"Programming error: missing case in composeAnyBackend"
      else r
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 :: forall (c :: * -> Constraint) (i :: BackendType -> *).
SatisfiesForAllBackends i c =>
(forall (b :: BackendType). c (i b) => i b -> i b -> i b)
-> AnyBackend i -> AnyBackend i -> AnyBackend i -> AnyBackend i
mergeAnyBackend forall (b :: BackendType). c (i b) => i b -> i b -> i b
f AnyBackend i
e1 AnyBackend i
e2 AnyBackend i
owise = case (AnyBackend i
e1, AnyBackend i
e2) of
  (PostgresVanillaValue i ('Postgres 'Vanilla)
x, PostgresVanillaValue i ('Postgres 'Vanilla)
y) -> i ('Postgres 'Vanilla) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (i ('Postgres 'Vanilla)
-> i ('Postgres 'Vanilla) -> i ('Postgres 'Vanilla)
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i ('Postgres 'Vanilla)
x i ('Postgres 'Vanilla)
y)
  (PostgresCitusValue i ('Postgres 'Citus)
x, PostgresCitusValue i ('Postgres 'Citus)
y) -> i ('Postgres 'Citus) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (i ('Postgres 'Citus)
-> i ('Postgres 'Citus) -> i ('Postgres 'Citus)
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i ('Postgres 'Citus)
x i ('Postgres 'Citus)
y)
  (PostgresCockroachValue i ('Postgres 'Cockroach)
x, PostgresCockroachValue i ('Postgres 'Cockroach)
y) -> i ('Postgres 'Cockroach) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (i ('Postgres 'Cockroach)
-> i ('Postgres 'Cockroach) -> i ('Postgres 'Cockroach)
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i ('Postgres 'Cockroach)
x i ('Postgres 'Cockroach)
y)
  (MSSQLValue i 'MSSQL
x, MSSQLValue i 'MSSQL
y) -> i 'MSSQL -> AnyBackend i
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (i 'MSSQL -> i 'MSSQL -> i 'MSSQL
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i 'MSSQL
x i 'MSSQL
y)
  (BigQueryValue i 'BigQuery
x, BigQueryValue i 'BigQuery
y) -> i 'BigQuery -> AnyBackend i
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (i 'BigQuery -> i 'BigQuery -> i 'BigQuery
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i 'BigQuery
x i 'BigQuery
y)
  (DataConnectorValue i 'DataConnector
x, DataConnectorValue i 'DataConnector
y) -> i 'DataConnector -> AnyBackend i
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (i 'DataConnector -> i 'DataConnector -> i 'DataConnector
forall (b :: BackendType). c (i b) => i b -> i b -> i b
f i 'DataConnector
x i 'DataConnector
y)
  (AnyBackend i
value1, AnyBackend i
value2) ->
    if AnyBackend i
-> (forall (b :: BackendType). i b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
value1 (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b) -> (i b -> ()) -> i b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> i b -> ()
forall a b. a -> b -> a
const ()) AnyBackend (Const ()) -> AnyBackend (Const ()) -> Bool
forall a. Eq a => a -> a -> Bool
== AnyBackend i
-> (forall (b :: BackendType). i b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
value2 (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b) -> (i b -> ()) -> i b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> i b -> ()
forall a b. a -> b -> a
const ())
      then String -> AnyBackend i
forall a. HasCallStack => String -> a
error String
"Programming error: missing case in mergeAnyBackend"
      else AnyBackend i
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 :: forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
unpackAnyBackend AnyBackend i
exists = case (forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b, AnyBackend i
exists) of
  (BackendTag b
PostgresVanillaTag, PostgresVanillaValue i ('Postgres 'Vanilla)
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i ('Postgres 'Vanilla)
x
  (BackendTag b
PostgresCitusTag, PostgresCitusValue i ('Postgres 'Citus)
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i ('Postgres 'Citus)
x
  (BackendTag b
PostgresCockroachTag, PostgresCockroachValue i ('Postgres 'Cockroach)
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i ('Postgres 'Cockroach)
x
  (BackendTag b
MSSQLTag, MSSQLValue i 'MSSQL
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i 'MSSQL
x
  (BackendTag b
BigQueryTag, BigQueryValue i 'BigQuery
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i 'BigQuery
x
  (BackendTag b
DataConnectorTag, DataConnectorValue i 'DataConnector
x) -> i b -> Maybe (i b)
forall a. a -> Maybe a
Just i b
i 'DataConnector
x
  (BackendTag b
tag, AnyBackend i
value) ->
    if AnyBackend BackendTag
-> (forall (b :: BackendType). BackendTag b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend (BackendTag b -> AnyBackend BackendTag
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend BackendTag b
tag) (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b)
-> (BackendTag b -> ()) -> BackendTag b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> BackendTag b -> ()
forall a b. a -> b -> a
const ()) AnyBackend (Const ()) -> AnyBackend (Const ()) -> Bool
forall a. Eq a => a -> a -> Bool
== AnyBackend i
-> (forall (b :: BackendType). i b -> Const () b)
-> AnyBackend (Const ())
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
mapBackend AnyBackend i
value (() -> Const () b
forall {k} a (b :: k). a -> Const a b
Const (() -> Const () b) -> (i b -> ()) -> i b -> Const () b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> i b -> ()
forall a b. a -> b -> a
const ())
      then String -> Maybe (i b)
forall a. HasCallStack => String -> a
error String
"Programming error: missing case in unpackAnyBackend"
      else Maybe (i b)
forall a. Maybe a
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 :: forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r
       (arr :: * -> * -> *) x.
(ArrowChoice arr, AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
(forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r)
-> arr (AnyBackend i, x) r
dispatchAnyBackendArrow forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow = proc (AnyBackend i
ab, x
x) -> do
  case AnyBackend i
ab of
    PostgresVanillaValue i ('Postgres 'Vanilla)
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @('Postgres 'Vanilla) -< (i ('Postgres 'Vanilla)
val, x
x)
    PostgresCitusValue i ('Postgres 'Citus)
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @('Postgres 'Citus) -< (i ('Postgres 'Citus)
val, x
x)
    PostgresCockroachValue i ('Postgres 'Cockroach)
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @('Postgres 'Cockroach) -< (i ('Postgres 'Cockroach)
val, x
x)
    MSSQLValue i 'MSSQL
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @'MSSQL -< (i 'MSSQL
val, x
x)
    BigQueryValue i 'BigQuery
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @'BigQuery -< (i 'BigQuery
val, x
x)
    DataConnectorValue i 'DataConnector
val ->
      forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r
arrow @'DataConnector -< (i 'DataConnector
val, x
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 :: forall (i :: BackendType -> *).
SatisfiesForAllBackends i FromJSON =>
BackendType -> Value -> Parser (AnyBackend i)
parseAnyBackendFromJSON BackendType
backendKind Value
value = case BackendType
backendKind of
  Postgres PostgresKind
Vanilla -> i ('Postgres 'Vanilla) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (i ('Postgres 'Vanilla) -> AnyBackend i)
-> Parser (i ('Postgres 'Vanilla)) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i ('Postgres 'Vanilla))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  Postgres PostgresKind
Citus -> i ('Postgres 'Citus) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (i ('Postgres 'Citus) -> AnyBackend i)
-> Parser (i ('Postgres 'Citus)) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i ('Postgres 'Citus))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  Postgres PostgresKind
Cockroach -> i ('Postgres 'Cockroach) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (i ('Postgres 'Cockroach) -> AnyBackend i)
-> Parser (i ('Postgres 'Cockroach)) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i ('Postgres 'Cockroach))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  BackendType
MSSQL -> i 'MSSQL -> AnyBackend i
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (i 'MSSQL -> AnyBackend i)
-> Parser (i 'MSSQL) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i 'MSSQL)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  BackendType
BigQuery -> i 'BigQuery -> AnyBackend i
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (i 'BigQuery -> AnyBackend i)
-> Parser (i 'BigQuery) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i 'BigQuery)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
  BackendType
DataConnector -> i 'DataConnector -> AnyBackend i
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (i 'DataConnector -> AnyBackend i)
-> Parser (i 'DataConnector) -> Parser (AnyBackend i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (i 'DataConnector)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value

-- | Codec that can be used to decode and encode @AnyBackend i@ values. Throws
-- an error when attempting to encode a value with a mismatched @backendKind@
-- argument.
anyBackendCodec ::
  forall i.
  (i `SatisfiesForAllBackends` HasCodec) =>
  BackendType ->
  JSONCodec (AnyBackend i)
anyBackendCodec :: forall (i :: BackendType -> *).
SatisfiesForAllBackends i HasCodec =>
BackendType -> JSONCodec (AnyBackend i)
anyBackendCodec BackendType
backendKind = case BackendType
backendKind of
  Postgres PostgresKind
Vanilla -> (i ('Postgres 'Vanilla) -> AnyBackend i)
-> (AnyBackend i -> i ('Postgres 'Vanilla))
-> Codec Value (i ('Postgres 'Vanilla)) (i ('Postgres 'Vanilla))
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i ('Postgres 'Vanilla) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (\case (PostgresVanillaValue i ('Postgres 'Vanilla)
v) -> i ('Postgres 'Vanilla)
v; AnyBackend i
_ -> String -> i ('Postgres 'Vanilla)
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i ('Postgres 'Vanilla)) (i ('Postgres 'Vanilla))
 -> JSONCodec (AnyBackend i))
-> Codec Value (i ('Postgres 'Vanilla)) (i ('Postgres 'Vanilla))
-> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i ('Postgres 'Vanilla))
  Postgres PostgresKind
Citus -> (i ('Postgres 'Citus) -> AnyBackend i)
-> (AnyBackend i -> i ('Postgres 'Citus))
-> Codec Value (i ('Postgres 'Citus)) (i ('Postgres 'Citus))
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i ('Postgres 'Citus) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (\case (PostgresCitusValue i ('Postgres 'Citus)
v) -> i ('Postgres 'Citus)
v; AnyBackend i
_ -> String -> i ('Postgres 'Citus)
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i ('Postgres 'Citus)) (i ('Postgres 'Citus))
 -> JSONCodec (AnyBackend i))
-> Codec Value (i ('Postgres 'Citus)) (i ('Postgres 'Citus))
-> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i ('Postgres 'Citus))
  Postgres PostgresKind
Cockroach -> (i ('Postgres 'Cockroach) -> AnyBackend i)
-> (AnyBackend i -> i ('Postgres 'Cockroach))
-> Codec
     Value (i ('Postgres 'Cockroach)) (i ('Postgres 'Cockroach))
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i ('Postgres 'Cockroach) -> AnyBackend i
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (\case (PostgresCockroachValue i ('Postgres 'Cockroach)
v) -> i ('Postgres 'Cockroach)
v; AnyBackend i
_ -> String -> i ('Postgres 'Cockroach)
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i ('Postgres 'Cockroach)) (i ('Postgres 'Cockroach))
 -> JSONCodec (AnyBackend i))
-> Codec
     Value (i ('Postgres 'Cockroach)) (i ('Postgres 'Cockroach))
-> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i ('Postgres 'Cockroach))
  BackendType
MSSQL -> (i 'MSSQL -> AnyBackend i)
-> (AnyBackend i -> i 'MSSQL)
-> Codec Value (i 'MSSQL) (i 'MSSQL)
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i 'MSSQL -> AnyBackend i
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (\case (MSSQLValue i 'MSSQL
v) -> i 'MSSQL
v; AnyBackend i
_ -> String -> i 'MSSQL
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i 'MSSQL) (i 'MSSQL) -> JSONCodec (AnyBackend i))
-> Codec Value (i 'MSSQL) (i 'MSSQL) -> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i 'MSSQL)
  BackendType
BigQuery -> (i 'BigQuery -> AnyBackend i)
-> (AnyBackend i -> i 'BigQuery)
-> Codec Value (i 'BigQuery) (i 'BigQuery)
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i 'BigQuery -> AnyBackend i
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (\case (BigQueryValue i 'BigQuery
v) -> i 'BigQuery
v; AnyBackend i
_ -> String -> i 'BigQuery
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i 'BigQuery) (i 'BigQuery)
 -> JSONCodec (AnyBackend i))
-> Codec Value (i 'BigQuery) (i 'BigQuery)
-> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i 'BigQuery)
  BackendType
DataConnector -> (i 'DataConnector -> AnyBackend i)
-> (AnyBackend i -> i 'DataConnector)
-> Codec Value (i 'DataConnector) (i 'DataConnector)
-> JSONCodec (AnyBackend i)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec i 'DataConnector -> AnyBackend i
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (\case (DataConnectorValue i 'DataConnector
v) -> i 'DataConnector
v; AnyBackend i
_ -> String -> i 'DataConnector
forall a. HasCallStack => String -> a
error String
msg) (Codec Value (i 'DataConnector) (i 'DataConnector)
 -> JSONCodec (AnyBackend i))
-> Codec Value (i 'DataConnector) (i 'DataConnector)
-> JSONCodec (AnyBackend i)
forall a b. (a -> b) -> a -> b
$ forall value. HasCodec value => JSONCodec value
codec @(i 'DataConnector)
  where
    msg :: String
msg = String
"got unexpected backend type indicating anyBackendCodec was called with the wrong backendType 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 :: forall (i :: BackendType -> *).
SatisfiesForAllBackends i ToJSON =>
AnyBackend i -> Value
debugAnyBackendToJSON AnyBackend i
e = forall (c :: * -> Constraint) (i :: BackendType -> *) r.
SatisfiesForAllBackends i c =>
AnyBackend i
-> (forall (b :: BackendType). c (i b) => i b -> r) -> r
dispatchAnyBackend' @ToJSON AnyBackend i
e i b -> Value
forall a. ToJSON a => a -> Value
forall (b :: BackendType). ToJSON (i b) => i b -> Value
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` FromJSON) => FromJSONKeyValue (AnyBackend i) where
  parseJSONKeyValue :: (Key, Value) -> Parser (AnyBackend i)
parseJSONKeyValue (Key
backendTypeStr, Value
value) = do
    BackendType
backendType <- Text -> Parser BackendType
parseBackendTypeFromText (Text -> Parser BackendType) -> Text -> Parser BackendType
forall a b. (a -> b) -> a -> b
$ Key -> Text
Key.toText Key
backendTypeStr
    BackendType -> Value -> Parser (AnyBackend i)
forall (i :: BackendType -> *).
SatisfiesForAllBackends i FromJSON =>
BackendType -> Value -> Parser (AnyBackend i)
parseAnyBackendFromJSON BackendType
backendType Value
value

backendSourceKindFromText :: Text -> Maybe (AnyBackend BackendSourceKind)
backendSourceKindFromText :: Text -> Maybe (AnyBackend BackendSourceKind)
backendSourceKindFromText Text
text =
  BackendSourceKind ('Postgres 'Vanilla)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (BackendSourceKind ('Postgres 'Vanilla)
 -> AnyBackend BackendSourceKind)
-> Maybe (BackendSourceKind ('Postgres 'Vanilla))
-> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind ('Postgres 'Vanilla)
-> Maybe (BackendSourceKind ('Postgres 'Vanilla))
forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind
    Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind ('Postgres 'Citus)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (BackendSourceKind ('Postgres 'Citus)
 -> AnyBackend BackendSourceKind)
-> Maybe (BackendSourceKind ('Postgres 'Citus))
-> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind ('Postgres 'Citus)
-> Maybe (BackendSourceKind ('Postgres 'Citus))
forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind ('Postgres 'Citus)
PostgresCitusKind
    Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind ('Postgres 'Cockroach)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (BackendSourceKind ('Postgres 'Cockroach)
 -> AnyBackend BackendSourceKind)
-> Maybe (BackendSourceKind ('Postgres 'Cockroach))
-> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind ('Postgres 'Cockroach)
-> Maybe (BackendSourceKind ('Postgres 'Cockroach))
forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind ('Postgres 'Cockroach)
PostgresCockroachKind
    Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'MSSQL -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (BackendSourceKind 'MSSQL -> AnyBackend BackendSourceKind)
-> Maybe (BackendSourceKind 'MSSQL)
-> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind 'MSSQL -> Maybe (BackendSourceKind 'MSSQL)
forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind 'MSSQL
MSSQLKind
    Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'BigQuery -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (BackendSourceKind 'BigQuery -> AnyBackend BackendSourceKind)
-> Maybe (BackendSourceKind 'BigQuery)
-> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind 'BigQuery -> Maybe (BackendSourceKind 'BigQuery)
forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind 'BigQuery
BigQueryKind
    -- IMPORTANT: This must be the last thing here, since it will accept (almost) any string
    Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
-> Maybe (AnyBackend BackendSourceKind)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'DataConnector -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (BackendSourceKind 'DataConnector -> AnyBackend BackendSourceKind)
-> (DataConnectorName -> BackendSourceKind 'DataConnector)
-> DataConnectorName
-> AnyBackend BackendSourceKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConnectorName -> BackendSourceKind 'DataConnector
DataConnectorKind (DataConnectorName -> AnyBackend BackendSourceKind)
-> Maybe DataConnectorName -> Maybe (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
  (First DataConnectorName)
  (Either String DataConnectorName)
  DataConnectorName
-> Either String DataConnectorName -> Maybe DataConnectorName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First DataConnectorName)
  (Either String DataConnectorName)
  DataConnectorName
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right (Either String DataConnectorName -> Maybe DataConnectorName)
-> (Name -> Either String DataConnectorName)
-> Name
-> Maybe DataConnectorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Either String DataConnectorName
mkDataConnectorName (Name -> Maybe DataConnectorName)
-> Maybe Name -> Maybe DataConnectorName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Name
GQL.mkName Text
text)
  where
    staticKindFromText :: BackendSourceKind b -> Maybe (BackendSourceKind b)
    staticKindFromText :: forall (b :: BackendType).
BackendSourceKind b -> Maybe (BackendSourceKind b)
staticKindFromText BackendSourceKind b
kind =
      if Text
text Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BackendType -> [Text]
backendTextNames (BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind BackendSourceKind b
kind)
        then BackendSourceKind b -> Maybe (BackendSourceKind b)
forall a. a -> Maybe a
Just BackendSourceKind b
kind
        else Maybe (BackendSourceKind b)
forall a. Maybe a
Nothing

parseBackendSourceKindFromJSON :: Value -> Parser (AnyBackend BackendSourceKind)
parseBackendSourceKindFromJSON :: Value -> Parser (AnyBackend BackendSourceKind)
parseBackendSourceKindFromJSON Value
value =
  BackendSourceKind ('Postgres 'Vanilla)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Vanilla) -> AnyBackend i
PostgresVanillaValue (BackendSourceKind ('Postgres 'Vanilla)
 -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind ('Postgres 'Vanilla))
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('Postgres 'Vanilla)) Value
value
    Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind ('Postgres 'Citus)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Citus) -> AnyBackend i
PostgresCitusValue (BackendSourceKind ('Postgres 'Citus)
 -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind ('Postgres 'Citus))
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('Postgres 'Citus)) Value
value
    Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind ('Postgres 'Cockroach)
-> AnyBackend BackendSourceKind
forall (i :: BackendType -> *).
i ('Postgres 'Cockroach) -> AnyBackend i
PostgresCockroachValue (BackendSourceKind ('Postgres 'Cockroach)
 -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind ('Postgres 'Cockroach))
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('Postgres 'Cockroach)) Value
value
    Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'MSSQL -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'MSSQL -> AnyBackend i
MSSQLValue (BackendSourceKind 'MSSQL -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind 'MSSQL)
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('MSSQL)) Value
value
    Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'BigQuery -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'BigQuery -> AnyBackend i
BigQueryValue (BackendSourceKind 'BigQuery -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind 'BigQuery)
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('BigQuery)) Value
value
    -- IMPORTANT: This must the last thing here, since it will accept (almost) any string
    Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BackendSourceKind 'DataConnector -> AnyBackend BackendSourceKind
forall (i :: BackendType -> *). i 'DataConnector -> AnyBackend i
DataConnectorValue (BackendSourceKind 'DataConnector -> AnyBackend BackendSourceKind)
-> Parser (BackendSourceKind 'DataConnector)
-> Parser (AnyBackend BackendSourceKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(BackendSourceKind ('DataConnector)) Value
value