{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.GraphQL.Execute.RemoteJoin.Types
  ( -- * Remote joins tree
    JoinTree (..),
    JoinNode (..),
    RemoteJoins,
    QualifiedFieldName (..),
    getRemoteSchemaJoins,

    -- * Individual join information
    RemoteJoin (..),
    JoinCallId,
    JoinColumnAlias (..),
    getAliasFieldName,
    getPhantomFields,
    getJoinColumnMapping,

    -- * Join to source
    RemoteSourceJoin (..),

    -- * Join to schema
    RemoteSchemaJoin (..),

    -- * Join arguments
    JoinArgumentId,
    JoinArgument (..),
    JoinArguments (..),
  )
where

import Data.Aeson.Ordered qualified as AO
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.NonEmpty qualified as NEMap
import Hasura.GraphQL.Parser qualified as P
import Hasura.Prelude
import Hasura.RQL.IR.RemoteSchema qualified as IR
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ResultCustomization
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RemoteSchema.SchemaCache
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G

-------------------------------------------------------------------------------
-- Remote joins tree

-- | A JoinTree represents the set of operations that need to be executed to
-- enrich the response of a source with data from remote sources. A tree
-- structure is used to capture the locations in the response where the join
-- has to happpen as it offers an efficient traversal mechanism.
--
-- For a query such as this:
--
-- {
--   city {
--     name
--     code
--     # weather is a remote relationship
--     weather { forecast }
--     state {
--     # weather is a remote relationship
--       weather { forecast }
--     }
--   }
--  }
--
--  the join tree would look like
--  [
--  , ("weather", Leaf RemoteJoinInfoOfWeather),
--  , ("state", [ ("weather", Leaf RemoteJoinInfoOfWeather) ])
--  ]
--
-- Note that the same join tree will be emitted even if 'city' is of type
-- '[City]' and 'state' is of type [State], we currently do not capture any
-- information if any of the fields in the path expect json arrays. It is
-- similar in spirit to a GraphQL selection set in this regard.
--
-- This structure is somewhat similar to a prefix tree such as 'Data.Trie.Trie',
-- but has two additional guarantees:
--   - a 'JoinTree' is never empty,
--   - there cannot exist a pair of values for which one's prefix key is a
--     subset of the other: every value is effectively a leaf.
newtype JoinTree a = JoinTree {forall a. JoinTree a -> NEHashMap QualifiedFieldName (JoinNode a)
unJoinTree :: NEMap.NEHashMap QualifiedFieldName (JoinNode a)}
  deriving stock (Int -> JoinTree a -> ShowS
[JoinTree a] -> ShowS
JoinTree a -> String
(Int -> JoinTree a -> ShowS)
-> (JoinTree a -> String)
-> ([JoinTree a] -> ShowS)
-> Show (JoinTree a)
forall a. Show a => Int -> JoinTree a -> ShowS
forall a. Show a => [JoinTree a] -> ShowS
forall a. Show a => JoinTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JoinTree a -> ShowS
showsPrec :: Int -> JoinTree a -> ShowS
$cshow :: forall a. Show a => JoinTree a -> String
show :: JoinTree a -> String
$cshowList :: forall a. Show a => [JoinTree a] -> ShowS
showList :: [JoinTree a] -> ShowS
Show, JoinTree a -> JoinTree a -> Bool
(JoinTree a -> JoinTree a -> Bool)
-> (JoinTree a -> JoinTree a -> Bool) -> Eq (JoinTree a)
forall a. Eq a => JoinTree a -> JoinTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => JoinTree a -> JoinTree a -> Bool
== :: JoinTree a -> JoinTree a -> Bool
$c/= :: forall a. Eq a => JoinTree a -> JoinTree a -> Bool
/= :: JoinTree a -> JoinTree a -> Bool
Eq, (forall a b. (a -> b) -> JoinTree a -> JoinTree b)
-> (forall a b. a -> JoinTree b -> JoinTree a) -> Functor JoinTree
forall a b. a -> JoinTree b -> JoinTree a
forall a b. (a -> b) -> JoinTree a -> JoinTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> JoinTree a -> JoinTree b
fmap :: forall a b. (a -> b) -> JoinTree a -> JoinTree b
$c<$ :: forall a b. a -> JoinTree b -> JoinTree a
<$ :: forall a b. a -> JoinTree b -> JoinTree a
Functor, (forall m. Monoid m => JoinTree m -> m)
-> (forall m a. Monoid m => (a -> m) -> JoinTree a -> m)
-> (forall m a. Monoid m => (a -> m) -> JoinTree a -> m)
-> (forall a b. (a -> b -> b) -> b -> JoinTree a -> b)
-> (forall a b. (a -> b -> b) -> b -> JoinTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> JoinTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> JoinTree a -> b)
-> (forall a. (a -> a -> a) -> JoinTree a -> a)
-> (forall a. (a -> a -> a) -> JoinTree a -> a)
-> (forall a. JoinTree a -> [a])
-> (forall a. JoinTree a -> Bool)
-> (forall a. JoinTree a -> Int)
-> (forall a. Eq a => a -> JoinTree a -> Bool)
-> (forall a. Ord a => JoinTree a -> a)
-> (forall a. Ord a => JoinTree a -> a)
-> (forall a. Num a => JoinTree a -> a)
-> (forall a. Num a => JoinTree a -> a)
-> Foldable JoinTree
forall a. Eq a => a -> JoinTree a -> Bool
forall a. Num a => JoinTree a -> a
forall a. Ord a => JoinTree a -> a
forall m. Monoid m => JoinTree m -> m
forall a. JoinTree a -> Bool
forall a. JoinTree a -> Int
forall a. JoinTree a -> [a]
forall a. (a -> a -> a) -> JoinTree a -> a
forall m a. Monoid m => (a -> m) -> JoinTree a -> m
forall b a. (b -> a -> b) -> b -> JoinTree a -> b
forall a b. (a -> b -> b) -> b -> JoinTree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => JoinTree m -> m
fold :: forall m. Monoid m => JoinTree m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> JoinTree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> JoinTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> JoinTree a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> JoinTree a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> JoinTree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> JoinTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> JoinTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> JoinTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> JoinTree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> JoinTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> JoinTree a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> JoinTree a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> JoinTree a -> a
foldr1 :: forall a. (a -> a -> a) -> JoinTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> JoinTree a -> a
foldl1 :: forall a. (a -> a -> a) -> JoinTree a -> a
$ctoList :: forall a. JoinTree a -> [a]
toList :: forall a. JoinTree a -> [a]
$cnull :: forall a. JoinTree a -> Bool
null :: forall a. JoinTree a -> Bool
$clength :: forall a. JoinTree a -> Int
length :: forall a. JoinTree a -> Int
$celem :: forall a. Eq a => a -> JoinTree a -> Bool
elem :: forall a. Eq a => a -> JoinTree a -> Bool
$cmaximum :: forall a. Ord a => JoinTree a -> a
maximum :: forall a. Ord a => JoinTree a -> a
$cminimum :: forall a. Ord a => JoinTree a -> a
minimum :: forall a. Ord a => JoinTree a -> a
$csum :: forall a. Num a => JoinTree a -> a
sum :: forall a. Num a => JoinTree a -> a
$cproduct :: forall a. Num a => JoinTree a -> a
product :: forall a. Num a => JoinTree a -> a
Foldable, Functor JoinTree
Foldable JoinTree
Functor JoinTree
-> Foldable JoinTree
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> JoinTree a -> f (JoinTree b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    JoinTree (f a) -> f (JoinTree a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> JoinTree a -> m (JoinTree b))
-> (forall (m :: * -> *) a.
    Monad m =>
    JoinTree (m a) -> m (JoinTree a))
-> Traversable JoinTree
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => JoinTree (m a) -> m (JoinTree a)
forall (f :: * -> *) a.
Applicative f =>
JoinTree (f a) -> f (JoinTree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinTree a -> m (JoinTree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinTree a -> f (JoinTree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinTree a -> f (JoinTree b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinTree a -> f (JoinTree b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
JoinTree (f a) -> f (JoinTree a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
JoinTree (f a) -> f (JoinTree a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinTree a -> m (JoinTree b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinTree a -> m (JoinTree b)
$csequence :: forall (m :: * -> *) a. Monad m => JoinTree (m a) -> m (JoinTree a)
sequence :: forall (m :: * -> *) a. Monad m => JoinTree (m a) -> m (JoinTree a)
Traversable, (forall x. JoinTree a -> Rep (JoinTree a) x)
-> (forall x. Rep (JoinTree a) x -> JoinTree a)
-> Generic (JoinTree a)
forall x. Rep (JoinTree a) x -> JoinTree a
forall x. JoinTree a -> Rep (JoinTree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JoinTree a) x -> JoinTree a
forall a x. JoinTree a -> Rep (JoinTree a) x
$cfrom :: forall a x. JoinTree a -> Rep (JoinTree a) x
from :: forall x. JoinTree a -> Rep (JoinTree a) x
$cto :: forall a x. Rep (JoinTree a) x -> JoinTree a
to :: forall x. Rep (JoinTree a) x -> JoinTree a
Generic)
  deriving newtype (NonEmpty (JoinTree a) -> JoinTree a
JoinTree a -> JoinTree a -> JoinTree a
(JoinTree a -> JoinTree a -> JoinTree a)
-> (NonEmpty (JoinTree a) -> JoinTree a)
-> (forall b. Integral b => b -> JoinTree a -> JoinTree a)
-> Semigroup (JoinTree a)
forall b. Integral b => b -> JoinTree a -> JoinTree a
forall a. NonEmpty (JoinTree a) -> JoinTree a
forall a. JoinTree a -> JoinTree a -> JoinTree a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> JoinTree a -> JoinTree a
$c<> :: forall a. JoinTree a -> JoinTree a -> JoinTree a
<> :: JoinTree a -> JoinTree a -> JoinTree a
$csconcat :: forall a. NonEmpty (JoinTree a) -> JoinTree a
sconcat :: NonEmpty (JoinTree a) -> JoinTree a
$cstimes :: forall a b. Integral b => b -> JoinTree a -> JoinTree a
stimes :: forall b. Integral b => b -> JoinTree a -> JoinTree a
Semigroup)

-- | A field name annotated with an optional type name.
--
-- To deal with ambiguous join paths, such as those that emerge from GraphQL
-- interfaces or GraphQL unions, we do not just keep track of the fields' name,
-- but also, optionally, of their type. Whenever a selection set is deemed
-- ambiguous, we insert a reserved field in the query to retrieve the typename,
-- @__hasura_internal_typename@; when traversing the join tree, if that key is
-- present, then we use it alongside the field name when querying the join tree
-- (see @traverseObject@ in the @Join@ module).
--
-- We use 'Text' for the representation of the field name instead of
-- 'FieldName', for simplicity: the join tree is only meant to be queried using
-- the values we get in the reponse, which will be unrestricted text.
data QualifiedFieldName = QualifiedFieldName
  { QualifiedFieldName -> Maybe Text
_qfTypeName :: Maybe Text,
    QualifiedFieldName -> Text
_qfFieldName :: Text
  }
  deriving stock (Int -> QualifiedFieldName -> ShowS
[QualifiedFieldName] -> ShowS
QualifiedFieldName -> String
(Int -> QualifiedFieldName -> ShowS)
-> (QualifiedFieldName -> String)
-> ([QualifiedFieldName] -> ShowS)
-> Show QualifiedFieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedFieldName -> ShowS
showsPrec :: Int -> QualifiedFieldName -> ShowS
$cshow :: QualifiedFieldName -> String
show :: QualifiedFieldName -> String
$cshowList :: [QualifiedFieldName] -> ShowS
showList :: [QualifiedFieldName] -> ShowS
Show, QualifiedFieldName -> QualifiedFieldName -> Bool
(QualifiedFieldName -> QualifiedFieldName -> Bool)
-> (QualifiedFieldName -> QualifiedFieldName -> Bool)
-> Eq QualifiedFieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedFieldName -> QualifiedFieldName -> Bool
== :: QualifiedFieldName -> QualifiedFieldName -> Bool
$c/= :: QualifiedFieldName -> QualifiedFieldName -> Bool
/= :: QualifiedFieldName -> QualifiedFieldName -> Bool
Eq, (forall x. QualifiedFieldName -> Rep QualifiedFieldName x)
-> (forall x. Rep QualifiedFieldName x -> QualifiedFieldName)
-> Generic QualifiedFieldName
forall x. Rep QualifiedFieldName x -> QualifiedFieldName
forall x. QualifiedFieldName -> Rep QualifiedFieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QualifiedFieldName -> Rep QualifiedFieldName x
from :: forall x. QualifiedFieldName -> Rep QualifiedFieldName x
$cto :: forall x. Rep QualifiedFieldName x -> QualifiedFieldName
to :: forall x. Rep QualifiedFieldName x -> QualifiedFieldName
Generic)
  deriving anyclass (Eq QualifiedFieldName
Eq QualifiedFieldName
-> (Int -> QualifiedFieldName -> Int)
-> (QualifiedFieldName -> Int)
-> Hashable QualifiedFieldName
Int -> QualifiedFieldName -> Int
QualifiedFieldName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> QualifiedFieldName -> Int
hashWithSalt :: Int -> QualifiedFieldName -> Int
$chash :: QualifiedFieldName -> Int
hash :: QualifiedFieldName -> Int
Hashable)

-- | Each leaf associates a mapping from typename to actual join info.
-- This allows to disambiguate between different remote joins with the same name
-- in a given selection set, which might happen with union or interface
-- fragments.
data JoinNode a
  = Leaf a
  | Tree (JoinTree a)
  deriving stock (JoinNode a -> JoinNode a -> Bool
(JoinNode a -> JoinNode a -> Bool)
-> (JoinNode a -> JoinNode a -> Bool) -> Eq (JoinNode a)
forall a. Eq a => JoinNode a -> JoinNode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => JoinNode a -> JoinNode a -> Bool
== :: JoinNode a -> JoinNode a -> Bool
$c/= :: forall a. Eq a => JoinNode a -> JoinNode a -> Bool
/= :: JoinNode a -> JoinNode a -> Bool
Eq, (forall m. Monoid m => JoinNode m -> m)
-> (forall m a. Monoid m => (a -> m) -> JoinNode a -> m)
-> (forall m a. Monoid m => (a -> m) -> JoinNode a -> m)
-> (forall a b. (a -> b -> b) -> b -> JoinNode a -> b)
-> (forall a b. (a -> b -> b) -> b -> JoinNode a -> b)
-> (forall b a. (b -> a -> b) -> b -> JoinNode a -> b)
-> (forall b a. (b -> a -> b) -> b -> JoinNode a -> b)
-> (forall a. (a -> a -> a) -> JoinNode a -> a)
-> (forall a. (a -> a -> a) -> JoinNode a -> a)
-> (forall a. JoinNode a -> [a])
-> (forall a. JoinNode a -> Bool)
-> (forall a. JoinNode a -> Int)
-> (forall a. Eq a => a -> JoinNode a -> Bool)
-> (forall a. Ord a => JoinNode a -> a)
-> (forall a. Ord a => JoinNode a -> a)
-> (forall a. Num a => JoinNode a -> a)
-> (forall a. Num a => JoinNode a -> a)
-> Foldable JoinNode
forall a. Eq a => a -> JoinNode a -> Bool
forall a. Num a => JoinNode a -> a
forall a. Ord a => JoinNode a -> a
forall m. Monoid m => JoinNode m -> m
forall a. JoinNode a -> Bool
forall a. JoinNode a -> Int
forall a. JoinNode a -> [a]
forall a. (a -> a -> a) -> JoinNode a -> a
forall m a. Monoid m => (a -> m) -> JoinNode a -> m
forall b a. (b -> a -> b) -> b -> JoinNode a -> b
forall a b. (a -> b -> b) -> b -> JoinNode a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => JoinNode m -> m
fold :: forall m. Monoid m => JoinNode m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> JoinNode a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> JoinNode a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> JoinNode a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> JoinNode a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> JoinNode a -> b
foldr :: forall a b. (a -> b -> b) -> b -> JoinNode a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> JoinNode a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> JoinNode a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> JoinNode a -> b
foldl :: forall b a. (b -> a -> b) -> b -> JoinNode a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> JoinNode a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> JoinNode a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> JoinNode a -> a
foldr1 :: forall a. (a -> a -> a) -> JoinNode a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> JoinNode a -> a
foldl1 :: forall a. (a -> a -> a) -> JoinNode a -> a
$ctoList :: forall a. JoinNode a -> [a]
toList :: forall a. JoinNode a -> [a]
$cnull :: forall a. JoinNode a -> Bool
null :: forall a. JoinNode a -> Bool
$clength :: forall a. JoinNode a -> Int
length :: forall a. JoinNode a -> Int
$celem :: forall a. Eq a => a -> JoinNode a -> Bool
elem :: forall a. Eq a => a -> JoinNode a -> Bool
$cmaximum :: forall a. Ord a => JoinNode a -> a
maximum :: forall a. Ord a => JoinNode a -> a
$cminimum :: forall a. Ord a => JoinNode a -> a
minimum :: forall a. Ord a => JoinNode a -> a
$csum :: forall a. Num a => JoinNode a -> a
sum :: forall a. Num a => JoinNode a -> a
$cproduct :: forall a. Num a => JoinNode a -> a
product :: forall a. Num a => JoinNode a -> a
Foldable, (forall a b. (a -> b) -> JoinNode a -> JoinNode b)
-> (forall a b. a -> JoinNode b -> JoinNode a) -> Functor JoinNode
forall a b. a -> JoinNode b -> JoinNode a
forall a b. (a -> b) -> JoinNode a -> JoinNode b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> JoinNode a -> JoinNode b
fmap :: forall a b. (a -> b) -> JoinNode a -> JoinNode b
$c<$ :: forall a b. a -> JoinNode b -> JoinNode a
<$ :: forall a b. a -> JoinNode b -> JoinNode a
Functor, (forall x. JoinNode a -> Rep (JoinNode a) x)
-> (forall x. Rep (JoinNode a) x -> JoinNode a)
-> Generic (JoinNode a)
forall x. Rep (JoinNode a) x -> JoinNode a
forall x. JoinNode a -> Rep (JoinNode a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JoinNode a) x -> JoinNode a
forall a x. JoinNode a -> Rep (JoinNode a) x
$cfrom :: forall a x. JoinNode a -> Rep (JoinNode a) x
from :: forall x. JoinNode a -> Rep (JoinNode a) x
$cto :: forall a x. Rep (JoinNode a) x -> JoinNode a
to :: forall x. Rep (JoinNode a) x -> JoinNode a
Generic, Functor JoinNode
Foldable JoinNode
Functor JoinNode
-> Foldable JoinNode
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> JoinNode a -> f (JoinNode b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    JoinNode (f a) -> f (JoinNode a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> JoinNode a -> m (JoinNode b))
-> (forall (m :: * -> *) a.
    Monad m =>
    JoinNode (m a) -> m (JoinNode a))
-> Traversable JoinNode
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => JoinNode (m a) -> m (JoinNode a)
forall (f :: * -> *) a.
Applicative f =>
JoinNode (f a) -> f (JoinNode a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinNode a -> m (JoinNode b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinNode a -> f (JoinNode b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinNode a -> f (JoinNode b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> JoinNode a -> f (JoinNode b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
JoinNode (f a) -> f (JoinNode a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
JoinNode (f a) -> f (JoinNode a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinNode a -> m (JoinNode b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> JoinNode a -> m (JoinNode b)
$csequence :: forall (m :: * -> *) a. Monad m => JoinNode (m a) -> m (JoinNode a)
sequence :: forall (m :: * -> *) a. Monad m => JoinNode (m a) -> m (JoinNode a)
Traversable, Int -> JoinNode a -> ShowS
[JoinNode a] -> ShowS
JoinNode a -> String
(Int -> JoinNode a -> ShowS)
-> (JoinNode a -> String)
-> ([JoinNode a] -> ShowS)
-> Show (JoinNode a)
forall a. Show a => Int -> JoinNode a -> ShowS
forall a. Show a => [JoinNode a] -> ShowS
forall a. Show a => JoinNode a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> JoinNode a -> ShowS
showsPrec :: Int -> JoinNode a -> ShowS
$cshow :: forall a. Show a => JoinNode a -> String
show :: JoinNode a -> String
$cshowList :: forall a. Show a => [JoinNode a] -> ShowS
showList :: [JoinNode a] -> ShowS
Show)

type RemoteJoins = JoinTree RemoteJoin

-- | Collect all the remote joins to a remote schema from a join tree.
getRemoteSchemaJoins :: RemoteJoins -> [RemoteSchemaJoin]
getRemoteSchemaJoins :: RemoteJoins -> [RemoteSchemaJoin]
getRemoteSchemaJoins = (RemoteJoin -> [RemoteSchemaJoin])
-> [RemoteJoin] -> [RemoteSchemaJoin]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RemoteJoin -> [RemoteSchemaJoin]
getRemoteSchemaJoin ([RemoteJoin] -> [RemoteSchemaJoin])
-> (RemoteJoins -> [RemoteJoin])
-> RemoteJoins
-> [RemoteSchemaJoin]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteJoins -> [RemoteJoin]
forall a. JoinTree a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  where
    getRemoteSchemaJoin :: RemoteJoin -> [RemoteSchemaJoin]
    getRemoteSchemaJoin :: RemoteJoin -> [RemoteSchemaJoin]
getRemoteSchemaJoin = \case
      RemoteJoinSource AnyBackend RemoteSourceJoin
_ Maybe RemoteJoins
remoteJoins -> [RemoteSchemaJoin]
-> (RemoteJoins -> [RemoteSchemaJoin])
-> Maybe RemoteJoins
-> [RemoteSchemaJoin]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] RemoteJoins -> [RemoteSchemaJoin]
getRemoteSchemaJoins Maybe RemoteJoins
remoteJoins
      RemoteJoinRemoteSchema RemoteSchemaJoin
s Maybe RemoteJoins
remoteJoins -> RemoteSchemaJoin
s RemoteSchemaJoin -> [RemoteSchemaJoin] -> [RemoteSchemaJoin]
forall a. a -> [a] -> [a]
: [RemoteSchemaJoin]
-> (RemoteJoins -> [RemoteSchemaJoin])
-> Maybe RemoteJoins
-> [RemoteSchemaJoin]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] RemoteJoins -> [RemoteSchemaJoin]
getRemoteSchemaJoins Maybe RemoteJoins
remoteJoins

-------------------------------------------------------------------------------
-- Individual join information

-- | An individual join entry point in a 'JoinTree'.
--
-- Either a join against a source, or against a remote schema. In either case,
-- the constructor will contain that particular join's information (a
-- 'RemoteSourceJoin' or 'RemoteSchemaJoin' respectively) and, recursively, the
-- set of follow-up 'RemoteJoins' from that target, if any.
data RemoteJoin
  = RemoteJoinSource (AB.AnyBackend RemoteSourceJoin) (Maybe RemoteJoins)
  | RemoteJoinRemoteSchema RemoteSchemaJoin (Maybe RemoteJoins)
  deriving stock (RemoteJoin -> RemoteJoin -> Bool
(RemoteJoin -> RemoteJoin -> Bool)
-> (RemoteJoin -> RemoteJoin -> Bool) -> Eq RemoteJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteJoin -> RemoteJoin -> Bool
== :: RemoteJoin -> RemoteJoin -> Bool
$c/= :: RemoteJoin -> RemoteJoin -> Bool
/= :: RemoteJoin -> RemoteJoin -> Bool
Eq, (forall x. RemoteJoin -> Rep RemoteJoin x)
-> (forall x. Rep RemoteJoin x -> RemoteJoin) -> Generic RemoteJoin
forall x. Rep RemoteJoin x -> RemoteJoin
forall x. RemoteJoin -> Rep RemoteJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteJoin -> Rep RemoteJoin x
from :: forall x. RemoteJoin -> Rep RemoteJoin x
$cto :: forall x. Rep RemoteJoin x -> RemoteJoin
to :: forall x. Rep RemoteJoin x -> RemoteJoin
Generic)

-- | A unique id that gets assigned to each 'RemoteJoin' (this is to avoid the
-- requirement of Ord/Hashable implementation for RemoteJoin)
type JoinCallId = Int

-- | Disambiguates between 'FieldName's which are provided as part of the
-- GraphQL selection provided by the user (i.e. 'JCSelected') and those which
-- we need to retreive data but which are not expressly requested (i.e.
-- 'JCPhantom').
--
-- After processing the remote join, we remove all phantom 'FieldName's and
-- only return those which fall under the 'JCSelected' branch of this type.
data JoinColumnAlias
  = -- | This fieldname is already part of the response.
    JCSelected !FieldName
  | -- | This is explicitly added for the join.
    --
    -- Such keys will have to be removed from the response eventually.
    JCPhantom !FieldName
  deriving stock (JoinColumnAlias -> JoinColumnAlias -> Bool
(JoinColumnAlias -> JoinColumnAlias -> Bool)
-> (JoinColumnAlias -> JoinColumnAlias -> Bool)
-> Eq JoinColumnAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinColumnAlias -> JoinColumnAlias -> Bool
== :: JoinColumnAlias -> JoinColumnAlias -> Bool
$c/= :: JoinColumnAlias -> JoinColumnAlias -> Bool
/= :: JoinColumnAlias -> JoinColumnAlias -> Bool
Eq, (forall x. JoinColumnAlias -> Rep JoinColumnAlias x)
-> (forall x. Rep JoinColumnAlias x -> JoinColumnAlias)
-> Generic JoinColumnAlias
forall x. Rep JoinColumnAlias x -> JoinColumnAlias
forall x. JoinColumnAlias -> Rep JoinColumnAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinColumnAlias -> Rep JoinColumnAlias x
from :: forall x. JoinColumnAlias -> Rep JoinColumnAlias x
$cto :: forall x. Rep JoinColumnAlias x -> JoinColumnAlias
to :: forall x. Rep JoinColumnAlias x -> JoinColumnAlias
Generic, Int -> JoinColumnAlias -> ShowS
[JoinColumnAlias] -> ShowS
JoinColumnAlias -> String
(Int -> JoinColumnAlias -> ShowS)
-> (JoinColumnAlias -> String)
-> ([JoinColumnAlias] -> ShowS)
-> Show JoinColumnAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinColumnAlias -> ShowS
showsPrec :: Int -> JoinColumnAlias -> ShowS
$cshow :: JoinColumnAlias -> String
show :: JoinColumnAlias -> String
$cshowList :: [JoinColumnAlias] -> ShowS
showList :: [JoinColumnAlias] -> ShowS
Show)
  deriving anyclass (Eq JoinColumnAlias
Eq JoinColumnAlias
-> (Int -> JoinColumnAlias -> Int)
-> (JoinColumnAlias -> Int)
-> Hashable JoinColumnAlias
Int -> JoinColumnAlias -> Int
JoinColumnAlias -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JoinColumnAlias -> Int
hashWithSalt :: Int -> JoinColumnAlias -> Int
$chash :: JoinColumnAlias -> Int
hash :: JoinColumnAlias -> Int
Hashable)

-- | Extracts the field name from the 'JoinColumnAlias', regardless of whether
-- the field is requested by the user of a "phantom" field.
getAliasFieldName :: JoinColumnAlias -> FieldName
getAliasFieldName :: JoinColumnAlias -> FieldName
getAliasFieldName = \case
  JCSelected FieldName
f -> FieldName
f
  JCPhantom FieldName
f -> FieldName
f

-- | Extracts the list of phantom field names out of a given 'RemoteJoin',
-- i.e. the name of the fields that must be part of the query but were not
-- requested by the user.
getPhantomFields :: RemoteJoin -> [FieldName]
getPhantomFields :: RemoteJoin -> [FieldName]
getPhantomFields =
  (JoinColumnAlias -> Maybe FieldName)
-> [JoinColumnAlias] -> [FieldName]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe JoinColumnAlias -> Maybe FieldName
getPhantomFieldName ([JoinColumnAlias] -> [FieldName])
-> (RemoteJoin -> [JoinColumnAlias]) -> RemoteJoin -> [FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap FieldName JoinColumnAlias -> [JoinColumnAlias]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap FieldName JoinColumnAlias -> [JoinColumnAlias])
-> (RemoteJoin -> HashMap FieldName JoinColumnAlias)
-> RemoteJoin
-> [JoinColumnAlias]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteJoin -> HashMap FieldName JoinColumnAlias
getJoinColumnMapping
  where
    getPhantomFieldName :: JoinColumnAlias -> Maybe FieldName
    getPhantomFieldName :: JoinColumnAlias -> Maybe FieldName
getPhantomFieldName = \case
      JCSelected FieldName
_ -> Maybe FieldName
forall a. Maybe a
Nothing
      JCPhantom FieldName
f -> FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just FieldName
f

-- | Extracts an abstracted field mapping for a particular 'RemoteJoin', using a
-- common representation.
--
-- The RHS of the mapping uses 'JoinColumnAlias' instead of 'FieldName' to
-- differentiate between selected fields and phantom fields (see
-- 'JoinColumnAlias').
getJoinColumnMapping :: RemoteJoin -> HashMap.HashMap FieldName JoinColumnAlias
getJoinColumnMapping :: RemoteJoin -> HashMap FieldName JoinColumnAlias
getJoinColumnMapping = \case
  RemoteJoinSource AnyBackend RemoteSourceJoin
sourceJoin Maybe RemoteJoins
_ -> AnyBackend RemoteSourceJoin
-> (forall (b :: BackendType).
    RemoteSourceJoin b -> HashMap FieldName JoinColumnAlias)
-> HashMap FieldName JoinColumnAlias
forall (i :: BackendType -> *) r.
AnyBackend i -> (forall (b :: BackendType). i b -> r) -> r
AB.runBackend
    AnyBackend RemoteSourceJoin
sourceJoin
    \RemoteSourceJoin {HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns :: HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns :: forall (b :: BackendType).
RemoteSourceJoin b
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns} ->
      ((JoinColumnAlias, (Column b, ScalarType b)) -> JoinColumnAlias)
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
-> HashMap FieldName JoinColumnAlias
forall a b. (a -> b) -> HashMap FieldName a -> HashMap FieldName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JoinColumnAlias, (Column b, ScalarType b)) -> JoinColumnAlias
forall a b. (a, b) -> a
fst HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns
  RemoteJoinRemoteSchema RemoteSchemaJoin {HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases :: HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases :: RemoteSchemaJoin -> HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases} Maybe RemoteJoins
_ ->
    HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases

-------------------------------------------------------------------------------
-- Join to source

-- | A 'RemoteSourceJoin' contains all the contextual information required for
-- the execution of a join against a source, translated from the IR's
-- representation of a selection (see 'AnnFieldG').
data RemoteSourceJoin b = RemoteSourceJoin
  { forall (b :: BackendType). RemoteSourceJoin b -> SourceName
_rsjSource :: !SourceName,
    forall (b :: BackendType). RemoteSourceJoin b -> SourceConfig b
_rsjSourceConfig :: !(SourceConfig b),
    forall (b :: BackendType).
RemoteSourceJoin b
-> SourceRelationshipSelection b Void UnpreparedValue
_rsjRelationship :: !(IR.SourceRelationshipSelection b Void IR.UnpreparedValue),
    forall (b :: BackendType).
RemoteSourceJoin b
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns :: !(HashMap.HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))),
    forall (b :: BackendType). RemoteSourceJoin b -> StringifyNumbers
_rsjStringifyNum :: Options.StringifyNumbers
  }
  deriving ((forall x. RemoteSourceJoin b -> Rep (RemoteSourceJoin b) x)
-> (forall x. Rep (RemoteSourceJoin b) x -> RemoteSourceJoin b)
-> Generic (RemoteSourceJoin b)
forall x. Rep (RemoteSourceJoin b) x -> RemoteSourceJoin b
forall x. RemoteSourceJoin b -> Rep (RemoteSourceJoin b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RemoteSourceJoin b) x -> RemoteSourceJoin b
forall (b :: BackendType) x.
RemoteSourceJoin b -> Rep (RemoteSourceJoin b) x
$cfrom :: forall (b :: BackendType) x.
RemoteSourceJoin b -> Rep (RemoteSourceJoin b) x
from :: forall x. RemoteSourceJoin b -> Rep (RemoteSourceJoin b) x
$cto :: forall (b :: BackendType) x.
Rep (RemoteSourceJoin b) x -> RemoteSourceJoin b
to :: forall x. Rep (RemoteSourceJoin b) x -> RemoteSourceJoin b
Generic)

deriving instance
  ( Backend b,
    Show (IR.SourceRelationshipSelection b Void IR.UnpreparedValue),
    Show (SourceConfig b)
  ) =>
  Show (RemoteSourceJoin b)

deriving instance
  ( Backend b,
    Eq (IR.SourceRelationshipSelection b Void IR.UnpreparedValue)
  ) =>
  Eq (RemoteSourceJoin b)

-------------------------------------------------------------------------------
-- Join to schema

-- | A 'RemoteSchemaJoin' contains all the contextual information required for
-- the execution of a join against a remote schema, translated from the IR's
-- representation of a selection (see 'AnnFieldG').
data RemoteSchemaJoin = RemoteSchemaJoin
  { -- | User-provided arguments with variables.
    RemoteSchemaJoin -> HashMap Name (InputValue RemoteSchemaVariable)
_rsjArgs :: !(HashMap.HashMap G.Name (P.InputValue RemoteSchemaVariable)),
    -- | Customizer for JSON result from the remote server.
    RemoteSchemaJoin -> ResultCustomizer
_rsjResultCustomizer :: !ResultCustomizer,
    -- | User-provided selection set of remote field.
    RemoteSchemaJoin -> SelectionSet Void RemoteSchemaVariable
_rsjSelSet :: !(IR.SelectionSet Void RemoteSchemaVariable),
    -- | A map of the join column to its alias in the response
    RemoteSchemaJoin -> HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases :: !(HashMap.HashMap FieldName JoinColumnAlias),
    -- | Remote server fields.
    RemoteSchemaJoin -> NonEmpty FieldCall
_rsjFieldCall :: !(NonEmpty FieldCall),
    -- | The remote schema server info.
    RemoteSchemaJoin -> RemoteSchemaInfo
_rsjRemoteSchema :: !RemoteSchemaInfo
  }
  deriving stock ((forall x. RemoteSchemaJoin -> Rep RemoteSchemaJoin x)
-> (forall x. Rep RemoteSchemaJoin x -> RemoteSchemaJoin)
-> Generic RemoteSchemaJoin
forall x. Rep RemoteSchemaJoin x -> RemoteSchemaJoin
forall x. RemoteSchemaJoin -> Rep RemoteSchemaJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaJoin -> Rep RemoteSchemaJoin x
from :: forall x. RemoteSchemaJoin -> Rep RemoteSchemaJoin x
$cto :: forall x. Rep RemoteSchemaJoin x -> RemoteSchemaJoin
to :: forall x. Rep RemoteSchemaJoin x -> RemoteSchemaJoin
Generic)

-- NOTE: This cannot be derived automatically, as 'RemoteResultCustomizer' does
-- not permit a proper 'Eq' instance (it's a newtype around a function).
instance Eq RemoteSchemaJoin where
  == :: RemoteSchemaJoin -> RemoteSchemaJoin -> Bool
(==) = ((HashMap Name (InputValue RemoteSchemaVariable),
  SelectionSet Void RemoteSchemaVariable,
  HashMap FieldName JoinColumnAlias, NonEmpty FieldCall,
  RemoteSchemaInfo)
 -> (HashMap Name (InputValue RemoteSchemaVariable),
     SelectionSet Void RemoteSchemaVariable,
     HashMap FieldName JoinColumnAlias, NonEmpty FieldCall,
     RemoteSchemaInfo)
 -> Bool)
-> (RemoteSchemaJoin
    -> (HashMap Name (InputValue RemoteSchemaVariable),
        SelectionSet Void RemoteSchemaVariable,
        HashMap FieldName JoinColumnAlias, NonEmpty FieldCall,
        RemoteSchemaInfo))
-> RemoteSchemaJoin
-> RemoteSchemaJoin
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (HashMap Name (InputValue RemoteSchemaVariable),
 SelectionSet Void RemoteSchemaVariable,
 HashMap FieldName JoinColumnAlias, NonEmpty FieldCall,
 RemoteSchemaInfo)
-> (HashMap Name (InputValue RemoteSchemaVariable),
    SelectionSet Void RemoteSchemaVariable,
    HashMap FieldName JoinColumnAlias, NonEmpty FieldCall,
    RemoteSchemaInfo)
-> Bool
forall a. Eq a => a -> a -> Bool
(==) \RemoteSchemaJoin {NonEmpty FieldCall
HashMap Name (InputValue RemoteSchemaVariable)
HashMap FieldName JoinColumnAlias
ResultCustomizer
RemoteSchemaInfo
SelectionSet Void RemoteSchemaVariable
_rsjJoinColumnAliases :: RemoteSchemaJoin -> HashMap FieldName JoinColumnAlias
_rsjArgs :: RemoteSchemaJoin -> HashMap Name (InputValue RemoteSchemaVariable)
_rsjResultCustomizer :: RemoteSchemaJoin -> ResultCustomizer
_rsjSelSet :: RemoteSchemaJoin -> SelectionSet Void RemoteSchemaVariable
_rsjFieldCall :: RemoteSchemaJoin -> NonEmpty FieldCall
_rsjRemoteSchema :: RemoteSchemaJoin -> RemoteSchemaInfo
_rsjArgs :: HashMap Name (InputValue RemoteSchemaVariable)
_rsjResultCustomizer :: ResultCustomizer
_rsjSelSet :: SelectionSet Void RemoteSchemaVariable
_rsjJoinColumnAliases :: HashMap FieldName JoinColumnAlias
_rsjFieldCall :: NonEmpty FieldCall
_rsjRemoteSchema :: RemoteSchemaInfo
..} ->
    (HashMap Name (InputValue RemoteSchemaVariable)
_rsjArgs, SelectionSet Void RemoteSchemaVariable
_rsjSelSet, HashMap FieldName JoinColumnAlias
_rsjJoinColumnAliases, NonEmpty FieldCall
_rsjFieldCall, RemoteSchemaInfo
_rsjRemoteSchema)

-------------------------------------------------------------------------------
-- Join arguments

-- | A map of fieldname to values extracted from each LHS row/object
--
-- For example, if a remote relationship 'weather' on 'city' table
-- is defined as follows:
--   city.weather = get_weather(city: city.code, cityState: city.state_code)
-- a join argument for this join would have the values of columns 'code' and
-- 'state_code' for each 'city' row that participates in the join
newtype JoinArgument = JoinArgument {JoinArgument -> HashMap FieldName Value
unJoinArgument :: HashMap.HashMap FieldName AO.Value}
  deriving stock (JoinArgument -> JoinArgument -> Bool
(JoinArgument -> JoinArgument -> Bool)
-> (JoinArgument -> JoinArgument -> Bool) -> Eq JoinArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinArgument -> JoinArgument -> Bool
== :: JoinArgument -> JoinArgument -> Bool
$c/= :: JoinArgument -> JoinArgument -> Bool
/= :: JoinArgument -> JoinArgument -> Bool
Eq, (forall x. JoinArgument -> Rep JoinArgument x)
-> (forall x. Rep JoinArgument x -> JoinArgument)
-> Generic JoinArgument
forall x. Rep JoinArgument x -> JoinArgument
forall x. JoinArgument -> Rep JoinArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinArgument -> Rep JoinArgument x
from :: forall x. JoinArgument -> Rep JoinArgument x
$cto :: forall x. Rep JoinArgument x -> JoinArgument
to :: forall x. Rep JoinArgument x -> JoinArgument
Generic, Int -> JoinArgument -> ShowS
[JoinArgument] -> ShowS
JoinArgument -> String
(Int -> JoinArgument -> ShowS)
-> (JoinArgument -> String)
-> ([JoinArgument] -> ShowS)
-> Show JoinArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinArgument -> ShowS
showsPrec :: Int -> JoinArgument -> ShowS
$cshow :: JoinArgument -> String
show :: JoinArgument -> String
$cshowList :: [JoinArgument] -> ShowS
showList :: [JoinArgument] -> ShowS
Show)
  deriving newtype (Eq JoinArgument
Eq JoinArgument
-> (Int -> JoinArgument -> Int)
-> (JoinArgument -> Int)
-> Hashable JoinArgument
Int -> JoinArgument -> Int
JoinArgument -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> JoinArgument -> Int
hashWithSalt :: Int -> JoinArgument -> Int
$chash :: JoinArgument -> Int
hash :: JoinArgument -> Int
Hashable)

-- | A unique id assigned to each join argument
type JoinArgumentId = Int

data JoinArguments = JoinArguments
  { -- | The 'RemoteJoin' associated with the join arguments within this
    -- structure.
    JoinArguments -> RemoteJoin
_jalJoin :: !RemoteJoin,
    -- | Arguments for which we must fetch a response from the remote, along with
    -- the identifiers that are used to stitch the final response together.
    --
    -- NOTE: 'HashMap.HashMap' is used to deduplicate multiple 'JoinArgument's so that
    -- we avoid fetching more data from a remote than is necessary (i.e. in the
    -- case of duplicate arguments).
    JoinArguments -> HashMap JoinArgument Int
_jalArguments :: !(HashMap.HashMap JoinArgument JoinArgumentId),
    -- | The 'FieldName' associated with the "replacement token" for this join
    -- argument.
    --
    -- NOTE: We need this for query logging; ideally we would use the full path
    -- for the GraphQL query associated with this remote join, but we don't have
    -- access to that here so this is the next best thing to do.
    JoinArguments -> FieldName
_jalFieldName :: !FieldName
  }
  deriving stock ((forall x. JoinArguments -> Rep JoinArguments x)
-> (forall x. Rep JoinArguments x -> JoinArguments)
-> Generic JoinArguments
forall x. Rep JoinArguments x -> JoinArguments
forall x. JoinArguments -> Rep JoinArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoinArguments -> Rep JoinArguments x
from :: forall x. JoinArguments -> Rep JoinArguments x
$cto :: forall x. Rep JoinArguments x -> JoinArguments
to :: forall x. Rep JoinArguments x -> JoinArguments
Generic)