{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.Relationships.Remote
  ( RemoteRelationship (..),
    RemoteRelationshipDefinition (..),
    parseRemoteRelationshipDefinition,
    RRFormat (..),
    RRParseMode (..),
    _RelationshipToSource,
    _RelationshipToSchema,
    rrName,
    rrDefinition,
    RemoteSchemaFieldInfo (..),
    RemoteSourceFieldInfo (..),
    RemoteFieldInfoRHS (..),
    RemoteFieldInfo (..),
    DBJoinField (..),
    ScalarComputedField (..),
    graphQLValueToJSON,
    LHSIdentifier (..),
    tableNameToLHSIdentifier,
  )
where

import Control.Lens (makeLenses, makePrisms)
import Data.Aeson
import Data.Aeson qualified as J
import Data.Aeson.TH qualified as J
import Data.Aeson.Types (Parser)
import Data.HashMap.Strict qualified as HM
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.Relationships.ToSchema
import Hasura.RQL.Types.Relationships.ToSource
import Hasura.SQL.AnyBackend (AnyBackend)
import Hasura.SQL.Backend

--------------------------------------------------------------------------------
-- metadata

-- | Metadata representation of a generic remote relationship, regardless of the
-- source: all sources use this same agnostic definition. The internal
-- definition field is where we differentiate between different targets.
data RemoteRelationship = RemoteRelationship
  { RemoteRelationship -> RelName
_rrName :: RelName,
    RemoteRelationship -> RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationshipDefinition
  }
  deriving (Int -> RemoteRelationship -> ShowS
[RemoteRelationship] -> ShowS
RemoteRelationship -> String
(Int -> RemoteRelationship -> ShowS)
-> (RemoteRelationship -> String)
-> ([RemoteRelationship] -> ShowS)
-> Show RemoteRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteRelationship] -> ShowS
$cshowList :: [RemoteRelationship] -> ShowS
show :: RemoteRelationship -> String
$cshow :: RemoteRelationship -> String
showsPrec :: Int -> RemoteRelationship -> ShowS
$cshowsPrec :: Int -> RemoteRelationship -> ShowS
Show, RemoteRelationship -> RemoteRelationship -> Bool
(RemoteRelationship -> RemoteRelationship -> Bool)
-> (RemoteRelationship -> RemoteRelationship -> Bool)
-> Eq RemoteRelationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteRelationship -> RemoteRelationship -> Bool
$c/= :: RemoteRelationship -> RemoteRelationship -> Bool
== :: RemoteRelationship -> RemoteRelationship -> Bool
$c== :: RemoteRelationship -> RemoteRelationship -> Bool
Eq, (forall x. RemoteRelationship -> Rep RemoteRelationship x)
-> (forall x. Rep RemoteRelationship x -> RemoteRelationship)
-> Generic RemoteRelationship
forall x. Rep RemoteRelationship x -> RemoteRelationship
forall x. RemoteRelationship -> Rep RemoteRelationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteRelationship x -> RemoteRelationship
$cfrom :: forall x. RemoteRelationship -> Rep RemoteRelationship x
Generic)

instance Cacheable RemoteRelationship

instance FromJSON RemoteRelationship where
  parseJSON :: Value -> Parser RemoteRelationship
parseJSON = String
-> (Object -> Parser RemoteRelationship)
-> Value
-> Parser RemoteRelationship
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RemoteRelationship" ((Object -> Parser RemoteRelationship)
 -> Value -> Parser RemoteRelationship)
-> (Object -> Parser RemoteRelationship)
-> Value
-> Parser RemoteRelationship
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    RelName -> RemoteRelationshipDefinition -> RemoteRelationship
RemoteRelationship
      (RelName -> RemoteRelationshipDefinition -> RemoteRelationship)
