module Hasura.GraphQL.Execute.RemoteJoin.Join
( processRemoteJoins,
foldJoinTreeWith,
)
where
import Control.Lens (view, _3)
import Data.Aeson.Ordered qualified as JO
import Data.ByteString.Lazy qualified as BL
import Data.Environment qualified as Env
import Data.HashMap.Strict.Extended qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashMap.Strict.NonEmpty qualified as NEMap
import Data.HashSet qualified as HS
import Data.IntMap.Strict qualified as IntMap
import Data.Text qualified as T
import Data.Tuple (swap)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Backend qualified as EB
import Hasura.GraphQL.Execute.Instances ()
import Hasura.GraphQL.Execute.RemoteJoin.RemoteSchema qualified as RS
import Hasura.GraphQL.Execute.RemoteJoin.Source qualified as S
import Hasura.GraphQL.Execute.RemoteJoin.Types
import Hasura.GraphQL.Logging (MonadQueryLog)
import Hasura.GraphQL.RemoteServer (execRemoteGQ)
import Hasura.GraphQL.Transport.Backend qualified as TB
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqOutgoing, GQLReqUnparsed)
import Hasura.GraphQL.Transport.Instances ()
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.RemoteSchema
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Types (RequestId)
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP
processRemoteJoins ::
forall m.
( MonadError QErr m,
MonadIO m,
EB.MonadQueryTags m,
MonadQueryLog m,
Tracing.MonadTrace m
) =>
RequestId ->
L.Logger L.Hasura ->
Env.Environment ->
HTTP.Manager ->
[HTTP.Header] ->
UserInfo ->
EncJSON ->
Maybe RemoteJoins ->
GQLReqUnparsed ->
m EncJSON
processRemoteJoins :: RequestId
-> Logger Hasura
-> Environment
-> Manager
-> [Header]
-> UserInfo
-> EncJSON
-> Maybe RemoteJoins
-> GQLReqUnparsed
-> m EncJSON
processRemoteJoins RequestId
requestId Logger Hasura
logger Environment
env Manager
manager [Header]
requestHeaders UserInfo
userInfo EncJSON
lhs Maybe RemoteJoins
maybeJoinTree GQLReqUnparsed
gqlreq =
Maybe RemoteJoins
-> EncJSON -> (RemoteJoins -> m EncJSON) -> m EncJSON
forall (f :: * -> *) a.
Applicative f =>
Maybe RemoteJoins -> a -> (RemoteJoins -> f a) -> f a
forRemoteJoins Maybe RemoteJoins
maybeJoinTree EncJSON
lhs \RemoteJoins
joinTree -> do
Value
lhsParsed <-
ByteString -> Either String Value
JO.eitherDecode (EncJSON -> ByteString
encJToLBS EncJSON
lhs)
Either String Value -> (String -> m Value) -> m Value
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Text -> m Value
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m Value) -> (String -> Text) -> String -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
Identity Value
jsonResult <-
(AnyBackend SourceJoinCall -> m ByteString)
-> (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString)
-> UserInfo
-> Identity Value
-> RemoteJoins
-> m (Identity Value)
forall (m :: * -> *) (f :: * -> *).
(MonadError QErr m, MonadQueryTags m, Traversable f) =>
(AnyBackend SourceJoinCall -> m ByteString)
-> (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString)
-> UserInfo
-> f Value
-> RemoteJoins
-> m (f Value)
foldJoinTreeWith
AnyBackend SourceJoinCall -> m ByteString
callSource
ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString
callRemoteServer
UserInfo
userInfo
(Value -> Identity Value
forall a. a -> Identity a
Identity Value
lhsParsed)
RemoteJoins
joinTree
EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
encJFromOrderedValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ Identity Value -> Value
forall a. Identity a -> a
runIdentity Identity Value
jsonResult
where
callSource ::
AB.AnyBackend S.SourceJoinCall ->
m BL.ByteString
callSource :: AnyBackend SourceJoinCall -> m ByteString
callSource AnyBackend SourceJoinCall
sourceJoinCall =
AnyBackend SourceJoinCall
-> (forall (b :: BackendType).
BackendTransport b =>
SourceJoinCall b -> m ByteString)
-> m ByteString
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @TB.BackendTransport AnyBackend SourceJoinCall
sourceJoinCall \(S.SourceJoinCall {SourceConfig b
RootFieldAlias
DBStepInfo b
_sjcStepInfo :: forall (b :: BackendType). SourceJoinCall b -> DBStepInfo b
_sjcSourceConfig :: forall (b :: BackendType). SourceJoinCall b -> SourceConfig b
_sjcRootFieldAlias :: forall (b :: BackendType). SourceJoinCall b -> RootFieldAlias
_sjcStepInfo :: DBStepInfo b
_sjcSourceConfig :: SourceConfig b
_sjcRootFieldAlias :: RootFieldAlias
..} :: S.SourceJoinCall b) -> do
(DiffTime, EncJSON)
response <-
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> m (DiffTime, EncJSON)
forall (b :: BackendType) (m :: * -> *).
(BackendTransport b, MonadIO m, MonadError QErr m, MonadQueryLog m,
MonadTrace m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig b
-> ExecutionMonad b EncJSON
-> Maybe (PreparedQuery b)
-> m (DiffTime, EncJSON)
TB.runDBQuery @b
RequestId
requestId
GQLReqUnparsed
gqlreq
RootFieldAlias
_sjcRootFieldAlias
UserInfo
userInfo
Logger Hasura
logger
SourceConfig b
_sjcSourceConfig
(DBStepInfo b -> ExecutionMonad b EncJSON
forall (b :: BackendType). DBStepInfo b -> ExecutionMonad b EncJSON
EB.dbsiAction DBStepInfo b
_sjcStepInfo)
(DBStepInfo b -> Maybe (PreparedQuery b)
forall (b :: BackendType). DBStepInfo b -> Maybe (PreparedQuery b)
EB.dbsiPreparedQuery DBStepInfo b
_sjcStepInfo)
ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString) -> EncJSON -> ByteString
forall a b. (a -> b) -> a -> b
$ (DiffTime, EncJSON) -> EncJSON
forall a b. (a, b) -> b
snd (DiffTime, EncJSON)
response
callRemoteServer ::
ValidatedRemoteSchemaDef ->
GQLReqOutgoing ->
m BL.ByteString
callRemoteServer :: ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString
callRemoteServer ValidatedRemoteSchemaDef
remoteSchemaInfo GQLReqOutgoing
request =
((DiffTime, [Header], ByteString) -> ByteString)
-> m (DiffTime, [Header], ByteString) -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString (DiffTime, [Header], ByteString) ByteString
-> (DiffTime, [Header], ByteString) -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString (DiffTime, [Header], ByteString) ByteString
forall s t a b. Field3 s t a b => Lens s t a b
_3) (m (DiffTime, [Header], ByteString) -> m ByteString)
-> m (DiffTime, [Header], ByteString) -> m ByteString
forall a b. (a -> b) -> a -> b
$
Environment
-> Manager
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m) =>
Environment
-> Manager
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
execRemoteGQ Environment
env Manager
manager UserInfo
userInfo [Header]
requestHeaders ValidatedRemoteSchemaDef
remoteSchemaInfo GQLReqOutgoing
request
foldJoinTreeWith ::
( MonadError QErr m,
EB.MonadQueryTags m,
Traversable f
) =>
(AB.AnyBackend S.SourceJoinCall -> m BL.ByteString) ->
(ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m BL.ByteString) ->
UserInfo ->
(f JO.Value) ->
RemoteJoins ->
m (f JO.Value)
foldJoinTreeWith :: (AnyBackend SourceJoinCall -> m ByteString)
-> (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString)
-> UserInfo
-> f Value
-> RemoteJoins
-> m (f Value)
foldJoinTreeWith AnyBackend SourceJoinCall -> m ByteString
callSource ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString
callRemoteSchema UserInfo
userInfo f Value
lhs RemoteJoins
joinTree = do
(f (CompositeValue ReplacementToken)
compositeValue, IntMap JoinArguments
joins) <- JoinTree (JoinCallId, RemoteJoin)
-> f Value
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments)
forall (f :: * -> *) (m :: * -> *).
(MonadError QErr m, Traversable f) =>
JoinTree (JoinCallId, RemoteJoin)
-> f Value
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments)
collectJoinArguments (RemoteJoins -> JoinTree (JoinCallId, RemoteJoin)
assignJoinIds RemoteJoins
joinTree) f Value
lhs
IntMap (IntMap Value)
joinIndices <- (IntMap (Maybe (IntMap Value)) -> IntMap (IntMap Value))
-> m (IntMap (Maybe (IntMap Value))) -> m (IntMap (IntMap Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntMap (Maybe (IntMap Value)) -> IntMap (IntMap Value)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (m (IntMap (Maybe (IntMap Value))) -> m (IntMap (IntMap Value)))
-> m (IntMap (Maybe (IntMap Value))) -> m (IntMap (IntMap Value))
forall a b. (a -> b) -> a -> b
$
IntMap JoinArguments
-> (JoinArguments -> m (Maybe (IntMap Value)))
-> m (IntMap (Maybe (IntMap Value)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for IntMap JoinArguments
joins ((JoinArguments -> m (Maybe (IntMap Value)))
-> m (IntMap (Maybe (IntMap Value))))
-> (JoinArguments -> m (Maybe (IntMap Value)))
-> m (IntMap (Maybe (IntMap Value)))
forall a b. (a -> b) -> a -> b
$ \JoinArguments {HashMap JoinArgument JoinCallId
FieldName
RemoteJoin
_jalFieldName :: JoinArguments -> FieldName
_jalArguments :: JoinArguments -> HashMap JoinArgument JoinCallId
_jalJoin :: JoinArguments -> RemoteJoin
_jalFieldName :: FieldName
_jalArguments :: HashMap JoinArgument JoinCallId
_jalJoin :: RemoteJoin
..} -> do
let joinArguments :: IntMap JoinArgument
joinArguments = [(JoinCallId, JoinArgument)] -> IntMap JoinArgument
forall a. [(JoinCallId, a)] -> IntMap a
IntMap.fromList ([(JoinCallId, JoinArgument)] -> IntMap JoinArgument)
-> [(JoinCallId, JoinArgument)] -> IntMap JoinArgument
forall a b. (a -> b) -> a -> b
$ ((JoinArgument, JoinCallId) -> (JoinCallId, JoinArgument))
-> [(JoinArgument, JoinCallId)] -> [(JoinCallId, JoinArgument)]
forall a b. (a -> b) -> [a] -> [b]
map (JoinArgument, JoinCallId) -> (JoinCallId, JoinArgument)
forall a b. (a, b) -> (b, a)
swap ([(JoinArgument, JoinCallId)] -> [(JoinCallId, JoinArgument)])
-> [(JoinArgument, JoinCallId)] -> [(JoinCallId, JoinArgument)]
forall a b. (a -> b) -> a -> b
$ HashMap JoinArgument JoinCallId -> [(JoinArgument, JoinCallId)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap JoinArgument JoinCallId
_jalArguments
Maybe (Maybe RemoteJoins, IntMap Value)
previousStep <- case RemoteJoin
_jalJoin of
RemoteJoinRemoteSchema RemoteSchemaJoin
remoteSchemaJoin Maybe RemoteJoins
childJoinTree -> do
let remoteSchemaInfo :: ValidatedRemoteSchemaDef
remoteSchemaInfo = RemoteSchemaInfo -> ValidatedRemoteSchemaDef
rsDef (RemoteSchemaInfo -> ValidatedRemoteSchemaDef)
-> RemoteSchemaInfo -> ValidatedRemoteSchemaDef
forall a b. (a -> b) -> a -> b
$ RemoteSchemaJoin -> RemoteSchemaInfo
_rsjRemoteSchema RemoteSchemaJoin
remoteSchemaJoin
Maybe (IntMap Value)
maybeJoinIndex <- (GQLReqOutgoing -> m ByteString)
-> UserInfo
-> RemoteSchemaJoin
-> IntMap JoinArgument
-> m (Maybe (IntMap Value))
forall (m :: * -> *).
MonadError QErr m =>
(GQLReqOutgoing -> m ByteString)
-> UserInfo
-> RemoteSchemaJoin
-> IntMap JoinArgument
-> m (Maybe (IntMap Value))
RS.makeRemoteSchemaJoinCall (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString
callRemoteSchema ValidatedRemoteSchemaDef
remoteSchemaInfo) UserInfo
userInfo RemoteSchemaJoin
remoteSchemaJoin IntMap JoinArgument
joinArguments
Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value)))
-> Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value))
forall a b. (a -> b) -> a -> b
$ (IntMap Value -> (Maybe RemoteJoins, IntMap Value))
-> Maybe (IntMap Value) -> Maybe (Maybe RemoteJoins, IntMap Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe RemoteJoins
childJoinTree,) Maybe (IntMap Value)
maybeJoinIndex
RemoteJoinSource AnyBackend RemoteSourceJoin
sourceJoin Maybe RemoteJoins
childJoinTree -> do
Maybe (IntMap Value)
maybeJoinIndex <- (AnyBackend SourceJoinCall -> m ByteString)
-> UserInfo
-> AnyBackend RemoteSourceJoin
-> FieldName
-> IntMap JoinArgument
-> m (Maybe (IntMap Value))
forall (m :: * -> *).
(MonadQueryTags m, MonadError QErr m) =>
(AnyBackend SourceJoinCall -> m ByteString)
-> UserInfo
-> AnyBackend RemoteSourceJoin
-> FieldName
-> IntMap JoinArgument
-> m (Maybe (IntMap Value))
S.makeSourceJoinCall AnyBackend SourceJoinCall -> m ByteString
callSource UserInfo
userInfo AnyBackend RemoteSourceJoin
sourceJoin FieldName
_jalFieldName IntMap JoinArgument
joinArguments
Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value)))
-> Maybe (Maybe RemoteJoins, IntMap Value)
-> m (Maybe (Maybe RemoteJoins, IntMap Value))
forall a b. (a -> b) -> a -> b
$ (IntMap Value -> (Maybe RemoteJoins, IntMap Value))
-> Maybe (IntMap Value) -> Maybe (Maybe RemoteJoins, IntMap Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe RemoteJoins
childJoinTree,) Maybe (IntMap Value)
maybeJoinIndex
Maybe (Maybe RemoteJoins, IntMap Value)
-> ((Maybe RemoteJoins, IntMap Value) -> m (IntMap Value))
-> m (Maybe (IntMap Value))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Maybe RemoteJoins, IntMap Value)
previousStep (((Maybe RemoteJoins, IntMap Value) -> m (IntMap Value))
-> m (Maybe (IntMap Value)))
-> ((Maybe RemoteJoins, IntMap Value) -> m (IntMap Value))
-> m (Maybe (IntMap Value))
forall a b. (a -> b) -> a -> b
$ \(Maybe RemoteJoins
childJoinTree, IntMap Value
joinIndex) -> do
Maybe RemoteJoins
-> IntMap Value
-> (RemoteJoins -> m (IntMap Value))
-> m (IntMap Value)
forall (f :: * -> *) a.
Applicative f =>
Maybe RemoteJoins -> a -> (RemoteJoins -> f a) -> f a
forRemoteJoins Maybe RemoteJoins
childJoinTree IntMap Value
joinIndex ((RemoteJoins -> m (IntMap Value)) -> m (IntMap Value))
-> (RemoteJoins -> m (IntMap Value)) -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$ \RemoteJoins
childRemoteJoins -> do
[Value]
results <-
(AnyBackend SourceJoinCall -> m ByteString)
-> (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString)
-> UserInfo
-> [Value]
-> RemoteJoins
-> m [Value]
forall (m :: * -> *) (f :: * -> *).
(MonadError QErr m, MonadQueryTags m, Traversable f) =>
(AnyBackend SourceJoinCall -> m ByteString)
-> (ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString)
-> UserInfo
-> f Value
-> RemoteJoins
-> m (f Value)
foldJoinTreeWith
AnyBackend SourceJoinCall -> m ByteString
callSource
ValidatedRemoteSchemaDef -> GQLReqOutgoing -> m ByteString
callRemoteSchema
UserInfo
userInfo
(IntMap Value -> [Value]
forall a. IntMap a -> [a]
IntMap.elems IntMap Value
joinIndex)
RemoteJoins
childRemoteJoins
IntMap Value -> m (IntMap Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap Value -> m (IntMap Value))
-> IntMap Value -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$ [(JoinCallId, Value)] -> IntMap Value
forall a. [(JoinCallId, a)] -> IntMap a
IntMap.fromAscList ([(JoinCallId, Value)] -> IntMap Value)
-> [(JoinCallId, Value)] -> IntMap Value
forall a b. (a -> b) -> a -> b
$ [JoinCallId] -> [Value] -> [(JoinCallId, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip (IntMap Value -> [JoinCallId]
forall a. IntMap a -> [JoinCallId]
IntMap.keys IntMap Value
joinIndex) [Value]
results
IntMap (IntMap Value)
-> f (CompositeValue ReplacementToken) -> m (f Value)
forall (f :: * -> *) (m :: * -> *).
(MonadError QErr m, Traversable f) =>
IntMap (IntMap Value)
-> f (CompositeValue ReplacementToken) -> m (f Value)
joinResults IntMap (IntMap Value)
joinIndices f (CompositeValue ReplacementToken)
compositeValue
forRemoteJoins ::
(Applicative f) =>
Maybe RemoteJoins ->
a ->
(RemoteJoins -> f a) ->
f a
forRemoteJoins :: Maybe RemoteJoins -> a -> (RemoteJoins -> f a) -> f a
forRemoteJoins Maybe RemoteJoins
remoteJoins a
onNoJoins RemoteJoins -> f a
f =
f a -> (RemoteJoins -> f a) -> Maybe RemoteJoins -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
onNoJoins) RemoteJoins -> f a
f Maybe RemoteJoins
remoteJoins
assignJoinIds :: JoinTree RemoteJoin -> JoinTree (JoinCallId, RemoteJoin)
assignJoinIds :: RemoteJoins -> JoinTree (JoinCallId, RemoteJoin)
assignJoinIds RemoteJoins
joinTree =
State
(JoinCallId, [(JoinCallId, RemoteJoin)])
(JoinTree (JoinCallId, RemoteJoin))
-> (JoinCallId, [(JoinCallId, RemoteJoin)])
-> JoinTree (JoinCallId, RemoteJoin)
forall s a. State s a -> s -> a
evalState ((RemoteJoin
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin))
-> RemoteJoins
-> State
(JoinCallId, [(JoinCallId, RemoteJoin)])
(JoinTree (JoinCallId, RemoteJoin))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse RemoteJoin
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin)
assignId RemoteJoins
joinTree) (JoinCallId
0, [])
where
assignId ::
RemoteJoin ->
State (JoinCallId, [(JoinCallId, RemoteJoin)]) (JoinCallId, RemoteJoin)
assignId :: RemoteJoin
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin)
assignId RemoteJoin
remoteJoin = do
(JoinCallId
joinCallId, [(JoinCallId, RemoteJoin)]
joinIds) <- StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, [(JoinCallId, RemoteJoin)])
forall s (m :: * -> *). MonadState s m => m s
get
let mJoinId :: Maybe (JoinCallId, RemoteJoin)
mJoinId = [(JoinCallId, RemoteJoin)]
joinIds [(JoinCallId, RemoteJoin)]
-> ([(JoinCallId, RemoteJoin)] -> Maybe (JoinCallId, RemoteJoin))
-> Maybe (JoinCallId, RemoteJoin)
forall a b. a -> (a -> b) -> b
& ((JoinCallId, RemoteJoin) -> Bool)
-> [(JoinCallId, RemoteJoin)] -> Maybe (JoinCallId, RemoteJoin)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \(JoinCallId
_, RemoteJoin
j) -> RemoteJoin
j RemoteJoin -> RemoteJoin -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteJoin
remoteJoin
Maybe (JoinCallId, RemoteJoin)
mJoinId Maybe (JoinCallId, RemoteJoin)
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin)
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` do
(JoinCallId, [(JoinCallId, RemoteJoin)])
-> StateT (JoinCallId, [(JoinCallId, RemoteJoin)]) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (JoinCallId
joinCallId JoinCallId -> JoinCallId -> JoinCallId
forall a. Num a => a -> a -> a
+ JoinCallId
1, (JoinCallId
joinCallId, RemoteJoin
remoteJoin) (JoinCallId, RemoteJoin)
-> [(JoinCallId, RemoteJoin)] -> [(JoinCallId, RemoteJoin)]
forall a. a -> [a] -> [a]
: [(JoinCallId, RemoteJoin)]
joinIds)
(JoinCallId, RemoteJoin)
-> StateT
(JoinCallId, [(JoinCallId, RemoteJoin)])
Identity
(JoinCallId, RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JoinCallId
joinCallId, RemoteJoin
remoteJoin)
collectJoinArguments ::
forall f m.
(MonadError QErr m, Traversable f) =>
JoinTree (JoinCallId, RemoteJoin) ->
f JO.Value ->
m (f (CompositeValue ReplacementToken), IntMap.IntMap JoinArguments)
collectJoinArguments :: JoinTree (JoinCallId, RemoteJoin)
-> f Value
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments)
collectJoinArguments JoinTree (JoinCallId, RemoteJoin)
joinTree f Value
lhs = do
(f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
result <- (StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
-> (JoinCallId, IntMap JoinArguments)
-> m (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments)))
-> (JoinCallId, IntMap JoinArguments)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
-> m (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
-> (JoinCallId, IntMap JoinArguments)
-> m (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (JoinCallId
0, IntMap JoinArguments
forall a. Monoid a => a
mempty) (StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
-> m (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments)))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
-> m (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
forall a b. (a -> b) -> a -> b
$ (Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken))
-> f Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(f (CompositeValue ReplacementToken))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (JoinTree (JoinCallId, RemoteJoin)
-> Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
traverseValue JoinTree (JoinCallId, RemoteJoin)
joinTree) f Value
lhs
(f (CompositeValue ReplacementToken), IntMap JoinArguments)
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((f (CompositeValue ReplacementToken), IntMap JoinArguments)
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments))
-> (f (CompositeValue ReplacementToken), IntMap JoinArguments)
-> m (f (CompositeValue ReplacementToken), IntMap JoinArguments)
forall a b. (a -> b) -> a -> b
$ ((JoinCallId, IntMap JoinArguments) -> IntMap JoinArguments)
-> (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
-> (f (CompositeValue ReplacementToken), IntMap JoinArguments)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (JoinCallId, IntMap JoinArguments) -> IntMap JoinArguments
forall a b. (a, b) -> b
snd (f (CompositeValue ReplacementToken),
(JoinCallId, IntMap JoinArguments))
result
where
getReplacementToken ::
IntMap.Key ->
RemoteJoin ->
JoinArgument ->
FieldName ->
StateT
(JoinArgumentId, IntMap.IntMap JoinArguments)
m
ReplacementToken
getReplacementToken :: JoinCallId
-> RemoteJoin
-> JoinArgument
-> FieldName
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
getReplacementToken JoinCallId
joinId RemoteJoin
remoteJoin JoinArgument
argument FieldName
fieldName = do
(JoinCallId
counter, IntMap JoinArguments
joins) <- StateT
(JoinCallId, IntMap JoinArguments)
m
(JoinCallId, IntMap JoinArguments)
forall s (m :: * -> *). MonadState s m => m s
get
case JoinCallId -> IntMap JoinArguments -> Maybe JoinArguments
forall a. JoinCallId -> IntMap a -> Maybe a
IntMap.lookup JoinCallId
joinId IntMap JoinArguments
joins of
Just (JoinArguments RemoteJoin
_remoteJoin HashMap JoinArgument JoinCallId
arguments FieldName
_fieldName) ->
case JoinArgument -> HashMap JoinArgument JoinCallId -> Maybe JoinCallId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup JoinArgument
argument HashMap JoinArgument JoinCallId
arguments of
Just JoinCallId
argumentId -> ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken)
-> ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
forall a b. (a -> b) -> a -> b
$ JoinCallId -> JoinCallId -> ReplacementToken
ReplacementToken JoinCallId
joinId JoinCallId
argumentId
Maybe JoinCallId
Nothing -> JoinCallId
-> IntMap JoinArguments
-> HashMap JoinArgument JoinCallId
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
addNewArgument JoinCallId
counter IntMap JoinArguments
joins HashMap JoinArgument JoinCallId
arguments
Maybe JoinArguments
Nothing -> JoinCallId
-> IntMap JoinArguments
-> HashMap JoinArgument JoinCallId
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
addNewArgument JoinCallId
counter IntMap JoinArguments
joins HashMap JoinArgument JoinCallId
forall a. Monoid a => a
mempty
where
addNewArgument :: JoinCallId
-> IntMap JoinArguments
-> HashMap JoinArgument JoinCallId
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
addNewArgument JoinCallId
counter IntMap JoinArguments
joins HashMap JoinArgument JoinCallId
arguments = do
let argumentId :: JoinCallId
argumentId = JoinCallId
counter
newArguments :: JoinArguments
newArguments =
RemoteJoin
-> HashMap JoinArgument JoinCallId -> FieldName -> JoinArguments
JoinArguments
RemoteJoin
remoteJoin
(JoinArgument
-> JoinCallId
-> HashMap JoinArgument JoinCallId
-> HashMap JoinArgument JoinCallId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert JoinArgument
argument JoinCallId
argumentId HashMap JoinArgument JoinCallId
arguments)
FieldName
fieldName
(JoinCallId, IntMap JoinArguments)
-> StateT (JoinCallId, IntMap JoinArguments) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (JoinCallId
counter JoinCallId -> JoinCallId -> JoinCallId
forall a. Num a => a -> a -> a
+ JoinCallId
1, JoinCallId
-> JoinArguments -> IntMap JoinArguments -> IntMap JoinArguments
forall a. JoinCallId -> a -> IntMap a -> IntMap a
IntMap.insert JoinCallId
joinId JoinArguments
newArguments IntMap JoinArguments
joins)
ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken)
-> ReplacementToken
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
forall a b. (a -> b) -> a -> b
$ JoinCallId -> JoinCallId -> ReplacementToken
ReplacementToken JoinCallId
joinId JoinCallId
argumentId
traverseValue ::
JoinTree (IntMap.Key, RemoteJoin) ->
JO.Value ->
StateT
(JoinArgumentId, IntMap.IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
traverseValue :: JoinTree (JoinCallId, RemoteJoin)
-> Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
traverseValue JoinTree (JoinCallId, RemoteJoin)
joinTree_ = \case
Value
JO.Null -> CompositeValue ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositeValue ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken))
-> CompositeValue ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
forall a b. (a -> b) -> a -> b
$ Value -> CompositeValue ReplacementToken
forall a. Value -> CompositeValue a
CVOrdValue Value
JO.Null
JO.Object Object
object -> CompositeObject ReplacementToken -> CompositeValue ReplacementToken
forall a. CompositeObject a -> CompositeValue a
CVObject (CompositeObject ReplacementToken
-> CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JoinTree (JoinCallId, RemoteJoin)
-> Object
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
traverseObject JoinTree (JoinCallId, RemoteJoin)
joinTree_ Object
object
JO.Array Array
array -> [CompositeValue ReplacementToken]
-> CompositeValue ReplacementToken
forall a. [CompositeValue a] -> CompositeValue a
CVObjectArray ([CompositeValue ReplacementToken]
-> CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
[CompositeValue ReplacementToken]
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken))
-> [Value]
-> StateT
(JoinCallId, IntMap JoinArguments)
m
[CompositeValue ReplacementToken]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (JoinTree (JoinCallId, RemoteJoin)
-> Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
traverseValue JoinTree (JoinCallId, RemoteJoin)
joinTree_) (Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
array)
Value
_ -> Text
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"found a scalar value when traversing with a non-empty join tree"
traverseObject ::
JoinTree (IntMap.Key, RemoteJoin) ->
JO.Object ->
StateT
(JoinArgumentId, IntMap.IntMap JoinArguments)
m
(InsOrdHashMap Text (CompositeValue ReplacementToken))
traverseObject :: JoinTree (JoinCallId, RemoteJoin)
-> Object
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
traverseObject JoinTree (JoinCallId, RemoteJoin)
joinTree_ Object
object = do
let joinTreeNodes :: NEHashMap QualifiedFieldName (JoinNode (JoinCallId, RemoteJoin))
joinTreeNodes = JoinTree (JoinCallId, RemoteJoin)
-> NEHashMap QualifiedFieldName (JoinNode (JoinCallId, RemoteJoin))
forall a. JoinTree a -> NEHashMap QualifiedFieldName (JoinNode a)
unJoinTree JoinTree (JoinCallId, RemoteJoin)
joinTree_
phantomFields :: HashSet Text
phantomFields =
[Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$
(FieldName -> Text) -> [FieldName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FieldName -> Text
getFieldNameTxt ([FieldName] -> [Text]) -> [FieldName] -> [Text]
forall a b. (a -> b) -> a -> b
$
((JoinCallId, RemoteJoin) -> [FieldName])
-> [(JoinCallId, RemoteJoin)] -> [FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RemoteJoin -> [FieldName]
getPhantomFields (RemoteJoin -> [FieldName])
-> ((JoinCallId, RemoteJoin) -> RemoteJoin)
-> (JoinCallId, RemoteJoin)
-> [FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JoinCallId, RemoteJoin) -> RemoteJoin
forall a b. (a, b) -> b
snd) ([(JoinCallId, RemoteJoin)] -> [FieldName])
-> [(JoinCallId, RemoteJoin)] -> [FieldName]
forall a b. (a -> b) -> a -> b
$ JoinTree (JoinCallId, RemoteJoin) -> [(JoinCallId, RemoteJoin)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList JoinTree (JoinCallId, RemoteJoin)
joinTree_
Maybe Text
joinTypeName <- case Text -> Object -> Maybe Value
JO.lookup Text
"__hasura_internal_typename" Object
object of
Maybe Value
Nothing -> Maybe Text
-> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
Just (JO.String Text
typename) -> Maybe Text
-> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
-> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text))
-> Maybe Text
-> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
typename
Just Value
value -> Text -> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text))
-> Text -> StateT (JoinCallId, IntMap JoinArguments) m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
"The reserved __hasura_internal_typename field contains an unexpected value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a. Show a => a -> Text
tshow Value
value
[(Text, Maybe (CompositeValue ReplacementToken))]
compositeObject <- [(Text, Value)]
-> ((Text, Value)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Text, Maybe (CompositeValue ReplacementToken)))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
[(Text, Maybe (CompositeValue ReplacementToken))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Object -> [(Text, Value)]
JO.toList Object
object) (((Text, Value)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Text, Maybe (CompositeValue ReplacementToken)))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
[(Text, Maybe (CompositeValue ReplacementToken))])
-> ((Text, Value)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Text, Maybe (CompositeValue ReplacementToken)))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
[(Text, Maybe (CompositeValue ReplacementToken))]
forall a b. (a -> b) -> a -> b
$ \(Text
fieldName, Value
value_) ->
(Text
fieldName,) (Maybe (CompositeValue ReplacementToken)
-> (Text, Maybe (CompositeValue ReplacementToken)))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Text, Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case QualifiedFieldName
-> NEHashMap QualifiedFieldName (JoinNode (JoinCallId, RemoteJoin))
-> Maybe (JoinNode (JoinCallId, RemoteJoin))
forall k v. (Eq k, Hashable k) => k -> NEHashMap k v -> Maybe v
NEMap.lookup (Maybe Text -> Text -> QualifiedFieldName
QualifiedFieldName Maybe Text
joinTypeName Text
fieldName) NEHashMap QualifiedFieldName (JoinNode (JoinCallId, RemoteJoin))
joinTreeNodes of
Just (Leaf (JoinCallId
joinId, RemoteJoin
remoteJoin)) -> do
HashMap FieldName Value
joinArgument <- HashMap FieldName JoinColumnAlias
-> (JoinColumnAlias
-> StateT (JoinCallId, IntMap JoinArguments) m Value)
-> StateT
(JoinCallId, IntMap JoinArguments) m (HashMap FieldName Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (RemoteJoin -> HashMap FieldName JoinColumnAlias
getJoinColumnMapping RemoteJoin
remoteJoin) ((JoinColumnAlias
-> StateT (JoinCallId, IntMap JoinArguments) m Value)
-> StateT
(JoinCallId, IntMap JoinArguments) m (HashMap FieldName Value))
-> (JoinColumnAlias
-> StateT (JoinCallId, IntMap JoinArguments) m Value)
-> StateT
(JoinCallId, IntMap JoinArguments) m (HashMap FieldName Value)
forall a b. (a -> b) -> a -> b
$ \JoinColumnAlias
alias -> do
let aliasTxt :: Text
aliasTxt = FieldName -> Text
getFieldNameTxt (FieldName -> Text) -> FieldName -> Text
forall a b. (a -> b) -> a -> b
$ JoinColumnAlias -> FieldName
getAliasFieldName JoinColumnAlias
alias
Maybe Value
-> StateT (JoinCallId, IntMap JoinArguments) m Value
-> StateT (JoinCallId, IntMap JoinArguments) m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Object -> Maybe Value
JO.lookup Text
aliasTxt Object
object) (StateT (JoinCallId, IntMap JoinArguments) m Value
-> StateT (JoinCallId, IntMap JoinArguments) m Value)
-> StateT (JoinCallId, IntMap JoinArguments) m Value
-> StateT (JoinCallId, IntMap JoinArguments) m Value
forall a b. (a -> b) -> a -> b
$
Text -> StateT (JoinCallId, IntMap JoinArguments) m Value
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> StateT (JoinCallId, IntMap JoinArguments) m Value)
-> Text -> StateT (JoinCallId, IntMap JoinArguments) m Value
forall a b. (a -> b) -> a -> b
$ Text
"a join column is missing from the response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
aliasTxt
if HashMap FieldName Value -> Bool
forall k v. HashMap k v -> Bool
Map.null ((Value -> Bool)
-> HashMap FieldName Value -> HashMap FieldName Value
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
JO.Null) HashMap FieldName Value
joinArgument)
then
CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a. a -> Maybe a
Just (CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken))
-> (ReplacementToken -> CompositeValue ReplacementToken)
-> ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplacementToken -> CompositeValue ReplacementToken
forall a. a -> CompositeValue a
CVFromRemote
(ReplacementToken -> Maybe (CompositeValue ReplacementToken))
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JoinCallId
-> RemoteJoin
-> JoinArgument
-> FieldName
-> StateT (JoinCallId, IntMap JoinArguments) m ReplacementToken
getReplacementToken JoinCallId
joinId RemoteJoin
remoteJoin (HashMap FieldName Value -> JoinArgument
JoinArgument HashMap FieldName Value
joinArgument) (Text -> FieldName
FieldName Text
fieldName)
else
Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken)))
-> Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall a b. (a -> b) -> a -> b
$ CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a. a -> Maybe a
Just (CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken))
-> CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a b. (a -> b) -> a -> b
$ Value -> CompositeValue ReplacementToken
forall a. Value -> CompositeValue a
CVOrdValue Value
JO.Null
Just (Tree JoinTree (JoinCallId, RemoteJoin)
joinSubTree) ->
CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a. a -> Maybe a
Just (CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken))
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JoinTree (JoinCallId, RemoteJoin)
-> Value
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeValue ReplacementToken)
traverseValue JoinTree (JoinCallId, RemoteJoin)
joinSubTree Value
value_
Maybe (JoinNode (JoinCallId, RemoteJoin))
Nothing ->
if Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Text
fieldName HashSet Text
phantomFields Bool -> Bool -> Bool
|| Text
fieldName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"__hasura_internal_typename"
then Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CompositeValue ReplacementToken)
forall a. Maybe a
Nothing
else Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken)))
-> Maybe (CompositeValue ReplacementToken)
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(Maybe (CompositeValue ReplacementToken))
forall a b. (a -> b) -> a -> b
$ CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a. a -> Maybe a
Just (CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken))
-> CompositeValue ReplacementToken
-> Maybe (CompositeValue ReplacementToken)
forall a b. (a -> b) -> a -> b
$ Value -> CompositeValue ReplacementToken
forall a. Value -> CompositeValue a
CVOrdValue Value
value_
CompositeObject ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompositeObject ReplacementToken
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken))
-> ([(Text, CompositeValue ReplacementToken)]
-> CompositeObject ReplacementToken)
-> [(Text, CompositeValue ReplacementToken)]
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, CompositeValue ReplacementToken)]
-> CompositeObject ReplacementToken
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
OMap.fromList ([(Text, CompositeValue ReplacementToken)]
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken))
-> [(Text, CompositeValue ReplacementToken)]
-> StateT
(JoinCallId, IntMap JoinArguments)
m
(CompositeObject ReplacementToken)
forall a b. (a -> b) -> a -> b
$
((Text, Maybe (CompositeValue ReplacementToken))
-> Maybe (Text, CompositeValue ReplacementToken))
-> [(Text, Maybe (CompositeValue ReplacementToken))]
-> [(Text, CompositeValue ReplacementToken)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Text, Maybe (CompositeValue ReplacementToken))
-> Maybe (Text, CompositeValue ReplacementToken)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [(Text, Maybe (CompositeValue ReplacementToken))]
compositeObject
joinResults ::
forall f m.
(MonadError QErr m, Traversable f) =>
IntMap.IntMap (IntMap.IntMap JO.Value) ->
f (CompositeValue ReplacementToken) ->
m (f JO.Value)
joinResults :: IntMap (IntMap Value)
-> f (CompositeValue ReplacementToken) -> m (f Value)
joinResults IntMap (IntMap Value)
remoteResults f (CompositeValue ReplacementToken)
compositeValues = do
(CompositeValue ReplacementToken -> m Value)
-> f (CompositeValue ReplacementToken) -> m (f Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CompositeValue Value -> Value)
-> m (CompositeValue Value) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompositeValue Value -> Value
compositeValueToJSON (m (CompositeValue Value) -> m Value)
-> (CompositeValue ReplacementToken -> m (CompositeValue Value))
-> CompositeValue ReplacementToken
-> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplacementToken -> m Value)
-> CompositeValue ReplacementToken -> m (CompositeValue Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ReplacementToken -> m Value
replaceToken) f (CompositeValue ReplacementToken)
compositeValues
where
replaceToken :: ReplacementToken -> m JO.Value
replaceToken :: ReplacementToken -> m Value
replaceToken (ReplacementToken JoinCallId
joinCallId JoinCallId
argumentId) = do
IntMap Value
joinCallResults <-
Maybe (IntMap Value) -> m (IntMap Value) -> m (IntMap Value)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (JoinCallId -> IntMap (IntMap Value) -> Maybe (IntMap Value)
forall a. JoinCallId -> IntMap a -> Maybe a
IntMap.lookup JoinCallId
joinCallId IntMap (IntMap Value)
remoteResults) (m (IntMap Value) -> m (IntMap Value))
-> m (IntMap Value) -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$
Text -> m (IntMap Value)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (IntMap Value)) -> Text -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$
Text
"couldn't find results for the join with id: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> JoinCallId -> Text
forall a. Show a => a -> Text
tshow JoinCallId
joinCallId
Maybe Value -> m Value -> m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (JoinCallId -> IntMap Value -> Maybe Value
forall a. JoinCallId -> IntMap a -> Maybe a
IntMap.lookup JoinCallId
argumentId IntMap Value
joinCallResults) (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$
Text -> m Value
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m Value) -> Text -> m Value
forall a b. (a -> b) -> a -> b
$
Text
"couldn't find a value for argument id in the join results: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (JoinCallId, JoinCallId) -> Text
forall a. Show a => a -> Text
tshow (JoinCallId
argumentId, JoinCallId
joinCallId)
type CompositeObject a = OMap.InsOrdHashMap Text (CompositeValue a)
data CompositeValue a
= CVOrdValue !JO.Value
| CVObject !(CompositeObject a)
| CVObjectArray ![CompositeValue a]
| CVFromRemote !a
deriving (JoinCallId -> CompositeValue a -> ShowS
[CompositeValue a] -> ShowS
CompositeValue a -> String
(JoinCallId -> CompositeValue a -> ShowS)
-> (CompositeValue a -> String)
-> ([CompositeValue a] -> ShowS)
-> Show (CompositeValue a)
forall a. Show a => JoinCallId -> CompositeValue a -> ShowS
forall a. Show a => [CompositeValue a] -> ShowS
forall a. Show a => CompositeValue a -> String
forall a.
(JoinCallId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeValue a] -> ShowS
$cshowList :: forall a. Show a => [CompositeValue a] -> ShowS
show :: CompositeValue a -> String
$cshow :: forall a. Show a => CompositeValue a -> String
showsPrec :: JoinCallId -> CompositeValue a -> ShowS
$cshowsPrec :: forall a. Show a => JoinCallId -> CompositeValue a -> ShowS
Show, CompositeValue a -> CompositeValue a -> Bool
(CompositeValue a -> CompositeValue a -> Bool)
-> (CompositeValue a -> CompositeValue a -> Bool)
-> Eq (CompositeValue a)
forall a. Eq a => CompositeValue a -> CompositeValue a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeValue a -> CompositeValue a -> Bool
$c/= :: forall a. Eq a => CompositeValue a -> CompositeValue a -> Bool
== :: CompositeValue a -> CompositeValue a -> Bool
$c== :: forall a. Eq a => CompositeValue a -> CompositeValue a -> Bool
Eq, a -> CompositeValue b -> CompositeValue a
(a -> b) -> CompositeValue a -> CompositeValue b
(forall a b. (a -> b) -> CompositeValue a -> CompositeValue b)
-> (forall a b. a -> CompositeValue b -> CompositeValue a)
-> Functor CompositeValue
forall a b. a -> CompositeValue b -> CompositeValue a
forall a b. (a -> b) -> CompositeValue a -> CompositeValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CompositeValue b -> CompositeValue a
$c<$ :: forall a b. a -> CompositeValue b -> CompositeValue a
fmap :: (a -> b) -> CompositeValue a -> CompositeValue b
$cfmap :: forall a b. (a -> b) -> CompositeValue a -> CompositeValue b
Functor, CompositeValue a -> Bool
(a -> m) -> CompositeValue a -> m
(a -> b -> b) -> b -> CompositeValue a -> b
(forall m. Monoid m => CompositeValue m -> m)
-> (forall m a. Monoid m => (a -> m) -> CompositeValue a -> m)
-> (forall m a. Monoid m => (a -> m) -> CompositeValue a -> m)
-> (forall a b. (a -> b -> b) -> b -> CompositeValue a -> b)
-> (forall a b. (a -> b -> b) -> b -> CompositeValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompositeValue a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompositeValue a -> b)
-> (forall a. (a -> a -> a) -> CompositeValue a -> a)
-> (forall a. (a -> a -> a) -> CompositeValue a -> a)
-> (forall a. CompositeValue a -> [a])
-> (forall a. CompositeValue a -> Bool)
-> (forall a. CompositeValue a -> JoinCallId)
-> (forall a. Eq a => a -> CompositeValue a -> Bool)
-> (forall a. Ord a => CompositeValue a -> a)
-> (forall a. Ord a => CompositeValue a -> a)
-> (forall a. Num a => CompositeValue a -> a)
-> (forall a. Num a => CompositeValue a -> a)
-> Foldable CompositeValue
forall a. Eq a => a -> CompositeValue a -> Bool
forall a. Num a => CompositeValue a -> a
forall a. Ord a => CompositeValue a -> a
forall m. Monoid m => CompositeValue m -> m
forall a. CompositeValue a -> Bool
forall a. CompositeValue a -> JoinCallId
forall a. CompositeValue a -> [a]
forall a. (a -> a -> a) -> CompositeValue a -> a
forall m a. Monoid m => (a -> m) -> CompositeValue a -> m
forall b a. (b -> a -> b) -> b -> CompositeValue a -> b
forall a b. (a -> b -> b) -> b -> CompositeValue 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 -> JoinCallId)
-> (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
product :: CompositeValue a -> a
$cproduct :: forall a. Num a => CompositeValue a -> a
sum :: CompositeValue a -> a
$csum :: forall a. Num a => CompositeValue a -> a
minimum :: CompositeValue a -> a
$cminimum :: forall a. Ord a => CompositeValue a -> a
maximum :: CompositeValue a -> a
$cmaximum :: forall a. Ord a => CompositeValue a -> a
elem :: a -> CompositeValue a -> Bool
$celem :: forall a. Eq a => a -> CompositeValue a -> Bool
length :: CompositeValue a -> JoinCallId
$clength :: forall a. CompositeValue a -> JoinCallId
null :: CompositeValue a -> Bool
$cnull :: forall a. CompositeValue a -> Bool
toList :: CompositeValue a -> [a]
$ctoList :: forall a. CompositeValue a -> [a]
foldl1 :: (a -> a -> a) -> CompositeValue a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CompositeValue a -> a
foldr1 :: (a -> a -> a) -> CompositeValue a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CompositeValue a -> a
foldl' :: (b -> a -> b) -> b -> CompositeValue a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CompositeValue a -> b
foldl :: (b -> a -> b) -> b -> CompositeValue a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CompositeValue a -> b
foldr' :: (a -> b -> b) -> b -> CompositeValue a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CompositeValue a -> b
foldr :: (a -> b -> b) -> b -> CompositeValue a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CompositeValue a -> b
foldMap' :: (a -> m) -> CompositeValue a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CompositeValue a -> m
foldMap :: (a -> m) -> CompositeValue a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CompositeValue a -> m
fold :: CompositeValue m -> m
$cfold :: forall m. Monoid m => CompositeValue m -> m
Foldable, Functor CompositeValue
Foldable CompositeValue
Functor CompositeValue
-> Foldable CompositeValue
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompositeValue a -> f (CompositeValue b))
-> (forall (f :: * -> *) a.
Applicative f =>
CompositeValue (f a) -> f (CompositeValue a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompositeValue a -> m (CompositeValue b))
-> (forall (m :: * -> *) a.
Monad m =>
CompositeValue (m a) -> m (CompositeValue a))
-> Traversable CompositeValue
(a -> f b) -> CompositeValue a -> f (CompositeValue b)
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 =>
CompositeValue (m a) -> m (CompositeValue a)
forall (f :: * -> *) a.
Applicative f =>
CompositeValue (f a) -> f (CompositeValue a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompositeValue a -> m (CompositeValue b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompositeValue a -> f (CompositeValue b)
sequence :: CompositeValue (m a) -> m (CompositeValue a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CompositeValue (m a) -> m (CompositeValue a)
mapM :: (a -> m b) -> CompositeValue a -> m (CompositeValue b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompositeValue a -> m (CompositeValue b)
sequenceA :: CompositeValue (f a) -> f (CompositeValue a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CompositeValue (f a) -> f (CompositeValue a)
traverse :: (a -> f b) -> CompositeValue a -> f (CompositeValue b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompositeValue a -> f (CompositeValue b)
$cp2Traversable :: Foldable CompositeValue
$cp1Traversable :: Functor CompositeValue
Traversable)
compositeValueToJSON :: CompositeValue JO.Value -> JO.Value
compositeValueToJSON :: CompositeValue Value -> Value
compositeValueToJSON = \case
CVOrdValue Value
v -> Value
v
CVObject CompositeObject Value
obj -> [(Text, Value)] -> Value
JO.object ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap Text Value -> [(Text, Value)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList (InsOrdHashMap Text Value -> [(Text, Value)])
-> InsOrdHashMap Text Value -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ (CompositeValue Value -> Value)
-> CompositeObject Value -> InsOrdHashMap Text Value
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
OMap.map CompositeValue Value -> Value
compositeValueToJSON CompositeObject Value
obj
CVObjectArray [CompositeValue Value]
vals -> [Value] -> Value
JO.array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (CompositeValue Value -> Value)
-> [CompositeValue Value] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map CompositeValue Value -> Value
compositeValueToJSON [CompositeValue Value]
vals
CVFromRemote Value
v -> Value
v
data ReplacementToken = ReplacementToken
{
ReplacementToken -> JoinCallId
_rtCallId :: !JoinCallId,
ReplacementToken -> JoinCallId
_rtArgumentId :: !JoinArgumentId
}