-> Parser RelName
-> Parser (RemoteRelationshipDefinition -> RemoteRelationship)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (RemoteRelationshipDefinition -> RemoteRelationship)
-> Parser RemoteRelationshipDefinition -> Parser RemoteRelationship
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
RRPLenient (Value -> Parser RemoteRelationshipDefinition)
-> Parser Value -> Parser RemoteRelationshipDefinition
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"definition")

-- | Represents the format of the metadata a remote relationship was read from
-- and must be written back as. We don't have a good way of doing metadata
-- versioning yet, and we therefore use this to keep track of the format used.
data RRFormat
  = -- | The remote relationship was parsed from the old format, that was only
    -- used only for db-to-rs schemas.
    RRFOldDBToRemoteSchema
  | -- | The remote relationship was parsed from the new unified format.
    RRFUnifiedFormat
  deriving (Int -> RRFormat -> ShowS
[RRFormat] -> ShowS
RRFormat -> String
(Int -> RRFormat -> ShowS)
-> (RRFormat -> String) -> ([RRFormat] -> ShowS) -> Show RRFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRFormat] -> ShowS
$cshowList :: [RRFormat] -> ShowS
show :: RRFormat -> String
$cshow :: RRFormat -> String
showsPrec :: Int -> RRFormat -> ShowS
$cshowsPrec :: Int -> RRFormat -> ShowS
Show, RRFormat -> RRFormat -> Bool
(RRFormat -> RRFormat -> Bool)
-> (RRFormat -> RRFormat -> Bool) -> Eq RRFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRFormat -> RRFormat -> Bool
$c/= :: RRFormat -> RRFormat -> Bool
== :: RRFormat -> RRFormat -> Bool
$c== :: RRFormat -> RRFormat -> Bool
Eq, (forall x. RRFormat -> Rep RRFormat x)
-> (forall x. Rep RRFormat x -> RRFormat) -> Generic RRFormat
forall x. Rep RRFormat x -> RRFormat
forall x. RRFormat -> Rep RRFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RRFormat x -> RRFormat
$cfrom :: forall x. RRFormat -> Rep RRFormat x
Generic)

instance Cacheable RRFormat

-- | Metadata representation of the internal definition of a remote relationship.
data RemoteRelationshipDefinition
  = -- | Remote relationship targetting a source.
    RelationshipToSource ToSourceRelationshipDef
  | -- | Remote relationship targetting a remote schema.
    RelationshipToSchema RRFormat ToSchemaRelationshipDef
  deriving (Int -> RemoteRelationshipDefinition -> ShowS
[RemoteRelationshipDefinition] -> ShowS
RemoteRelationshipDefinition -> String
(Int -> RemoteRelationshipDefinition -> ShowS)
-> (RemoteRelationshipDefinition -> String)
-> ([RemoteRelationshipDefinition] -> ShowS)
-> Show RemoteRelationshipDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteRelationshipDefinition] -> ShowS
$cshowList :: [RemoteRelationshipDefinition] -> ShowS
show :: RemoteRelationshipDefinition -> String
$cshow :: RemoteRelationshipDefinition -> String
showsPrec :: Int -> RemoteRelationshipDefinition -> ShowS
$cshowsPrec :: Int -> RemoteRelationshipDefinition -> ShowS
Show, RemoteRelationshipDefinition
-> RemoteRelationshipDefinition -> Bool
(RemoteRelationshipDefinition
 -> RemoteRelationshipDefinition -> Bool)
-> (RemoteRelationshipDefinition
    -> RemoteRelationshipDefinition -> Bool)
-> Eq RemoteRelationshipDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteRelationshipDefinition
-> RemoteRelationshipDefinition -> Bool
$c/= :: RemoteRelationshipDefinition
-> RemoteRelationshipDefinition -> Bool
== :: RemoteRelationshipDefinition
-> RemoteRelationshipDefinition -> Bool
$c== :: RemoteRelationshipDefinition
-> RemoteRelationshipDefinition -> Bool
Eq, (forall x.
 RemoteRelationshipDefinition -> Rep RemoteRelationshipDefinition x)
-> (forall x.
    Rep RemoteRelationshipDefinition x -> RemoteRelationshipDefinition)
-> Generic RemoteRelationshipDefinition
forall x.
Rep RemoteRelationshipDefinition x -> RemoteRelationshipDefinition
forall x.
RemoteRelationshipDefinition -> Rep RemoteRelationshipDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoteRelationshipDefinition x -> RemoteRelationshipDefinition
$cfrom :: forall x.
RemoteRelationshipDefinition -> Rep RemoteRelationshipDefinition x
Generic)

instance Cacheable RemoteRelationshipDefinition

-- See documentation for 'parseRemoteRelationshipDefinition' for why
-- this is necessary.
instance
  TypeError
    ( 'ShowType RemoteRelationshipDefinition
        ':<>: 'Text " has different JSON representations depending on context;"
        ':$$: 'Text "call ‘parseRemoteRelationshipDefinition’ directly instead of relying on ‘FromJSON’"
    ) =>
  FromJSON RemoteRelationshipDefinition
  where
  parseJSON :: Value -> Parser RemoteRelationshipDefinition
parseJSON = String -> Value -> Parser RemoteRelationshipDefinition
forall a. HasCallStack => String -> a
error String
"impossible"

-- | Whether to accept legacy fields when parsing 'RemoteRelationshipDefinition'
data RRParseMode
  = -- | Only allow legacy fields when parsing 'RemoteRelationshipDefinition'
    RRPLegacy
  | -- | Allow legacy fields when parsing 'RemoteRelationshipDefinition'
    RRPLenient
  | -- | Reject legacy fields when parsing 'RemoteRelationshipDefinition'
    RRPStrict
  deriving (Int -> RRParseMode -> ShowS
[RRParseMode] -> ShowS
RRParseMode -> String
(Int -> RRParseMode -> ShowS)
-> (RRParseMode -> String)
-> ([RRParseMode] -> ShowS)
-> Show RRParseMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRParseMode] -> ShowS
$cshowList :: [RRParseMode] -> ShowS
show :: RRParseMode -> String
$cshow :: RRParseMode -> String
showsPrec :: Int -> RRParseMode -> ShowS
$cshowsPrec :: Int -> RRParseMode -> ShowS
Show, RRParseMode -> RRParseMode -> Bool
(RRParseMode -> RRParseMode -> Bool)
-> (RRParseMode -> RRParseMode -> Bool) -> Eq RRParseMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRParseMode -> RRParseMode -> Bool
$c/= :: RRParseMode -> RRParseMode -> Bool
== :: RRParseMode -> RRParseMode -> Bool
$c== :: RRParseMode -> RRParseMode -> Bool
Eq, (forall x. RRParseMode -> Rep RRParseMode x)
-> (forall x. Rep RRParseMode x -> RRParseMode)
-> Generic RRParseMode
forall x. Rep RRParseMode x -> RRParseMode
forall x. RRParseMode -> Rep RRParseMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RRParseMode x -> RRParseMode
$cfrom :: forall x. RRParseMode -> Rep RRParseMode x
Generic)

-- | Parse 'RemoteRelationshipDefinition' letting the caller decide how lenient to be.
--
-- This is necessary because 'RemoteRelationshipDefinition' is parsed in
-- different contexts. In 'RemoteRelationship', the
-- 'RemoteRelationshipDefinition' is always parsed out from a top-level
-- @"definition" field. Thus, a legacy payload looks like this:
--
-- @
-- {
--   "name": "thing",
--   "definition": {
--     "remote_schema": "stuff",
--     "hasura_fields": ...
--     "remote_field": ...
--   }
-- }
-- @
--
-- and a new payload looks like this:
--
-- @
-- {
--   "name": "thing",
--   "definition": {
--     "to_remote_schema": {
--       "schema": "stuff",
--       "lhs_fields": ...
--       "remote_field": ...
--     }
--   }
-- }
-- @
--
-- In contrast, 'CreateFromSourceRelationship' does not have a top-
-- level @"definition"@ in its legacy format. Instead, the legacy fields
-- themselves are top-level:
--
-- @
-- {
--   "remote_schema": "stuff",
--   "hasura_fields": ...
--   "remote_field": ...
-- }
-- @
--
-- Furthermore, the presence of a @"definition"@ field is used to detect
-- that the new payload is being used:
--
-- @
-- {
--   "definition": {
--     "to_remote_schema": {
--       "schema": "stuff",
--       "lhs_fields": ...
--       "remote_field": ...
--     }
--   }
-- }
-- @
--
-- In this latter case, we should not allow @"remote_schema"@ to appear
-- under @"definition"@.
parseRemoteRelationshipDefinition :: RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition :: RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
mode = String
-> (Object -> Parser RemoteRelationshipDefinition)
-> Value
-> Parser RemoteRelationshipDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"RemoteRelationshipDefinition " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
suffix) \Object
obj -> do
  Maybe RemoteSchemaName
remoteSchema <- Object
obj Object -> Key -> Parser (Maybe RemoteSchemaName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_schema"
  case (Maybe RemoteSchemaName
remoteSchema, RRParseMode
mode) of
    (Just {}, RRParseMode
RRPStrict) -> Parser RemoteRelationshipDefinition
invalid
    (Just RemoteSchemaName
schema, RRParseMode
_) -> do
      HashSet FieldName
hasuraFields <- Object
obj Object -> Key -> Parser (HashSet FieldName)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hasura_fields"
      RemoteFields
remoteField <- Object
obj Object -> Key -> Parser RemoteFields
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remote_field"
      RemoteRelationshipDefinition -> Parser RemoteRelationshipDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteRelationshipDefinition
 -> Parser RemoteRelationshipDefinition)
-> RemoteRelationshipDefinition
-> Parser RemoteRelationshipDefinition
forall a b. (a -> b) -> a -> b
$ RRFormat -> ToSchemaRelationshipDef -> RemoteRelationshipDefinition
RelationshipToSchema RRFormat
RRFOldDBToRemoteSchema (ToSchemaRelationshipDef -> RemoteRelationshipDefinition)
-> ToSchemaRelationshipDef -> RemoteRelationshipDefinition
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName
-> HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef
ToSchemaRelationshipDef RemoteSchemaName
schema HashSet FieldName
hasuraFields RemoteFields
remoteField
    (Maybe RemoteSchemaName
Nothing, RRParseMode
RRPLegacy) -> Parser RemoteRelationshipDefinition
invalid
    (Maybe RemoteSchemaName
Nothing, RRParseMode
_) -> do
      Maybe Value
toSource <- Object
obj Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"to_source"
      Maybe Value
toSchema <- Object
obj Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"to_remote_schema"
      case (Maybe Value
toSchema, Maybe Value
toSource) of
        (Just Value
schema, Maybe Value
Nothing) -> RRFormat -> ToSchemaRelationshipDef -> RemoteRelationshipDefinition
RelationshipToSchema RRFormat
RRFUnifiedFormat (ToSchemaRelationshipDef -> RemoteRelationshipDefinition)
-> Parser ToSchemaRelationshipDef
-> Parser RemoteRelationshipDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ToSchemaRelationshipDef
forall a. FromJSON a => Value -> Parser a
parseJSON Value
schema
        (Maybe Value
Nothing, Just Value
source) -> ToSourceRelationshipDef -> RemoteRelationshipDefinition
RelationshipToSource (ToSourceRelationshipDef -> RemoteRelationshipDefinition)
-> Parser ToSourceRelationshipDef
-> Parser RemoteRelationshipDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ToSourceRelationshipDef
forall a. FromJSON a => Value -> Parser a
parseJSON Value
source
        (Maybe Value, Maybe Value)
_ -> Parser RemoteRelationshipDefinition
invalid
  where
    (String
suffix, String
expected) = case RRParseMode
mode of
      RRParseMode
RRPLegacy -> (String
"(legacy format)", String
"remote_schema")
      RRParseMode
RRPLenient -> (String
"(lenient format)", String
"remote_schema, to_source, to_remote_schema")
      RRParseMode
RRPStrict -> (String
"(strict format)", String
"to_source, to_remote_schema")

    invalid :: Parser RemoteRelationshipDefinition
invalid =
      String -> Parser RemoteRelationshipDefinition
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RemoteRelationshipDefinition)
-> String -> Parser RemoteRelationshipDefinition
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"remote relationship definition ",
            String
suffix,
            String
" expects exactly one of: ",
            String
expected
          ]

instance ToJSON RemoteRelationshipDefinition where
  toJSON :: RemoteRelationshipDefinition -> Value
toJSON = \case
    RelationshipToSource ToSourceRelationshipDef
source -> [Pair] -> Value
object [Key
"to_source" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ToSourceRelationshipDef -> Value
forall a. ToJSON a => a -> Value
toJSON ToSourceRelationshipDef
source]
    RelationshipToSchema RRFormat
format schema :: ToSchemaRelationshipDef
schema@ToSchemaRelationshipDef {HashSet FieldName
RemoteSchemaName
RemoteFields
_trrdRemoteField :: ToSchemaRelationshipDef -> RemoteFields
_trrdLhsFields :: ToSchemaRelationshipDef -> HashSet FieldName
_trrdRemoteSchema :: ToSchemaRelationshipDef -> RemoteSchemaName
_trrdRemoteField :: RemoteFields
_trrdLhsFields :: HashSet FieldName
_trrdRemoteSchema :: RemoteSchemaName
..} -> case RRFormat
format of
      RRFormat
RRFUnifiedFormat -> [Pair] -> Value
object [Key
"to_remote_schema" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ToSchemaRelationshipDef -> Value
forall a. ToJSON a => a -> Value
toJSON ToSchemaRelationshipDef
schema]
      RRFormat
RRFOldDBToRemoteSchema ->
        [Pair] -> Value
object
          [ Key
"remote_schema" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RemoteSchemaName -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteSchemaName
_trrdRemoteSchema,
            Key
"hasura_fields" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HashSet FieldName -> Value
forall a. ToJSON a => a -> Value
toJSON HashSet FieldName
_trrdLhsFields,
            Key
"remote_field" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RemoteFields -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteFields
_trrdRemoteField
          ]

--------------------------------------------------------------------------------
-- schema cache

-- | Resolved remote relationship, as stored in the schema cache.
data RemoteFieldInfo lhsJoinField = RemoteFieldInfo
  { RemoteFieldInfo lhsJoinField -> HashMap FieldName lhsJoinField
_rfiLHS :: HM.HashMap FieldName lhsJoinField,
    RemoteFieldInfo lhsJoinField -> RemoteFieldInfoRHS
_rfiRHS :: RemoteFieldInfoRHS
  }
  deriving ((forall x.
 RemoteFieldInfo lhsJoinField
 -> Rep (RemoteFieldInfo lhsJoinField) x)
-> (forall x.
    Rep (RemoteFieldInfo lhsJoinField) x
    -> RemoteFieldInfo lhsJoinField)
-> Generic (RemoteFieldInfo lhsJoinField)
forall x.
Rep (RemoteFieldInfo lhsJoinField) x
-> RemoteFieldInfo lhsJoinField
forall x.
RemoteFieldInfo lhsJoinField
-> Rep (RemoteFieldInfo lhsJoinField) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall lhsJoinField x.
Rep (RemoteFieldInfo lhsJoinField) x
-> RemoteFieldInfo lhsJoinField
forall lhsJoinField x.
RemoteFieldInfo lhsJoinField
-> Rep (RemoteFieldInfo lhsJoinField) x
$cto :: forall lhsJoinField x.
Rep (RemoteFieldInfo lhsJoinField) x
-> RemoteFieldInfo lhsJoinField
$cfrom :: forall lhsJoinField x.
RemoteFieldInfo lhsJoinField
-> Rep (RemoteFieldInfo lhsJoinField) x
Generic, RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
(RemoteFieldInfo lhsJoinField
 -> RemoteFieldInfo lhsJoinField -> Bool)
-> (RemoteFieldInfo lhsJoinField
    -> RemoteFieldInfo lhsJoinField -> Bool)
-> Eq (RemoteFieldInfo lhsJoinField)
forall lhsJoinField.
Eq lhsJoinField =>
RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
$c/= :: forall lhsJoinField.
Eq lhsJoinField =>
RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
== :: RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
$c== :: forall lhsJoinField.
Eq lhsJoinField =>
RemoteFieldInfo lhsJoinField
-> RemoteFieldInfo lhsJoinField -> Bool
Eq)

instance (Cacheable lhsJoinField) => Cacheable (RemoteFieldInfo lhsJoinField)

instance (ToJSON lhsJoinField) => ToJSON (RemoteFieldInfo lhsJoinField)

-- | Resolved remote relationship's RHS
data RemoteFieldInfoRHS
  = RFISchema RemoteSchemaFieldInfo
  | RFISource (AnyBackend RemoteSourceFieldInfo)
  deriving ((forall x. RemoteFieldInfoRHS -> Rep RemoteFieldInfoRHS x)
-> (forall x. Rep RemoteFieldInfoRHS x -> RemoteFieldInfoRHS)
-> Generic RemoteFieldInfoRHS
forall x. Rep RemoteFieldInfoRHS x -> RemoteFieldInfoRHS
forall x. RemoteFieldInfoRHS -> Rep RemoteFieldInfoRHS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteFieldInfoRHS x -> RemoteFieldInfoRHS
$cfrom :: forall x. RemoteFieldInfoRHS -> Rep RemoteFieldInfoRHS x
Generic, RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool
(RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool)
-> (RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool)
-> Eq RemoteFieldInfoRHS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool
$c/= :: RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool
== :: RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool
$c== :: RemoteFieldInfoRHS -> RemoteFieldInfoRHS -> Bool
Eq)

instance Cacheable RemoteFieldInfoRHS

instance ToJSON RemoteFieldInfoRHS where
  toJSON :: RemoteFieldInfoRHS -> Value
toJSON =
    \case
      RFISchema RemoteSchemaFieldInfo
schema -> RemoteSchemaFieldInfo -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteSchemaFieldInfo
schema
      RFISource AnyBackend RemoteSourceFieldInfo
_ -> () -> Value
forall a. ToJSON a => a -> Value
toJSON ()

-- | Information about the field on the LHS of a join against a remote schema.
data DBJoinField (b :: BackendType)
  = JoinColumn (Column b) (ColumnType b)
  | JoinComputedField (ScalarComputedField b)
  deriving ((forall x. DBJoinField b -> Rep (DBJoinField b) x)
-> (forall x. Rep (DBJoinField b) x -> DBJoinField b)
-> Generic (DBJoinField b)
forall x. Rep (DBJoinField b) x -> DBJoinField b
forall x. DBJoinField b -> Rep (DBJoinField b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (DBJoinField b) x -> DBJoinField b
forall (b :: BackendType) x. DBJoinField b -> Rep (DBJoinField b) x
$cto :: forall (b :: BackendType) x. Rep (DBJoinField b) x -> DBJoinField b
$cfrom :: forall (b :: BackendType) x. DBJoinField b -> Rep (DBJoinField b) x
Generic)

deriving instance Backend b => Eq (DBJoinField b)

deriving instance Backend b => Show (DBJoinField b)

instance Backend b => Cacheable (DBJoinField b)

instance Backend b => Hashable (DBJoinField b)

instance (Backend b) => ToJSON (DBJoinField b) where
  toJSON :: DBJoinField b -> Value
toJSON = \case
    JoinColumn Column b
column ColumnType b
columnType -> (Column b, ColumnType b) -> Value
forall a. ToJSON a => a -> Value
toJSON (Column b
column, ColumnType b
columnType)
    JoinComputedField ScalarComputedField b
computedField -> ScalarComputedField b -> Value
forall a. ToJSON a => a -> Value
toJSON ScalarComputedField b
computedField

-- | Information about a computed field appearing on the LHS of a remote join.
-- FIXME: why do we need all of this?
data ScalarComputedField (b :: BackendType) = ScalarComputedField
  { ScalarComputedField b -> XComputedField b
_scfXField :: XComputedField b,
    ScalarComputedField b -> ComputedFieldName
_scfName :: ComputedFieldName,
    ScalarComputedField b -> FunctionName b
_scfFunction :: FunctionName b,
    ScalarComputedField b -> ComputedFieldImplicitArguments b
_scfComputedFieldImplicitArgs :: ComputedFieldImplicitArguments b,
    ScalarComputedField b -> ScalarType b
_scfType :: ScalarType b
  }
  deriving ((forall x. ScalarComputedField b -> Rep (ScalarComputedField b) x)
-> (forall x.
    Rep (ScalarComputedField b) x -> ScalarComputedField b)
-> Generic (ScalarComputedField b)
forall x. Rep (ScalarComputedField b) x -> ScalarComputedField b
forall x. ScalarComputedField b -> Rep (ScalarComputedField b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (ScalarComputedField b) x -> ScalarComputedField b
forall (b :: BackendType) x.
ScalarComputedField b -> Rep (ScalarComputedField b) x
$cto :: forall (b :: BackendType) x.
Rep (ScalarComputedField b) x -> ScalarComputedField b
$cfrom :: forall (b :: BackendType) x.
ScalarComputedField b -> Rep (ScalarComputedField b) x
Generic)

deriving instance Backend b => Eq (ScalarComputedField b)

deriving instance Backend b => Show (ScalarComputedField b)

instance Backend b => Cacheable (ScalarComputedField b)

instance Backend b => Hashable (ScalarComputedField b)

instance Backend b => ToJSON (ScalarComputedField b) where
  toJSON :: ScalarComputedField b -> Value
toJSON ScalarComputedField {FunctionName b
ScalarType b
ComputedFieldImplicitArguments b
XComputedField b
ComputedFieldName
_scfType :: ScalarType b
_scfComputedFieldImplicitArgs :: ComputedFieldImplicitArguments b
_scfFunction :: FunctionName b
_scfName :: ComputedFieldName
_scfXField :: XComputedField b
_scfType :: forall (b :: BackendType). ScalarComputedField b -> ScalarType b
_scfComputedFieldImplicitArgs :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldImplicitArguments b
_scfFunction :: forall (b :: BackendType). ScalarComputedField b -> FunctionName b
_scfName :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldName
_scfXField :: forall (b :: BackendType).
ScalarComputedField b -> XComputedField b
..} =
    [Pair] -> Value
object
      [ Key
"name" Key -> ComputedFieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ComputedFieldName
_scfName,
        Key
"function" Key -> FunctionName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FunctionName b
_scfFunction,
        Key
"function_implicit_arguments" Key -> ComputedFieldImplicitArguments b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ComputedFieldImplicitArguments b
_scfComputedFieldImplicitArgs,
        Key
"type" Key -> ScalarType b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScalarType b
_scfType
      ]

--------------------------------------------------------------------------------
-- template haskell generation

$(makeLenses ''RemoteRelationship)
$(J.deriveToJSON hasuraJSON {J.omitNothingFields = False} ''RemoteRelationship)
$(makePrisms ''RemoteRelationshipDefinition)