module Hasura.GraphQL.Execute.RemoteJoin.Collect
  ( getRemoteJoinsQueryDB,
    getRemoteJoinsMutationDB,
    getRemoteJoinsActionQuery,
    getRemoteJoinsActionMutation,
    getRemoteJoinsGraphQLField,
  )
where

import Control.Lens (Traversal', preview, traverseOf, _2)
import Control.Monad.Writer
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashMap.Strict.NonEmpty (NEHashMap)
import Data.HashMap.Strict.NonEmpty qualified as NEMap
import Data.Text qualified as T
import Hasura.GraphQL.Execute.RemoteJoin.Types
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Relationships.Remote
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G

{- Note [Remote Joins Architecture]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Unparsed Incoming GraphQL   +------------------------------+
    --------------------------> | Parsing of the GraphQL query |-----+
                                +------------------------------+     |
                                                                     | DB Query and remote joins (if any)
                                                                     |
                                                                     V
    +----------------------------------+  SQL query response  +----------------------------+
    |  Traverse the DB response to     | <------------------- |  Execution of the DB query |
    |  get the values of the arguments |                      +----------------------------+
    |   of the remote field            |
    +----------------------------------+
                 |
                 | Remote field arguments
                 V
    +--------------------------+  Remote schema response   +----------------------------------------+
    | Query the remote schema  | ------------------------> | Replace the remote join fields in      |
    | with the remote field    |                           | the SQL query response (JSON) with     |
    | arguments to the remote  |                           | the response obtained from the remote  |
    | field configured in the  |                           | schema at appropriate places.          |
    | remote join.             |                           +----------------------------------------+
    +--------------------------+
-}

-------------------------------------------------------------------------------
-- AST entry points

-- | Collects remote joins from the a 'QueryDB' if any, and transforms the
-- selection to add new join fields where those occured.
--
-- Returns the transformed selection set, in which remote fields have been
-- inserted, and for which the @r@ type is now 'Void'.
getRemoteJoinsQueryDB ::
  Backend b =>
  QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsQueryDB :: QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsQueryDB =
  Collector (QueryDB b Void (UnpreparedValue b))
-> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (QueryDB b Void (UnpreparedValue b))
 -> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins))
-> (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (QueryDB b Void (UnpreparedValue b)))
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (QueryDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    QDBMultipleRows AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s ->
      AnnSimpleSelectG b Void (UnpreparedValue b)
-> QueryDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBMultipleRows (AnnSimpleSelectG b Void (UnpreparedValue b)
 -> QueryDB b Void (UnpreparedValue b))
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
-> Collector (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s
    QDBSingleRow AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s ->
      AnnSimpleSelectG b Void (UnpreparedValue b)
-> QueryDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBSingleRow (AnnSimpleSelectG b Void (UnpreparedValue b)
 -> QueryDB b Void (UnpreparedValue b))
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
-> Collector (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s
    QDBAggregation AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s ->
      AnnAggregateSelectG b Void (UnpreparedValue b)
-> QueryDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnAggregateSelectG b r v -> QueryDB b r v
QDBAggregation (AnnAggregateSelectG b Void (UnpreparedValue b)
 -> QueryDB b Void (UnpreparedValue b))
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
-> Collector (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s
    QDBConnection ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s ->
      ConnectionSelect b Void (UnpreparedValue b)
-> QueryDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
ConnectionSelect b r v -> QueryDB b r v
QDBConnection (ConnectionSelect b Void (UnpreparedValue b)
 -> QueryDB b Void (UnpreparedValue b))
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
-> Collector (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
transformConnectionSelect ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s
    QDBStreamMultipleRows AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s ->
      AnnSimpleStreamSelectG b Void (UnpreparedValue b)
-> QueryDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleStreamSelectG b r v -> QueryDB b r v
QDBStreamMultipleRows (AnnSimpleStreamSelectG b Void (UnpreparedValue b)
 -> QueryDB b Void (UnpreparedValue b))
-> Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
-> Collector (QueryDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
transformStreamSelect AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
s

-- | Collects remote joins from the a 'MutationDB' if any, and transforms the
-- selection to add new join fields where those occured.
--
-- Returns the transformed selection set, in which remote fields have been
-- inserted, and for which the @r@ type is now 'Void'.
getRemoteJoinsMutationDB ::
  Backend b =>
  MutationDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsMutationDB :: MutationDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
getRemoteJoinsMutationDB =
  Collector (MutationDB b Void (UnpreparedValue b))
-> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (MutationDB b Void (UnpreparedValue b))
 -> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins))
-> (MutationDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (MutationDB b Void (UnpreparedValue b)))
-> MutationDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    MDBInsert AnnotatedInsert
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
insert ->
      AnnotatedInsert b Void (UnpreparedValue b)
-> MutationDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MutationDB b r v
MDBInsert (AnnotatedInsert b Void (UnpreparedValue b)
 -> MutationDB b Void (UnpreparedValue b))
-> Collector (AnnotatedInsert b Void (UnpreparedValue b))
-> Collector (MutationDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike
  Collector
  (AnnotatedInsert
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnotatedInsert b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (AnnotatedInsert
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnotatedInsert b Void (UnpreparedValue b))
     (MutationOutputG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (MutationOutputG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnotatedInsert
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnotatedInsert b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v r2.
Lens
  (AnnotatedInsert b r1 v)
  (AnnotatedInsert b r2 v)
  (MutationOutputG b r1 v)
  (MutationOutputG b r2 v)
aiOutput MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput AnnotatedInsert
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
insert
    MDBUpdate AnnotatedUpdateG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
update ->
      AnnotatedUpdateG b Void (UnpreparedValue b)
-> MutationDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnotatedUpdateG b r v -> MutationDB b r v
MDBUpdate (AnnotatedUpdateG b Void (UnpreparedValue b)
 -> MutationDB b Void (UnpreparedValue b))
-> Collector (AnnotatedUpdateG b Void (UnpreparedValue b))
-> Collector (MutationDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike
  Collector
  (AnnotatedUpdateG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnotatedUpdateG b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (AnnotatedUpdateG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnotatedUpdateG b Void (UnpreparedValue b))
     (MutationOutputG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (MutationOutputG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnotatedUpdateG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnotatedUpdateG b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v r2.
Lens
  (AnnotatedUpdateG b r1 v)
  (AnnotatedUpdateG b r2 v)
  (MutationOutputG b r1 v)
  (MutationOutputG b r2 v)
auOutput MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput AnnotatedUpdateG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
update
    MDBDelete AnnDelG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
delete ->
      AnnDelG b Void (UnpreparedValue b)
-> MutationDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v. AnnDelG b r v -> MutationDB b r v
MDBDelete (AnnDelG b Void (UnpreparedValue b)
 -> MutationDB b Void (UnpreparedValue b))
-> Collector (AnnDelG b Void (UnpreparedValue b))
-> Collector (MutationDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike
  Collector
  (AnnDelG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnDelG b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (AnnDelG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnDelG b Void (UnpreparedValue b))
     (MutationOutputG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (MutationOutputG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnDelG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnDelG b Void (UnpreparedValue b))
  (MutationOutputG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v r2.
Lens
  (AnnDelG b r1 v)
  (AnnDelG b r2 v)
  (MutationOutputG b r1 v)
  (MutationOutputG b r2 v)
adOutput MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput AnnDelG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
delete
    MDBFunction JsonAggSelect
aggSelect AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
select ->
      JsonAggSelect
-> AnnSimpleSelectG b Void (UnpreparedValue b)
-> MutationDB b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
JsonAggSelect -> AnnSimpleSelectG b r v -> MutationDB b r v
MDBFunction JsonAggSelect
aggSelect (AnnSimpleSelectG b Void (UnpreparedValue b)
 -> MutationDB b Void (UnpreparedValue b))
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
-> Collector (MutationDB b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
select

getRemoteJoinsActionQuery ::
  ActionQuery (RemoteRelationshipField UnpreparedValue) ->
  (ActionQuery Void, Maybe RemoteJoins)
getRemoteJoinsActionQuery :: ActionQuery (RemoteRelationshipField UnpreparedValue)
-> (ActionQuery Void, Maybe RemoteJoins)
getRemoteJoinsActionQuery =
  Collector (ActionQuery Void)
-> (ActionQuery Void, Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (ActionQuery Void)
 -> (ActionQuery Void, Maybe RemoteJoins))
-> (ActionQuery (RemoteRelationshipField UnpreparedValue)
    -> Collector (ActionQuery Void))
-> ActionQuery (RemoteRelationshipField UnpreparedValue)
-> (ActionQuery Void, Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    AQQuery AnnActionExecution (RemoteRelationshipField UnpreparedValue)
sync ->
      AnnActionExecution Void -> ActionQuery Void
forall r. AnnActionExecution r -> ActionQuery r
AQQuery (AnnActionExecution Void -> ActionQuery Void)
-> Collector (AnnActionExecution Void)
-> Collector (ActionQuery Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnActionExecution (RemoteRelationshipField UnpreparedValue)
-> Collector (AnnActionExecution Void)
transformSyncAction AnnActionExecution (RemoteRelationshipField UnpreparedValue)
sync
    AQAsync AnnActionAsyncQuery
  ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue)
async ->
      AnnActionAsyncQuery ('Postgres 'Vanilla) Void -> ActionQuery Void
forall r.
AnnActionAsyncQuery ('Postgres 'Vanilla) r -> ActionQuery r
AQAsync (AnnActionAsyncQuery ('Postgres 'Vanilla) Void -> ActionQuery Void)
-> Collector (AnnActionAsyncQuery ('Postgres 'Vanilla) Void)
-> Collector (ActionQuery Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LensLike
  Collector
  (AnnActionAsyncQuery
     ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
  (AnnActionAsyncQuery ('Postgres 'Vanilla) Void)
  (AsyncActionQueryFieldsG (RemoteRelationshipField UnpreparedValue))
  (AsyncActionQueryFieldsG Void)
-> LensLike
     Collector
     (AnnActionAsyncQuery
        ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
     (AnnActionAsyncQuery ('Postgres 'Vanilla) Void)
     (AsyncActionQueryFieldsG (RemoteRelationshipField UnpreparedValue))
     (AsyncActionQueryFieldsG Void)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnActionAsyncQuery
     ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue))
  (AnnActionAsyncQuery ('Postgres 'Vanilla) Void)
  (AsyncActionQueryFieldsG (RemoteRelationshipField UnpreparedValue))
  (AsyncActionQueryFieldsG Void)
forall (b :: BackendType) r1 r2.
Lens
  (AnnActionAsyncQuery b r1)
  (AnnActionAsyncQuery b r2)
  (AsyncActionQueryFieldsG r1)
  (AsyncActionQueryFieldsG r2)
aaaqFields ((AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
 -> Collector (AsyncActionQueryFieldG Void))
-> AsyncActionQueryFieldsG
     (RemoteRelationshipField UnpreparedValue)
-> Collector (AsyncActionQueryFieldsG Void)
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
-> Collector (AsyncActionQueryFieldG Void)
transformAsyncFields) AnnActionAsyncQuery
  ('Postgres 'Vanilla) (RemoteRelationshipField UnpreparedValue)
async

getRemoteJoinsActionMutation ::
  ActionMutation (RemoteRelationshipField UnpreparedValue) ->
  (ActionMutation Void, Maybe RemoteJoins)
getRemoteJoinsActionMutation :: ActionMutation (RemoteRelationshipField UnpreparedValue)
-> (ActionMutation Void, Maybe RemoteJoins)
getRemoteJoinsActionMutation =
  Collector (ActionMutation Void)
-> (ActionMutation Void, Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (ActionMutation Void)
 -> (ActionMutation Void, Maybe RemoteJoins))
-> (ActionMutation (RemoteRelationshipField UnpreparedValue)
    -> Collector (ActionMutation Void))
-> ActionMutation (RemoteRelationshipField UnpreparedValue)
-> (ActionMutation Void, Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    AMAsync AnnActionMutationAsync
async -> ActionMutation Void -> Collector (ActionMutation Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionMutation Void -> Collector (ActionMutation Void))
-> ActionMutation Void -> Collector (ActionMutation Void)
forall a b. (a -> b) -> a -> b
$ AnnActionMutationAsync -> ActionMutation Void
forall r. AnnActionMutationAsync -> ActionMutation r
AMAsync AnnActionMutationAsync
async
    AMSync AnnActionExecution (RemoteRelationshipField UnpreparedValue)
sync -> AnnActionExecution Void -> ActionMutation Void
forall r. AnnActionExecution r -> ActionMutation r
AMSync (AnnActionExecution Void -> ActionMutation Void)
-> Collector (AnnActionExecution Void)
-> Collector (ActionMutation Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnActionExecution (RemoteRelationshipField UnpreparedValue)
-> Collector (AnnActionExecution Void)
transformSyncAction AnnActionExecution (RemoteRelationshipField UnpreparedValue)
sync

getRemoteJoinsSourceRelation ::
  Backend b =>
  SourceRelationshipSelection b (RemoteRelationshipField UnpreparedValue) UnpreparedValue ->
  (SourceRelationshipSelection b Void UnpreparedValue, Maybe RemoteJoins)
getRemoteJoinsSourceRelation :: SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
-> (SourceRelationshipSelection b Void UnpreparedValue,
    Maybe RemoteJoins)
getRemoteJoinsSourceRelation =
  Collector (SourceRelationshipSelection b Void UnpreparedValue)
-> (SourceRelationshipSelection b Void UnpreparedValue,
    Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (SourceRelationshipSelection b Void UnpreparedValue)
 -> (SourceRelationshipSelection b Void UnpreparedValue,
     Maybe RemoteJoins))
-> (SourceRelationshipSelection
      b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
    -> Collector (SourceRelationshipSelection b Void UnpreparedValue))
-> SourceRelationshipSelection
     b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
-> (SourceRelationshipSelection b Void UnpreparedValue,
    Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    SourceRelationshipObject AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
objectSelect ->
      AnnObjectSelectG b Void (UnpreparedValue b)
-> SourceRelationshipSelection b Void UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnObjectSelectG b r (vf b) -> SourceRelationshipSelection b r vf
SourceRelationshipObject (AnnObjectSelectG b Void (UnpreparedValue b)
 -> SourceRelationshipSelection b Void UnpreparedValue)
-> Collector (AnnObjectSelectG b Void (UnpreparedValue b))
-> Collector (SourceRelationshipSelection b Void UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnObjectSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnObjectSelectG b Void (UnpreparedValue b))
transformObjectSelect AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
objectSelect
    SourceRelationshipArray AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
simpleSelect ->
      AnnSimpleSelectG b Void (UnpreparedValue b)
-> SourceRelationshipSelection b Void UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnSimpleSelectG b r (vf b) -> SourceRelationshipSelection b r vf
SourceRelationshipArray (AnnSimpleSelectG b Void (UnpreparedValue b)
 -> SourceRelationshipSelection b Void UnpreparedValue)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
-> Collector (SourceRelationshipSelection b Void UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
simpleSelect
    SourceRelationshipArrayAggregate AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
aggregateSelect ->
      AnnAggregateSelectG b Void (UnpreparedValue b)
-> SourceRelationshipSelection b Void UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnAggregateSelectG b r (vf b)
-> SourceRelationshipSelection b r vf
SourceRelationshipArrayAggregate (AnnAggregateSelectG b Void (UnpreparedValue b)
 -> SourceRelationshipSelection b Void UnpreparedValue)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
-> Collector (SourceRelationshipSelection b Void UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
aggregateSelect

getRemoteJoinsGraphQLField ::
  GraphQLField (RemoteRelationshipField UnpreparedValue) var ->
  (GraphQLField Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLField :: GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> (GraphQLField Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLField =
  Collector (GraphQLField Void var)
-> (GraphQLField Void var, Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (GraphQLField Void var)
 -> (GraphQLField Void var, Maybe RemoteJoins))
-> (GraphQLField (RemoteRelationshipField UnpreparedValue) var
    -> Collector (GraphQLField Void var))
-> GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> (GraphQLField Void var, Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> Collector (GraphQLField Void var)
forall var.
GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> Collector (GraphQLField Void var)
transformGraphQLField

getRemoteJoinsGraphQLSelectionSet ::
  SelectionSet (RemoteRelationshipField UnpreparedValue) var ->
  (SelectionSet Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLSelectionSet :: SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> (SelectionSet Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLSelectionSet =
  Collector (SelectionSet Void var)
-> (SelectionSet Void var, Maybe RemoteJoins)
forall a. Collector a -> (a, Maybe RemoteJoins)
runCollector (Collector (SelectionSet Void var)
 -> (SelectionSet Void var, Maybe RemoteJoins))
-> (SelectionSet (RemoteRelationshipField UnpreparedValue) var
    -> Collector (SelectionSet Void var))
-> SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> (SelectionSet Void var, Maybe RemoteJoins)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (SelectionSet Void var)
forall var.
SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (SelectionSet Void var)
transformGraphQLSelectionSet

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

-- | A writer monad used to collect together all remote joins
-- appearing in some data structure.
--
-- In the functions below, the 'withField' function is used to track the
-- context of the path from the root of the current selection set.
--
-- It is important that we work bottom-up, and do not 'collect' duplicate
-- field names at any level, because the 'Semigroup' instance for 'RemoteJoins'
-- does not allow for these duplicates.
newtype Collector a = Collector {Collector a -> (a, Maybe RemoteJoins)
runCollector :: (a, Maybe RemoteJoins)}
  deriving
    (a -> Collector b -> Collector a
(a -> b) -> Collector a -> Collector b
(forall a b. (a -> b) -> Collector a -> Collector b)
-> (forall a b. a -> Collector b -> Collector a)
-> Functor Collector
forall a b. a -> Collector b -> Collector a
forall a b. (a -> b) -> Collector a -> Collector b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Collector b -> Collector a
$c<$ :: forall a b. a -> Collector b -> Collector a
fmap :: (a -> b) -> Collector a -> Collector b
$cfmap :: forall a b. (a -> b) -> Collector a -> Collector b
Functor, Functor Collector
a -> Collector a
Functor Collector
-> (forall a. a -> Collector a)
-> (forall a b. Collector (a -> b) -> Collector a -> Collector b)
-> (forall a b c.
    (a -> b -> c) -> Collector a -> Collector b -> Collector c)
-> (forall a b. Collector a -> Collector b -> Collector b)
-> (forall a b. Collector a -> Collector b -> Collector a)
-> Applicative Collector
Collector a -> Collector b -> Collector b
Collector a -> Collector b -> Collector a
Collector (a -> b) -> Collector a -> Collector b
(a -> b -> c) -> Collector a -> Collector b -> Collector c
forall a. a -> Collector a
forall a b. Collector a -> Collector b -> Collector a
forall a b. Collector a -> Collector b -> Collector b
forall a b. Collector (a -> b) -> Collector a -> Collector b
forall a b c.
(a -> b -> c) -> Collector a -> Collector b -> Collector c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Collector a -> Collector b -> Collector a
$c<* :: forall a b. Collector a -> Collector b -> Collector a
*> :: Collector a -> Collector b -> Collector b
$c*> :: forall a b. Collector a -> Collector b -> Collector b
liftA2 :: (a -> b -> c) -> Collector a -> Collector b -> Collector c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Collector a -> Collector b -> Collector c
<*> :: Collector (a -> b) -> Collector a -> Collector b
$c<*> :: forall a b. Collector (a -> b) -> Collector a -> Collector b
pure :: a -> Collector a
$cpure :: forall a. a -> Collector a
$cp1Applicative :: Functor Collector
Applicative, Applicative Collector
a -> Collector a
Applicative Collector
-> (forall a b. Collector a -> (a -> Collector b) -> Collector b)
-> (forall a b. Collector a -> Collector b -> Collector b)
-> (forall a. a -> Collector a)
-> Monad Collector
Collector a -> (a -> Collector b) -> Collector b
Collector a -> Collector b -> Collector b
forall a. a -> Collector a
forall a b. Collector a -> Collector b -> Collector b
forall a b. Collector a -> (a -> Collector b) -> Collector b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Collector a
$creturn :: forall a. a -> Collector a
>> :: Collector a -> Collector b -> Collector b
$c>> :: forall a b. Collector a -> Collector b -> Collector b
>>= :: Collector a -> (a -> Collector b) -> Collector b
$c>>= :: forall a b. Collector a -> (a -> Collector b) -> Collector b
$cp1Monad :: Applicative Collector
Monad, MonadWriter (Maybe RemoteJoins))
    via Writer (Maybe RemoteJoins)

-- | Collect some remote joins appearing at the given field names in the current
-- context.
collect :: NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
collect :: NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
collect = Maybe RemoteJoins -> Collector ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Maybe RemoteJoins -> Collector ())
-> (NEHashMap QualifiedFieldName RemoteJoin -> Maybe RemoteJoins)
-> NEHashMap QualifiedFieldName RemoteJoin
-> Collector ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteJoins -> Maybe RemoteJoins
forall a. a -> Maybe a
Just (RemoteJoins -> Maybe RemoteJoins)
-> (NEHashMap QualifiedFieldName RemoteJoin -> RemoteJoins)
-> NEHashMap QualifiedFieldName RemoteJoin
-> Maybe RemoteJoins
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEHashMap QualifiedFieldName (JoinNode RemoteJoin) -> RemoteJoins
forall a. NEHashMap QualifiedFieldName (JoinNode a) -> JoinTree a
JoinTree (NEHashMap QualifiedFieldName (JoinNode RemoteJoin) -> RemoteJoins)
-> (NEHashMap QualifiedFieldName RemoteJoin
    -> NEHashMap QualifiedFieldName (JoinNode RemoteJoin))
-> NEHashMap QualifiedFieldName RemoteJoin
-> RemoteJoins
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteJoin -> JoinNode RemoteJoin)
-> NEHashMap QualifiedFieldName RemoteJoin
-> NEHashMap QualifiedFieldName (JoinNode RemoteJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RemoteJoin -> JoinNode RemoteJoin
forall a. a -> JoinNode a
Leaf

-- | Keep track of the given field name in the current path from the root of the
-- selection set.
withField :: Maybe Text -> Text -> Collector a -> Collector a
withField :: Maybe Text -> Text -> Collector a -> Collector a
withField Maybe Text
typeName Text
fieldName = (Maybe RemoteJoins -> Maybe RemoteJoins)
-> Collector a -> Collector a
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((RemoteJoins -> RemoteJoins)
-> Maybe RemoteJoins -> Maybe RemoteJoins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RemoteJoins -> RemoteJoins
wrap)
  where
    wrap :: RemoteJoins -> RemoteJoins
wrap RemoteJoins
rjs = NEHashMap QualifiedFieldName (JoinNode RemoteJoin) -> RemoteJoins
forall a. NEHashMap QualifiedFieldName (JoinNode a) -> JoinTree a
JoinTree (NEHashMap QualifiedFieldName (JoinNode RemoteJoin) -> RemoteJoins)
-> NEHashMap QualifiedFieldName (JoinNode RemoteJoin)
-> RemoteJoins
forall a b. (a -> b) -> a -> b
$ QualifiedFieldName
-> JoinNode RemoteJoin
-> NEHashMap QualifiedFieldName (JoinNode RemoteJoin)
forall k v. Hashable k => k -> v -> NEHashMap k v
NEMap.singleton (Maybe Text -> Text -> QualifiedFieldName
QualifiedFieldName Maybe Text
typeName Text
fieldName) (RemoteJoins -> JoinNode RemoteJoin
forall a. JoinTree a -> JoinNode a
Tree RemoteJoins
rjs)

-- | Traverse a list of fields, while applying 'withField' to keep track of the
-- path within the AST. This function assumes that no type name is required for
-- the 'QualifiedFieldName' and uses 'Nothing'.
traverseFields ::
  (a -> Collector b) ->
  Fields a ->
  Collector (Fields b)
traverseFields :: (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields a -> Collector b
fun =
  ((FieldName, a) -> Collector (FieldName, b))
-> Fields a -> Collector (Fields b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse \field :: (FieldName, a)
field@(FieldName
fieldName, a
_) ->
    Maybe Text
-> Text -> Collector (FieldName, b) -> Collector (FieldName, b)
forall a. Maybe Text -> Text -> Collector a -> Collector a
withField Maybe Text
forall a. Maybe a
Nothing (FieldName -> Text
getFieldNameTxt FieldName
fieldName) (Collector (FieldName, b) -> Collector (FieldName, b))
-> Collector (FieldName, b) -> Collector (FieldName, b)
forall a b. (a -> b) -> a -> b
$ (a -> Collector b) -> (FieldName, a) -> Collector (FieldName, b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Collector b
fun (FieldName, a)
field

-------------------------------------------------------------------------------
-- Internal AST traversals

transformAsyncFields ::
  AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue) ->
  Collector (AsyncActionQueryFieldG Void)
transformAsyncFields :: AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue)
-> Collector (AsyncActionQueryFieldG Void)
transformAsyncFields = LensLike
  Collector
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
  (AsyncActionQueryFieldG Void)
  (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
  ActionFields
-> LensLike
     Collector
     (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
     (AsyncActionQueryFieldG Void)
     (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
     ActionFields
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AsyncActionQueryFieldG (RemoteRelationshipField UnpreparedValue))
  (AsyncActionQueryFieldG Void)
  (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
  ActionFields
forall r1 r2.
Prism
  (AsyncActionQueryFieldG r1)
  (AsyncActionQueryFieldG r2)
  (ActionFieldsG r1)
  (ActionFieldsG r2)
_AsyncOutput ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> Collector ActionFields
transformActionFields

transformMutationOutput ::
  Backend b =>
  MutationOutputG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput :: MutationOutputG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutationOutputG b Void (UnpreparedValue b))
transformMutationOutput = \case
  MOutMultirowFields MutFldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
mutationFields ->
    MutFldsG b Void (UnpreparedValue b)
-> MutationOutputG b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
MutFldsG b r v -> MutationOutputG b r v
MOutMultirowFields (MutFldsG b Void (UnpreparedValue b)
 -> MutationOutputG b Void (UnpreparedValue b))
-> Collector (MutFldsG b Void (UnpreparedValue b))
-> Collector (MutationOutputG b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutFldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutFldsG b Void (UnpreparedValue b))
transformMutationFields MutFldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
mutationFields
  MOutSinglerowObject AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
annFields ->
    AnnFieldsG b Void (UnpreparedValue b)
-> MutationOutputG b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnFieldsG b r v -> MutationOutputG b r v
MOutSinglerowObject (AnnFieldsG b Void (UnpreparedValue b)
 -> MutationOutputG b Void (UnpreparedValue b))
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
-> Collector (MutationOutputG b Void (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
annFields
  where
    transformMutationFields :: MutFldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutFldsG b Void (UnpreparedValue b))
transformMutationFields = (MutFldG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (MutFldG b Void (UnpreparedValue b)))
-> MutFldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutFldsG b Void (UnpreparedValue b))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields ((MutFldG
    b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
  -> Collector (MutFldG b Void (UnpreparedValue b)))
 -> MutFldsG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (MutFldsG b Void (UnpreparedValue b)))
-> (MutFldG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (MutFldG b Void (UnpreparedValue b)))
-> MutFldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (MutFldsG b Void (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ LensLike
  Collector
  (MutFldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutFldG b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (MutFldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (MutFldG b Void (UnpreparedValue b))
     (AnnFieldsG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnFieldsG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (MutFldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (MutFldG b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
forall (b1 :: BackendType) r1 v1 (b2 :: BackendType) r2 v2.
Prism
  (MutFldG b1 r1 v1)
  (MutFldG b2 r2 v2)
  (AnnFieldsG b1 r1 v1)
  (AnnFieldsG b2 r2 v2)
_MRet AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields

transformSyncAction ::
  AnnActionExecution (RemoteRelationshipField UnpreparedValue) ->
  Collector (AnnActionExecution Void)
transformSyncAction :: AnnActionExecution (RemoteRelationshipField UnpreparedValue)
-> Collector (AnnActionExecution Void)
transformSyncAction = LensLike
  Collector
  (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
  (AnnActionExecution Void)
  (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
  ActionFields
-> LensLike
     Collector
     (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
     (AnnActionExecution Void)
     (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
     ActionFields
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnActionExecution (RemoteRelationshipField UnpreparedValue))
  (AnnActionExecution Void)
  (ActionFieldsG (RemoteRelationshipField UnpreparedValue))
  ActionFields
forall r1 r2.
Lens
  (AnnActionExecution r1)
  (AnnActionExecution r2)
  (ActionFieldsG r1)
  (ActionFieldsG r2)
aaeFields ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> Collector ActionFields
transformActionFields

transformSelect ::
  Backend b =>
  AnnSimpleSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect :: AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect = LensLike
  Collector
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnSimpleSelectG b Void (UnpreparedValue b))
  (Fields
     (AnnFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (AnnFieldG b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnSimpleSelectG b Void (UnpreparedValue b))
     (Fields
        (AnnFieldG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (AnnFieldG b Void (UnpreparedValue b)))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnSimpleSelectG b Void (UnpreparedValue b))
  (Fields
     (AnnFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (AnnFieldG b Void (UnpreparedValue b)))
forall (b :: BackendType) (f1 :: * -> *) v (f2 :: * -> *).
Lens
  (AnnSelectG b f1 v)
  (AnnSelectG b f2 v)
  (Fields (f1 v))
  (Fields (f2 v))
asnFields Fields
  (AnnFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (Fields (AnnFieldG b Void (UnpreparedValue b)))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields

transformStreamSelect ::
  Backend b =>
  AnnSimpleStreamSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
transformStreamSelect :: AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
transformStreamSelect select :: AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
select@AnnSelectStreamG {$sel:_assnFields:AnnSelectStreamG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectStreamG b f v -> Fields (f v)
_assnFields = Fields
  (AnnFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
fields} = do
  -- Transform selects in array, object and computed fields
  AnnFieldsG b Void (UnpreparedValue b)
transformedFields <- Fields
  (AnnFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields Fields
  (AnnFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
fields
  AnnSimpleStreamSelectG b Void (UnpreparedValue b)
-> Collector (AnnSimpleStreamSelectG b Void (UnpreparedValue b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnSimpleStreamSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
select {$sel:_assnFields:AnnSelectStreamG :: AnnFieldsG b Void (UnpreparedValue b)
_assnFields = AnnFieldsG b Void (UnpreparedValue b)
transformedFields}

transformAggregateSelect ::
  Backend b =>
  AnnAggregateSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect :: AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect =
  LensLike
  Collector
  (AnnAggregateSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnAggregateSelectG b Void (UnpreparedValue b))
  (Fields
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (AnnAggregateSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnAggregateSelectG b Void (UnpreparedValue b))
     (Fields
        (TableAggregateFieldG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnAggregateSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnAggregateSelectG b Void (UnpreparedValue b))
  (Fields
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
forall (b :: BackendType) (f1 :: * -> *) v (f2 :: * -> *).
Lens
  (AnnSelectG b f1 v)
  (AnnSelectG b f2 v)
  (Fields (f1 v))
  (Fields (f2 v))
asnFields LensLike
  Collector
  (AnnAggregateSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnAggregateSelectG b Void (UnpreparedValue b))
  (Fields
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (AnnAggregateSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnAggregateSelectG b Void (UnpreparedValue b))
     (Fields
        (TableAggregateFieldG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$
    (TableAggregateFieldG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (TableAggregateFieldG b Void (UnpreparedValue b)))
-> Fields
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector
     (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields ((TableAggregateFieldG
    b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
  -> Collector (TableAggregateFieldG b Void (UnpreparedValue b)))
 -> Fields
      (TableAggregateFieldG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> Collector
      (Fields (TableAggregateFieldG b Void (UnpreparedValue b))))
-> (TableAggregateFieldG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (TableAggregateFieldG b Void (UnpreparedValue b)))
-> Fields
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector
     (Fields (TableAggregateFieldG b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ LensLike
  Collector
  (TableAggregateFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (TableAggregateFieldG b Void (UnpreparedValue b))
  [(FieldName,
    AnnFieldG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
  (AnnFieldsG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (TableAggregateFieldG b Void (UnpreparedValue b))
     [(FieldName,
       AnnFieldG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
     (AnnFieldsG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (((XNodesAgg b,
  [(FieldName,
    AnnFieldG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
 -> Collector (XNodesAgg b, AnnFieldsG b Void (UnpreparedValue b)))
-> TableAggregateFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (TableAggregateFieldG b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v1 r2 v2.
Prism
  (TableAggregateFieldG b r1 v1)
  (TableAggregateFieldG b r2 v2)
  (XNodesAgg b, AnnFieldsG b r1 v1)
  (XNodesAgg b, AnnFieldsG b r2 v2)
_TAFNodes (((XNodesAgg b,
   [(FieldName,
     AnnFieldG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
  -> Collector (XNodesAgg b, AnnFieldsG b Void (UnpreparedValue b)))
 -> TableAggregateFieldG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (TableAggregateFieldG b Void (UnpreparedValue b)))
-> (([(FieldName,
       AnnFieldG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
     -> Collector (AnnFieldsG b Void (UnpreparedValue b)))
    -> (XNodesAgg b,
        [(FieldName,
          AnnFieldG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
    -> Collector (XNodesAgg b, AnnFieldsG b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (TableAggregateFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (TableAggregateFieldG b Void (UnpreparedValue b))
     [(FieldName,
       AnnFieldG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
     (AnnFieldsG b Void (UnpreparedValue b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(FieldName,
   AnnFieldG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
 -> Collector (AnnFieldsG b Void (UnpreparedValue b)))
-> (XNodesAgg b,
    [(FieldName,
      AnnFieldG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))])
-> Collector (XNodesAgg b, AnnFieldsG b Void (UnpreparedValue b))
forall s t a b. Field2 s t a b => Lens s t a b
_2) [(FieldName,
  AnnFieldG
    b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))]
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields

-- Relay doesn't support remote relationships: we can drill down directly to the
-- inner non-relay selection sets.
transformConnectionSelect ::
  forall b.
  Backend b =>
  ConnectionSelect b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (ConnectionSelect b Void (UnpreparedValue b))
transformConnectionSelect :: ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
transformConnectionSelect =
  LensLike
  Collector
  (ConnectionSelect
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (ConnectionSelect b Void (UnpreparedValue b))
  (Fields
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (ConnectionField b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (ConnectionSelect
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (ConnectionSelect b Void (UnpreparedValue b))
     (Fields
        (ConnectionField
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (ConnectionField b Void (UnpreparedValue b)))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((AnnSelectG
   b
   (ConnectionField b (RemoteRelationshipField UnpreparedValue))
   (UnpreparedValue b)
 -> Collector
      (AnnSelectG b (ConnectionField b Void) (UnpreparedValue b)))
-> ConnectionSelect
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v r2.
Lens
  (ConnectionSelect b r1 v)
  (ConnectionSelect b r2 v)
  (AnnSelectG b (ConnectionField b r1) v)
  (AnnSelectG b (ConnectionField b r2) v)
csSelect ((AnnSelectG
    b
    (ConnectionField b (RemoteRelationshipField UnpreparedValue))
    (UnpreparedValue b)
  -> Collector
       (AnnSelectG b (ConnectionField b Void) (UnpreparedValue b)))
 -> ConnectionSelect
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (ConnectionSelect b Void (UnpreparedValue b)))
-> ((Fields
       (ConnectionField
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     -> Collector (Fields (ConnectionField b Void (UnpreparedValue b))))
    -> AnnSelectG
         b
         (ConnectionField b (RemoteRelationshipField UnpreparedValue))
         (UnpreparedValue b)
    -> Collector
         (AnnSelectG b (ConnectionField b Void) (UnpreparedValue b)))
-> LensLike
     Collector
     (ConnectionSelect
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (ConnectionSelect b Void (UnpreparedValue b))
     (Fields
        (ConnectionField
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (ConnectionField b Void (UnpreparedValue b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fields
   (ConnectionField
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> Collector (Fields (ConnectionField b Void (UnpreparedValue b))))
-> AnnSelectG
     b
     (ConnectionField b (RemoteRelationshipField UnpreparedValue))
     (UnpreparedValue b)
-> Collector
     (AnnSelectG b (ConnectionField b Void) (UnpreparedValue b))
forall (b :: BackendType) (f1 :: * -> *) v (f2 :: * -> *).
Lens
  (AnnSelectG b f1 v)
  (AnnSelectG b f2 v)
  (Fields (f1 v))
  (Fields (f2 v))
asnFields) LensLike
  Collector
  (ConnectionSelect
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (ConnectionSelect b Void (UnpreparedValue b))
  (Fields
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (ConnectionField b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (ConnectionSelect
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (ConnectionSelect b Void (UnpreparedValue b))
     (Fields
        (ConnectionField
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (ConnectionField b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$
    (ConnectionField
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (ConnectionField b Void (UnpreparedValue b)))
-> Fields
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (Fields (ConnectionField b Void (UnpreparedValue b)))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields ((ConnectionField
    b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
  -> Collector (ConnectionField b Void (UnpreparedValue b)))
 -> Fields
      (ConnectionField
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> Collector (Fields (ConnectionField b Void (UnpreparedValue b))))
-> (ConnectionField
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (ConnectionField b Void (UnpreparedValue b)))
-> Fields
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (Fields (ConnectionField b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$
      LensLike
  Collector
  (ConnectionField
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (ConnectionField b Void (UnpreparedValue b))
  (Fields
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (EdgeField b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (ConnectionField b Void (UnpreparedValue b))
     (Fields
        (EdgeField
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (EdgeField b Void (UnpreparedValue b)))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (ConnectionField
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (ConnectionField b Void (UnpreparedValue b))
  (Fields
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (EdgeField b Void (UnpreparedValue b)))
forall (b1 :: BackendType) r1 v1 (b2 :: BackendType) r2 v2.
Prism
  (ConnectionField b1 r1 v1)
  (ConnectionField b2 r2 v2)
  (EdgeFields b1 r1 v1)
  (EdgeFields b2 r2 v2)
_ConnectionEdges LensLike
  Collector
  (ConnectionField
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (ConnectionField b Void (UnpreparedValue b))
  (Fields
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  (Fields (EdgeField b Void (UnpreparedValue b)))
-> LensLike
     Collector
     (ConnectionField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (ConnectionField b Void (UnpreparedValue b))
     (Fields
        (EdgeField
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
     (Fields (EdgeField b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$
        (EdgeField
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> Collector (EdgeField b Void (UnpreparedValue b)))
-> Fields
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (Fields (EdgeField b Void (UnpreparedValue b)))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields ((EdgeField
    b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
  -> Collector (EdgeField b Void (UnpreparedValue b)))
 -> Fields
      (EdgeField
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> Collector (Fields (EdgeField b Void (UnpreparedValue b))))
-> (EdgeField
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> Collector (EdgeField b Void (UnpreparedValue b)))
-> Fields
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Collector (Fields (EdgeField b Void (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ LensLike
  Collector
  (EdgeField
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (EdgeField b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (EdgeField
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (EdgeField b Void (UnpreparedValue b))
     (AnnFieldsG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnFieldsG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (EdgeField
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (EdgeField b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
forall (b1 :: BackendType) r1 v1 (b2 :: BackendType) r2 v2.
Prism
  (EdgeField b1 r1 v1)
  (EdgeField b2 r2 v2)
  (AnnFieldsG b1 r1 v1)
  (AnnFieldsG b2 r2 v2)
_EdgeNode AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields

transformObjectSelect ::
  Backend b =>
  AnnObjectSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b) ->
  Collector (AnnObjectSelectG b Void (UnpreparedValue b))
transformObjectSelect :: AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnObjectSelectG b Void (UnpreparedValue b))
transformObjectSelect = LensLike
  Collector
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnObjectSelectG b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
-> LensLike
     Collector
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnObjectSelectG b Void (UnpreparedValue b))
     (AnnFieldsG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
     (AnnFieldsG b Void (UnpreparedValue b))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnObjectSelectG b Void (UnpreparedValue b))
  (AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  (AnnFieldsG b Void (UnpreparedValue b))
forall (b :: BackendType) r1 v r2.
Lens
  (AnnObjectSelectG b r1 v)
  (AnnObjectSelectG b r2 v)
  (AnnFieldsG b r1 v)
  (AnnFieldsG b r2 v)
aosFields AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnFieldsG b Void (UnpreparedValue b))
forall (src :: BackendType).
Backend src =>
AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields

transformGraphQLField ::
  GraphQLField (RemoteRelationshipField UnpreparedValue) var ->
  Collector (GraphQLField Void var)
transformGraphQLField :: GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> Collector (GraphQLField Void var)
transformGraphQLField = LensLike
  Collector
  (GraphQLField (RemoteRelationshipField UnpreparedValue) var)
  (GraphQLField Void var)
  (SelectionSet (RemoteRelationshipField UnpreparedValue) var)
  (SelectionSet Void var)
-> LensLike
     Collector
     (GraphQLField (RemoteRelationshipField UnpreparedValue) var)
     (GraphQLField Void var)
     (SelectionSet (RemoteRelationshipField UnpreparedValue) var)
     (SelectionSet Void var)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (GraphQLField (RemoteRelationshipField UnpreparedValue) var)
  (GraphQLField Void var)
  (SelectionSet (RemoteRelationshipField UnpreparedValue) var)
  (SelectionSet Void var)
forall r var r2.
Lens
  (GraphQLField r var)
  (GraphQLField r2 var)
  (SelectionSet r var)
  (SelectionSet r2 var)
fSelectionSet SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (SelectionSet Void var)
forall var.
SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (SelectionSet Void var)
transformGraphQLSelectionSet

transformGraphQLSelectionSet ::
  SelectionSet (RemoteRelationshipField UnpreparedValue) var ->
  Collector (SelectionSet Void var)
transformGraphQLSelectionSet :: SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (SelectionSet Void var)
transformGraphQLSelectionSet = \case
  SelectionSet (RemoteRelationshipField UnpreparedValue) var
SelectionSetNone -> SelectionSet Void var -> Collector (SelectionSet Void var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionSet Void var
forall r var. SelectionSet r var
SelectionSetNone
  SelectionSetObject ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
s -> ObjectSelectionSet Void var -> SelectionSet Void var
forall r var. ObjectSelectionSet r var -> SelectionSet r var
SelectionSetObject (ObjectSelectionSet Void var -> SelectionSet Void var)
-> Collector (ObjectSelectionSet Void var)
-> Collector (SelectionSet Void var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (ObjectSelectionSet Void var)
forall var.
Maybe Name
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (ObjectSelectionSet Void var)
transformObjectSelectionSet Maybe Name
forall a. Maybe a
Nothing ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
s
  SelectionSetUnion DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
s -> DeduplicatedSelectionSet Void var -> SelectionSet Void var
forall r var. DeduplicatedSelectionSet r var -> SelectionSet r var
SelectionSetUnion (DeduplicatedSelectionSet Void var -> SelectionSet Void var)
-> Collector (DeduplicatedSelectionSet Void var)
-> Collector (SelectionSet Void var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
-> Collector (DeduplicatedSelectionSet Void var)
forall var2.
DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var2
-> Collector (DeduplicatedSelectionSet Void var2)
transformDeduplicatedTypeSelectionSet DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
s
  SelectionSetInterface DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
s -> DeduplicatedSelectionSet Void var -> SelectionSet Void var
forall r var. DeduplicatedSelectionSet r var -> SelectionSet r var
SelectionSetInterface (DeduplicatedSelectionSet Void var -> SelectionSet Void var)
-> Collector (DeduplicatedSelectionSet Void var)
-> Collector (SelectionSet Void var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
-> Collector (DeduplicatedSelectionSet Void var)
forall var2.
DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var2
-> Collector (DeduplicatedSelectionSet Void var2)
transformDeduplicatedTypeSelectionSet DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var
s
  where
    transformDeduplicatedTypeSelectionSet :: DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) var2
-> Collector (DeduplicatedSelectionSet Void var2)
transformDeduplicatedTypeSelectionSet =
      LensLike
  Collector
  (DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) var2)
  (DeduplicatedSelectionSet Void var2)
  (HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) var2))
  (HashMap Name (ObjectSelectionSet Void var2))
-> LensLike
     Collector
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) var2)
     (DeduplicatedSelectionSet Void var2)
     (HashMap
        Name
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) var2))
     (HashMap Name (ObjectSelectionSet Void var2))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) var2)
  (DeduplicatedSelectionSet Void var2)
  (HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) var2))
  (HashMap Name (ObjectSelectionSet Void var2))
forall r1 var1 r2 var2.
Lens
  (DeduplicatedSelectionSet r1 var1)
  (DeduplicatedSelectionSet r2 var2)
  (HashMap Name (ObjectSelectionSet r1 var1))
  (HashMap Name (ObjectSelectionSet r2 var2))
dssMemberSelectionSets LensLike
  Collector
  (DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) var2)
  (DeduplicatedSelectionSet Void var2)
  (HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) var2))
  (HashMap Name (ObjectSelectionSet Void var2))
-> LensLike
     Collector
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) var2)
     (DeduplicatedSelectionSet Void var2)
     (HashMap
        Name
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) var2))
     (HashMap Name (ObjectSelectionSet Void var2))
forall a b. (a -> b) -> a -> b
$ (Name
 -> ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) var2
 -> Collector (ObjectSelectionSet Void var2))
-> HashMap
     Name
     (ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var2)
-> Collector (HashMap Name (ObjectSelectionSet Void var2))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
Map.traverseWithKey \Name
typeName ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var2
objectSelectionSet ->
        Maybe Name
-> ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) var2
-> Collector (ObjectSelectionSet Void var2)
forall var.
Maybe Name
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (ObjectSelectionSet Void var)
transformObjectSelectionSet (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
typeName) ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var2
objectSelectionSet

-------------------------------------------------------------------------------
-- Actual transformations

-- | Transforms a source selection set.
--
-- This function takes an 'AnnFieldsG', which corresponds to a selection of
-- fields on a source, and extracts remote joins: for every field we encounter
-- that maps to a remote destination (either another source or a remote schema),
-- we replace it with a phantom field and 'collect' the corresponding
-- 'RemoteJoin'.
transformAnnFields ::
  forall src.
  Backend src =>
  AnnFieldsG src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src) ->
  Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields :: AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
transformAnnFields AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields = do
  -- Produces a list of transformed fields that may or may not have an
  -- associated remote join.
  Fields (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
annotatedFields <-
    AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> (AnnFieldsG
      src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
    -> Collector
         (Fields
            (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)))
-> Collector
     (Fields
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
forall a b. a -> (a -> b) -> b
& (AnnFieldG
   src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
 -> Collector
      (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
-> AnnFieldsG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector
     (Fields
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields \case
      -- AnnFields which do not need to be transformed.
      AFNodeId XRelay src
x SourceName
sn TableName src
qt PrimaryKeyColumns src
pkeys ->
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XRelay src
-> SourceName
-> TableName src
-> PrimaryKeyColumns src
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
XRelay b
-> SourceName
-> TableName b
-> PrimaryKeyColumns b
-> AnnFieldG b r v
AFNodeId XRelay src
x SourceName
sn TableName src
qt PrimaryKeyColumns src
pkeys, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFColumn AnnColumnField src (UnpreparedValue src)
c ->
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnColumnField src (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
AnnColumnField b v -> AnnFieldG b r v
AFColumn AnnColumnField src (UnpreparedValue src)
c, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFExpression Text
t ->
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v. Text -> AnnFieldG b r v
AFExpression Text
t, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      -- AnnFields with no associated remote joins and whose transformations are
      -- relatively straightforward.
      AFObjectRelation ObjectRelationSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel -> do
        AnnRelationSelectG
  src (AnnObjectSelectG src Void (UnpreparedValue src))
transformed <- LensLike
  Collector
  (ObjectRelationSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnObjectSelectG src Void (UnpreparedValue src)))
  (AnnObjectSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnObjectSelectG src Void (UnpreparedValue src))
-> LensLike
     Collector
     (ObjectRelationSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnRelationSelectG
        src (AnnObjectSelectG src Void (UnpreparedValue src)))
     (AnnObjectSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnObjectSelectG src Void (UnpreparedValue src))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (ObjectRelationSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnObjectSelectG src Void (UnpreparedValue src)))
  (AnnObjectSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnObjectSelectG src Void (UnpreparedValue src))
forall (b :: BackendType) a1 a2.
Lens (AnnRelationSelectG b a1) (AnnRelationSelectG b a2) a1 a2
aarAnnSelect AnnObjectSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnObjectSelectG src Void (UnpreparedValue src))
forall (b :: BackendType).
Backend b =>
AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnObjectSelectG b Void (UnpreparedValue b))
transformObjectSelect ObjectRelationSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnRelationSelectG
  src (AnnObjectSelectG src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ObjectRelationSelectG b r v -> AnnFieldG b r v
AFObjectRelation AnnRelationSelectG
  src (AnnObjectSelectG src Void (UnpreparedValue src))
transformed, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFArrayRelation (ASSimple ArrayRelationSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel) -> do
        AnnRelationSelectG
  src (AnnSimpleSelectG src Void (UnpreparedValue src))
transformed <- LensLike
  Collector
  (ArrayRelationSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnSimpleSelectG src Void (UnpreparedValue src)))
  (AnnSimpleSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnSimpleSelectG src Void (UnpreparedValue src))
-> LensLike
     Collector
     (ArrayRelationSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnRelationSelectG
        src (AnnSimpleSelectG src Void (UnpreparedValue src)))
     (AnnSimpleSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnSimpleSelectG src Void (UnpreparedValue src))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (ArrayRelationSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnSimpleSelectG src Void (UnpreparedValue src)))
  (AnnSimpleSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnSimpleSelectG src Void (UnpreparedValue src))
forall (b :: BackendType) a1 a2.
Lens (AnnRelationSelectG b a1) (AnnRelationSelectG b a2) a1 a2
aarAnnSelect AnnSimpleSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnSimpleSelectG src Void (UnpreparedValue src))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect ArrayRelationSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArraySelectG src Void (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
AFArrayRelation (ArraySelectG src Void (UnpreparedValue src)
 -> AnnFieldG src Void (UnpreparedValue src))
-> (AnnRelationSelectG
      src (AnnSimpleSelectG src Void (UnpreparedValue src))
    -> ArraySelectG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (AnnSimpleSelectG src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnRelationSelectG
  src (AnnSimpleSelectG src Void (UnpreparedValue src))
-> ArraySelectG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArrayRelationSelectG b r v -> ArraySelectG b r v
ASSimple (AnnRelationSelectG
   src (AnnSimpleSelectG src Void (UnpreparedValue src))
 -> AnnFieldG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (AnnSimpleSelectG src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall a b. (a -> b) -> a -> b
$ AnnRelationSelectG
  src (AnnSimpleSelectG src Void (UnpreparedValue src))
transformed, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFArrayRelation (ASAggregate ArrayAggregateSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
aggRel) -> do
        AnnRelationSelectG
  src (AnnAggregateSelectG src Void (UnpreparedValue src))
transformed <- LensLike
  Collector
  (ArrayAggregateSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnAggregateSelectG src Void (UnpreparedValue src)))
  (AnnAggregateSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnAggregateSelectG src Void (UnpreparedValue src))
-> LensLike
     Collector
     (ArrayAggregateSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnRelationSelectG
        src (AnnAggregateSelectG src Void (UnpreparedValue src)))
     (AnnAggregateSelectG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnAggregateSelectG src Void (UnpreparedValue src))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (ArrayAggregateSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (AnnAggregateSelectG src Void (UnpreparedValue src)))
  (AnnAggregateSelectG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnAggregateSelectG src Void (UnpreparedValue src))
forall (b :: BackendType) a1 a2.
Lens (AnnRelationSelectG b a1) (AnnRelationSelectG b a2) a1 a2
aarAnnSelect AnnAggregateSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnAggregateSelectG src Void (UnpreparedValue src))
forall (b :: BackendType).
Backend b =>
AnnAggregateSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnAggregateSelectG b Void (UnpreparedValue b))
transformAggregateSelect ArrayAggregateSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
aggRel
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArraySelectG src Void (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
AFArrayRelation (ArraySelectG src Void (UnpreparedValue src)
 -> AnnFieldG src Void (UnpreparedValue src))
-> (AnnRelationSelectG
      src (AnnAggregateSelectG src Void (UnpreparedValue src))
    -> ArraySelectG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (AnnAggregateSelectG src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnRelationSelectG
  src (AnnAggregateSelectG src Void (UnpreparedValue src))
-> ArraySelectG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArrayAggregateSelectG b r v -> ArraySelectG b r v
ASAggregate (AnnRelationSelectG
   src (AnnAggregateSelectG src Void (UnpreparedValue src))
 -> AnnFieldG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (AnnAggregateSelectG src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall a b. (a -> b) -> a -> b
$ AnnRelationSelectG
  src (AnnAggregateSelectG src Void (UnpreparedValue src))
transformed, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFArrayRelation (ASConnection ArrayConnectionSelect
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel) -> do
        AnnRelationSelectG
  src (ConnectionSelect src Void (UnpreparedValue src))
transformed <- LensLike
  Collector
  (ArrayConnectionSelect
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (ConnectionSelect src Void (UnpreparedValue src)))
  (ConnectionSelect
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (ConnectionSelect src Void (UnpreparedValue src))
-> LensLike
     Collector
     (ArrayConnectionSelect
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (AnnRelationSelectG
        src (ConnectionSelect src Void (UnpreparedValue src)))
     (ConnectionSelect
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
     (ConnectionSelect src Void (UnpreparedValue src))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Collector
  (ArrayConnectionSelect
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnRelationSelectG
     src (ConnectionSelect src Void (UnpreparedValue src)))
  (ConnectionSelect
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (ConnectionSelect src Void (UnpreparedValue src))
forall (b :: BackendType) a1 a2.
Lens (AnnRelationSelectG b a1) (AnnRelationSelectG b a2) a1 a2
aarAnnSelect ConnectionSelect
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (ConnectionSelect src Void (UnpreparedValue src))
forall (b :: BackendType).
Backend b =>
ConnectionSelect
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (ConnectionSelect b Void (UnpreparedValue b))
transformConnectionSelect ArrayConnectionSelect
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annRel
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArraySelectG src Void (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
AFArrayRelation (ArraySelectG src Void (UnpreparedValue src)
 -> AnnFieldG src Void (UnpreparedValue src))
-> (AnnRelationSelectG
      src (ConnectionSelect src Void (UnpreparedValue src))
    -> ArraySelectG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (ConnectionSelect src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnRelationSelectG
  src (ConnectionSelect src Void (UnpreparedValue src))
-> ArraySelectG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ArrayConnectionSelect b r v -> ArraySelectG b r v
ASConnection (AnnRelationSelectG
   src (ConnectionSelect src Void (UnpreparedValue src))
 -> AnnFieldG src Void (UnpreparedValue src))
-> AnnRelationSelectG
     src (ConnectionSelect src Void (UnpreparedValue src))
-> AnnFieldG src Void (UnpreparedValue src)
forall a b. (a -> b) -> a -> b
$ AnnRelationSelectG
  src (ConnectionSelect src Void (UnpreparedValue src))
transformed, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      AFComputedField XComputedField src
computedField ComputedFieldName
computedFieldName ComputedFieldSelect
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
computedFieldSelect -> do
        ComputedFieldSelect src Void (UnpreparedValue src)
transformed <- case ComputedFieldSelect
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
computedFieldSelect of
          CFSScalar ComputedFieldScalarSelect src (UnpreparedValue src)
cfss Maybe (AnnColumnCaseBoolExp src (UnpreparedValue src))
cbe -> ComputedFieldSelect src Void (UnpreparedValue src)
-> Collector (ComputedFieldSelect src Void (UnpreparedValue src))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldSelect src Void (UnpreparedValue src)
 -> Collector (ComputedFieldSelect src Void (UnpreparedValue src)))
-> ComputedFieldSelect src Void (UnpreparedValue src)
-> Collector (ComputedFieldSelect src Void (UnpreparedValue src))
forall a b. (a -> b) -> a -> b
$ ComputedFieldScalarSelect src (UnpreparedValue src)
-> Maybe (AnnColumnCaseBoolExp src (UnpreparedValue src))
-> ComputedFieldSelect src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
ComputedFieldScalarSelect b v
-> Maybe (AnnColumnCaseBoolExp b v) -> ComputedFieldSelect b r v
CFSScalar ComputedFieldScalarSelect src (UnpreparedValue src)
cfss Maybe (AnnColumnCaseBoolExp src (UnpreparedValue src))
cbe
          CFSTable JsonAggSelect
jsonAggSel AnnSimpleSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annSel -> do
            AnnSimpleSelectG src Void (UnpreparedValue src)
transformed <- AnnSimpleSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> Collector (AnnSimpleSelectG src Void (UnpreparedValue src))
forall (b :: BackendType).
Backend b =>
AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> Collector (AnnSimpleSelectG b Void (UnpreparedValue b))
transformSelect AnnSimpleSelectG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
annSel
            ComputedFieldSelect src Void (UnpreparedValue src)
-> Collector (ComputedFieldSelect src Void (UnpreparedValue src))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldSelect src Void (UnpreparedValue src)
 -> Collector (ComputedFieldSelect src Void (UnpreparedValue src)))
-> ComputedFieldSelect src Void (UnpreparedValue src)
-> Collector (ComputedFieldSelect src Void (UnpreparedValue src))
forall a b. (a -> b) -> a -> b
$ JsonAggSelect
-> AnnSimpleSelectG src Void (UnpreparedValue src)
-> ComputedFieldSelect src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
JsonAggSelect
-> AnnSimpleSelectG b r v -> ComputedFieldSelect b r v
CFSTable JsonAggSelect
jsonAggSel AnnSimpleSelectG src Void (UnpreparedValue src)
transformed
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XComputedField src
-> ComputedFieldName
-> ComputedFieldSelect src Void (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
XComputedField b
-> ComputedFieldName
-> ComputedFieldSelect b r v
-> AnnFieldG b r v
AFComputedField XComputedField src
computedField ComputedFieldName
computedFieldName ComputedFieldSelect src Void (UnpreparedValue src)
transformed, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      -- Remote AnnFields, whose elements require annotation so that they can be
      -- used to construct a remote join.
      AFRemote RemoteRelationshipSelect {HashMap FieldName (DBJoinField src)
RemoteRelationshipField UnpreparedValue
$sel:_rrsRelationship:RemoteRelationshipSelect :: forall (b :: BackendType) r. RemoteRelationshipSelect b r -> r
$sel:_rrsLHSJoinFields:RemoteRelationshipSelect :: forall (b :: BackendType) r.
RemoteRelationshipSelect b r -> HashMap FieldName (DBJoinField b)
_rrsRelationship :: RemoteRelationshipField UnpreparedValue
_rrsLHSJoinFields :: HashMap FieldName (DBJoinField src)
..} ->
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> Collector
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( -- We generate this so that the response has a key with the relationship,
            -- without which preserving the order of fields in the final response
            -- would require a lot of bookkeeping.
            AnnFieldG src Void (UnpreparedValue src)
remoteAnnPlaceholder,
            RemoteJoin -> Maybe RemoteJoin
forall a. a -> Maybe a
Just (RemoteJoin -> Maybe RemoteJoin) -> RemoteJoin -> Maybe RemoteJoin
forall a b. (a -> b) -> a -> b
$ HashMap FieldName JoinColumnAlias
-> RemoteRelationshipField UnpreparedValue -> RemoteJoin
createRemoteJoin HashMap FieldName JoinColumnAlias
joinColumnAliases RemoteRelationshipField UnpreparedValue
_rrsRelationship
          )

  let transformedFields :: AnnFieldsG src Void (UnpreparedValue src)
transformedFields = (((FieldName,
  (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
 -> (FieldName, AnnFieldG src Void (UnpreparedValue src)))
-> Fields
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> AnnFieldsG src Void (UnpreparedValue src)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FieldName,
   (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
  -> (FieldName, AnnFieldG src Void (UnpreparedValue src)))
 -> Fields
      (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
 -> AnnFieldsG src Void (UnpreparedValue src))
-> (((AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
     -> AnnFieldG src Void (UnpreparedValue src))
    -> (FieldName,
        (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
    -> (FieldName, AnnFieldG src Void (UnpreparedValue src)))
-> ((AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
    -> AnnFieldG src Void (UnpreparedValue src))
-> Fields
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> AnnFieldsG src Void (UnpreparedValue src)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
 -> AnnFieldG src Void (UnpreparedValue src))
-> (FieldName,
    (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
-> (FieldName, AnnFieldG src Void (UnpreparedValue src))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> AnnFieldG src Void (UnpreparedValue src)
forall a b. (a, b) -> a
fst Fields (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
annotatedFields
      remoteJoins :: [(QualifiedFieldName, RemoteJoin)]
remoteJoins =
        Fields (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
annotatedFields Fields (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> (Fields
      (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
    -> [(QualifiedFieldName, RemoteJoin)])
-> [(QualifiedFieldName, RemoteJoin)]
forall a b. a -> (a -> b) -> b
& ((FieldName,
  (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin))
 -> Maybe (QualifiedFieldName, RemoteJoin))
-> Fields
     (AnnFieldG src Void (UnpreparedValue src), Maybe RemoteJoin)
-> [(QualifiedFieldName, RemoteJoin)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(FieldName
fieldName, (AnnFieldG src Void (UnpreparedValue src)
_, Maybe RemoteJoin
mRemoteJoin)) ->
          (Maybe Text -> Text -> QualifiedFieldName
QualifiedFieldName Maybe Text
forall a. Maybe a
Nothing (FieldName -> Text
getFieldNameTxt FieldName
fieldName),) (RemoteJoin -> (QualifiedFieldName, RemoteJoin))
-> Maybe RemoteJoin -> Maybe (QualifiedFieldName, RemoteJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RemoteJoin
mRemoteJoin

  case [(QualifiedFieldName, RemoteJoin)]
-> Maybe (NEHashMap QualifiedFieldName RemoteJoin)
forall k v. (Eq k, Hashable k) => [(k, v)] -> Maybe (NEHashMap k v)
NEMap.fromList [(QualifiedFieldName, RemoteJoin)]
remoteJoins of
    Maybe (NEHashMap QualifiedFieldName RemoteJoin)
Nothing -> AnnFieldsG src Void (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnFieldsG src Void (UnpreparedValue src)
transformedFields
    Just NEHashMap QualifiedFieldName RemoteJoin
neRemoteJoins -> do
      NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
collect NEHashMap QualifiedFieldName RemoteJoin
neRemoteJoins
      AnnFieldsG src Void (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnFieldsG src Void (UnpreparedValue src)
 -> Collector (AnnFieldsG src Void (UnpreparedValue src)))
-> AnnFieldsG src Void (UnpreparedValue src)
-> Collector (AnnFieldsG src Void (UnpreparedValue src))
forall a b. (a -> b) -> a -> b
$ AnnFieldsG src Void (UnpreparedValue src)
transformedFields AnnFieldsG src Void (UnpreparedValue src)
-> AnnFieldsG src Void (UnpreparedValue src)
-> AnnFieldsG src Void (UnpreparedValue src)
forall a. Semigroup a => a -> a -> a
<> AnnFieldsG src Void (UnpreparedValue src)
phantomFields
  where
    -- Placeholder text to annotate a remote relationship field.
    remoteAnnPlaceholder :: AnnFieldG src Void (UnpreparedValue src)
    remoteAnnPlaceholder :: AnnFieldG src Void (UnpreparedValue src)
remoteAnnPlaceholder = Text -> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v. Text -> AnnFieldG b r v
AFExpression Text
"remote relationship placeholder"

    -- This is a map of column name to its alias of all columns in the
    -- selection set.
    columnFields :: HashMap (Column src) FieldName
    columnFields :: HashMap (Column src) FieldName
columnFields =
      [(Column src, FieldName)] -> HashMap (Column src) FieldName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Column src, FieldName)] -> HashMap (Column src) FieldName)
-> [(Column src, FieldName)] -> HashMap (Column src) FieldName
forall a b. (a -> b) -> a -> b
$
        [ (AnnColumnField src (UnpreparedValue src) -> Column src
forall (b :: BackendType) v. AnnColumnField b v -> Column b
_acfColumn AnnColumnField src (UnpreparedValue src)
annColumn, FieldName
alias)
          | (FieldName
alias, AnnColumnField src (UnpreparedValue src)
annColumn) <- Traversal'
  (AnnFieldG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnColumnField src (UnpreparedValue src))
-> AnnFieldsG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> [(FieldName, AnnColumnField src (UnpreparedValue src))]
forall super sub any.
Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields forall (b :: BackendType) r v.
Prism' (AnnFieldG b r v) (AnnColumnField b v)
Traversal'
  (AnnFieldG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (AnnColumnField src (UnpreparedValue src))
_AFColumn AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields
        ]

    -- This is a map of computed field name to its alias of all computed fields
    -- in the selection set.
    computedFields :: Map.HashMap ComputedFieldName FieldName
    computedFields :: HashMap ComputedFieldName FieldName
computedFields =
      [(ComputedFieldName, FieldName)]
-> HashMap ComputedFieldName FieldName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(ComputedFieldName, FieldName)]
 -> HashMap ComputedFieldName FieldName)
-> [(ComputedFieldName, FieldName)]
-> HashMap ComputedFieldName FieldName
forall a b. (a -> b) -> a -> b
$
        [ (ComputedFieldName
fieldName, FieldName
alias)
          | -- Note that we do not currently care about input arguments to a computed
            -- field because only computed fields which do not accept input arguments
            -- are currently allowed.
            (FieldName
alias, ComputedFieldName
fieldName) <- Traversal'
  (AnnFieldG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  ComputedFieldName
-> AnnFieldsG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> [(FieldName, ComputedFieldName)]
forall super sub any.
Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields (((XComputedField src, ComputedFieldName,
  ComputedFieldSelect
    src
    (RemoteRelationshipField UnpreparedValue)
    (UnpreparedValue src))
 -> f (XComputedField src, ComputedFieldName,
       ComputedFieldSelect
         src
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue src)))
-> AnnFieldG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> f (AnnFieldG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
forall (b :: BackendType) r v.
Prism'
  (AnnFieldG b r v)
  (XComputedField b, ComputedFieldName, ComputedFieldSelect b r v)
_AFComputedField (((XComputedField src, ComputedFieldName,
   ComputedFieldSelect
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  -> f (XComputedField src, ComputedFieldName,
        ComputedFieldSelect
          src
          (RemoteRelationshipField UnpreparedValue)
          (UnpreparedValue src)))
 -> AnnFieldG
      src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
 -> f (AnnFieldG
         src
         (RemoteRelationshipField UnpreparedValue)
         (UnpreparedValue src)))
-> ((ComputedFieldName -> f ComputedFieldName)
    -> (XComputedField src, ComputedFieldName,
        ComputedFieldSelect
          src
          (RemoteRelationshipField UnpreparedValue)
          (UnpreparedValue src))
    -> f (XComputedField src, ComputedFieldName,
          ComputedFieldSelect
            src
            (RemoteRelationshipField UnpreparedValue)
            (UnpreparedValue src)))
-> (ComputedFieldName -> f ComputedFieldName)
-> AnnFieldG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> f (AnnFieldG
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComputedFieldName -> f ComputedFieldName)
-> (XComputedField src, ComputedFieldName,
    ComputedFieldSelect
      src
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue src))
-> f (XComputedField src, ComputedFieldName,
      ComputedFieldSelect
        src
        (RemoteRelationshipField UnpreparedValue)
        (UnpreparedValue src))
forall s t a b. Field2 s t a b => Lens s t a b
_2) AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields
        ]

    -- Annotate a 'DBJoinField' with its field name and an alias so that it may
    -- be used to construct a remote join.
    annotateDBJoinField ::
      FieldName -> DBJoinField src -> (DBJoinField src, JoinColumnAlias)
    annotateDBJoinField :: FieldName -> DBJoinField src -> (DBJoinField src, JoinColumnAlias)
annotateDBJoinField FieldName
fieldName = \case
      jc :: DBJoinField src
jc@(JoinColumn Column src
column ColumnType src
_) ->
        let alias :: JoinColumnAlias
alias = FieldName
-> Column src
-> HashMap (Column src) FieldName
-> [FieldName]
-> JoinColumnAlias
forall field.
(Eq field, Hashable field) =>
FieldName
-> field
-> HashMap field FieldName
-> [FieldName]
-> JoinColumnAlias
getJoinColumnAlias FieldName
fieldName Column src
column HashMap (Column src) FieldName
columnFields [FieldName]
allAliases
         in (DBJoinField src
jc, JoinColumnAlias
alias)
      jcf :: DBJoinField src
jcf@(JoinComputedField ScalarComputedField {FunctionName src
ScalarType src
ComputedFieldImplicitArguments src
XComputedField src
ComputedFieldName
_scfType :: forall (b :: BackendType). ScalarComputedField b -> ScalarType b
_scfComputedFieldImplicitArgs :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldImplicitArguments b
_scfFunction :: forall (b :: BackendType). ScalarComputedField b -> FunctionName b
_scfName :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldName
_scfXField :: forall (b :: BackendType).
ScalarComputedField b -> XComputedField b
_scfType :: ScalarType src
_scfComputedFieldImplicitArgs :: ComputedFieldImplicitArguments src
_scfFunction :: FunctionName src
_scfName :: ComputedFieldName
_scfXField :: XComputedField src
..}) ->
        let alias :: JoinColumnAlias
alias = FieldName
-> ComputedFieldName
-> HashMap ComputedFieldName FieldName
-> [FieldName]
-> JoinColumnAlias
forall field.
(Eq field, Hashable field) =>
FieldName
-> field
-> HashMap field FieldName
-> [FieldName]
-> JoinColumnAlias
getJoinColumnAlias FieldName
fieldName ComputedFieldName
_scfName HashMap ComputedFieldName FieldName
computedFields [FieldName]
allAliases
         in (DBJoinField src
jcf, JoinColumnAlias
alias)
      where
        allAliases :: [FieldName]
allAliases = ((FieldName,
  AnnFieldG
    src
    (RemoteRelationshipField UnpreparedValue)
    (UnpreparedValue src))
 -> FieldName)
-> AnnFieldsG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName,
 AnnFieldG
   src
   (RemoteRelationshipField UnpreparedValue)
   (UnpreparedValue src))
-> FieldName
forall a b. (a, b) -> a
fst AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields

    -- goes through all the remote relationships in the selection set and emits
    -- 1. a map of join field names to their aliases in the lhs response
    -- 2. a list of extra fields that need to be included in the lhs query
    --    that are required for the join
    (HashMap FieldName JoinColumnAlias
joinColumnAliases, AnnFieldsG src Void (UnpreparedValue src)
phantomFields) =
      let lhsJoinFields :: HashMap FieldName (DBJoinField src)
lhsJoinFields =
            [HashMap FieldName (DBJoinField src)]
-> HashMap FieldName (DBJoinField src)
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
Map.unions ([HashMap FieldName (DBJoinField src)]
 -> HashMap FieldName (DBJoinField src))
-> [HashMap FieldName (DBJoinField src)]
-> HashMap FieldName (DBJoinField src)
forall a b. (a -> b) -> a -> b
$ ((FieldName,
  RemoteRelationshipSelect
    src (RemoteRelationshipField UnpreparedValue))
 -> HashMap FieldName (DBJoinField src))
-> [(FieldName,
     RemoteRelationshipSelect
       src (RemoteRelationshipField UnpreparedValue))]
-> [HashMap FieldName (DBJoinField src)]
forall a b. (a -> b) -> [a] -> [b]
map (RemoteRelationshipSelect
  src (RemoteRelationshipField UnpreparedValue)
-> HashMap FieldName (DBJoinField src)
forall (b :: BackendType) r.
RemoteRelationshipSelect b r -> HashMap FieldName (DBJoinField b)
_rrsLHSJoinFields (RemoteRelationshipSelect
   src (RemoteRelationshipField UnpreparedValue)
 -> HashMap FieldName (DBJoinField src))
-> ((FieldName,
     RemoteRelationshipSelect
       src (RemoteRelationshipField UnpreparedValue))
    -> RemoteRelationshipSelect
         src (RemoteRelationshipField UnpreparedValue))
-> (FieldName,
    RemoteRelationshipSelect
      src (RemoteRelationshipField UnpreparedValue))
-> HashMap FieldName (DBJoinField src)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName,
 RemoteRelationshipSelect
   src (RemoteRelationshipField UnpreparedValue))
-> RemoteRelationshipSelect
     src (RemoteRelationshipField UnpreparedValue)
forall a b. (a, b) -> b
snd) ([(FieldName,
   RemoteRelationshipSelect
     src (RemoteRelationshipField UnpreparedValue))]
 -> [HashMap FieldName (DBJoinField src)])
-> [(FieldName,
     RemoteRelationshipSelect
       src (RemoteRelationshipField UnpreparedValue))]
-> [HashMap FieldName (DBJoinField src)]
forall a b. (a -> b) -> a -> b
$ Traversal'
  (AnnFieldG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (RemoteRelationshipSelect
     src (RemoteRelationshipField UnpreparedValue))
-> AnnFieldsG
     src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
-> [(FieldName,
     RemoteRelationshipSelect
       src (RemoteRelationshipField UnpreparedValue))]
forall super sub any.
Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields forall (b :: BackendType) r v.
Prism' (AnnFieldG b r v) (RemoteRelationshipSelect b r)
Traversal'
  (AnnFieldG
     src
     (RemoteRelationshipField UnpreparedValue)
     (UnpreparedValue src))
  (RemoteRelationshipSelect
     src (RemoteRelationshipField UnpreparedValue))
_AFRemote AnnFieldsG
  src (RemoteRelationshipField UnpreparedValue) (UnpreparedValue src)
fields
          annotatedJoinColumns :: HashMap FieldName (DBJoinField src, JoinColumnAlias)
annotatedJoinColumns = (FieldName
 -> DBJoinField src -> (DBJoinField src, JoinColumnAlias))
-> HashMap FieldName (DBJoinField src)
-> HashMap FieldName (DBJoinField src, JoinColumnAlias)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.mapWithKey FieldName -> DBJoinField src -> (DBJoinField src, JoinColumnAlias)
annotateDBJoinField (HashMap FieldName (DBJoinField src)
 -> HashMap FieldName (DBJoinField src, JoinColumnAlias))
-> HashMap FieldName (DBJoinField src)
-> HashMap FieldName (DBJoinField src, JoinColumnAlias)
forall a b. (a -> b) -> a -> b
$ HashMap FieldName (DBJoinField src)
lhsJoinFields
          phantomFields_ :: AnnFieldsG src Void (UnpreparedValue src)
phantomFields_ =
            HashMap FieldName (DBJoinField src, JoinColumnAlias)
-> [(DBJoinField src, JoinColumnAlias)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashMap FieldName (DBJoinField src, JoinColumnAlias)
annotatedJoinColumns [(DBJoinField src, JoinColumnAlias)]
-> ([(DBJoinField src, JoinColumnAlias)]
    -> AnnFieldsG src Void (UnpreparedValue src))
-> AnnFieldsG src Void (UnpreparedValue src)
forall a b. a -> (a -> b) -> b
& ((DBJoinField src, JoinColumnAlias)
 -> Maybe (FieldName, AnnFieldG src Void (UnpreparedValue src)))
-> [(DBJoinField src, JoinColumnAlias)]
-> AnnFieldsG src Void (UnpreparedValue src)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(DBJoinField src
joinField, JoinColumnAlias
alias) ->
              case JoinColumnAlias
alias of
                JCSelected FieldName
_ -> Maybe (FieldName, AnnFieldG src Void (UnpreparedValue src))
forall a. Maybe a
Nothing
                JCPhantom FieldName
a -> case DBJoinField src
joinField of
                  JoinColumn Column src
column ColumnType src
columnType ->
                    let annotatedColumn :: AnnFieldG src Void (UnpreparedValue src)
annotatedColumn =
                          AnnColumnField src (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType) r v.
AnnColumnField b v -> AnnFieldG b r v
AFColumn (AnnColumnField src (UnpreparedValue src)
 -> AnnFieldG src Void (UnpreparedValue src))
-> AnnColumnField src (UnpreparedValue src)
-> AnnFieldG src Void (UnpreparedValue src)
forall a b. (a -> b) -> a -> b
$ Column src
-> ColumnType src
-> Bool
-> Maybe (ScalarSelectionArguments src)
-> Maybe (AnnColumnCaseBoolExp src (UnpreparedValue src))
-> AnnColumnField src (UnpreparedValue src)
forall (b :: BackendType) v.
Column b
-> ColumnType b
-> Bool
-> Maybe (ScalarSelectionArguments b)
-> Maybe (AnnColumnCaseBoolExp b v)
-> AnnColumnField b v
AnnColumnField Column src
column ColumnType src
columnType Bool
False Maybe (ScalarSelectionArguments src)
forall a. Maybe a
Nothing Maybe (AnnColumnCaseBoolExp src (UnpreparedValue src))
forall a. Maybe a
Nothing
                     in (FieldName, AnnFieldG src Void (UnpreparedValue src))
-> Maybe (FieldName, AnnFieldG src Void (UnpreparedValue src))
forall a. a -> Maybe a
Just (FieldName
a, AnnFieldG src Void (UnpreparedValue src)
annotatedColumn)
                  JoinComputedField ScalarComputedField src
computedFieldInfo ->
                    (FieldName, AnnFieldG src Void (UnpreparedValue src))
-> Maybe (FieldName, AnnFieldG src Void (UnpreparedValue src))
forall a. a -> Maybe a
Just (FieldName
a, ScalarComputedField src -> AnnFieldG src Void (UnpreparedValue src)
forall (b :: BackendType).
Backend b =>
ScalarComputedField b -> AnnFieldG b Void (UnpreparedValue b)
mkScalarComputedFieldSelect ScalarComputedField src
computedFieldInfo)
       in (((DBJoinField src, JoinColumnAlias) -> JoinColumnAlias)
-> HashMap FieldName (DBJoinField src, JoinColumnAlias)
-> HashMap FieldName JoinColumnAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DBJoinField src, JoinColumnAlias) -> JoinColumnAlias
forall a b. (a, b) -> b
snd HashMap FieldName (DBJoinField src, JoinColumnAlias)
annotatedJoinColumns, AnnFieldsG src Void (UnpreparedValue src)
phantomFields_)

    mkScalarComputedFieldSelect ::
      forall b.
      (Backend b) =>
      ScalarComputedField b ->
      AnnFieldG b Void (UnpreparedValue b)
    mkScalarComputedFieldSelect :: ScalarComputedField b -> AnnFieldG b Void (UnpreparedValue b)
mkScalarComputedFieldSelect ScalarComputedField {FunctionName b
ScalarType b
ComputedFieldImplicitArguments b
XComputedField b
ComputedFieldName
_scfType :: ScalarType b
_scfComputedFieldImplicitArgs :: ComputedFieldImplicitArguments b
_scfFunction :: FunctionName b
_scfName :: ComputedFieldName
_scfXField :: XComputedField b
_scfType :: forall (b :: BackendType). ScalarComputedField b -> ScalarType b
_scfComputedFieldImplicitArgs :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldImplicitArguments b
_scfFunction :: forall (b :: BackendType). ScalarComputedField b -> FunctionName b
_scfName :: forall (b :: BackendType).
ScalarComputedField b -> ComputedFieldName
_scfXField :: forall (b :: BackendType).
ScalarComputedField b -> XComputedField b
..} =
      let functionArgs :: FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
functionArgs =
            ([FunctionArgumentExp b (UnpreparedValue b)]
 -> HashMap Text (FunctionArgumentExp b (UnpreparedValue b))
 -> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b)))
-> HashMap Text (FunctionArgumentExp b (UnpreparedValue b))
-> [FunctionArgumentExp b (UnpreparedValue b)]
-> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip [FunctionArgumentExp b (UnpreparedValue b)]
-> HashMap Text (FunctionArgumentExp b (UnpreparedValue b))
-> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
forall a. [a] -> HashMap Text a -> FunctionArgsExpG a
FunctionArgsExp HashMap Text (FunctionArgumentExp b (UnpreparedValue b))
forall a. Monoid a => a
mempty ([FunctionArgumentExp b (UnpreparedValue b)]
 -> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b)))
-> [FunctionArgumentExp b (UnpreparedValue b)]
-> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ UnpreparedValue b
-> ComputedFieldImplicitArguments b
-> [FunctionArgumentExp b (UnpreparedValue b)]
forall (b :: BackendType) v.
Backend b =>
v -> ComputedFieldImplicitArguments b -> [FunctionArgumentExp b v]
fromComputedFieldImplicitArguments @b UnpreparedValue b
forall (b :: BackendType). UnpreparedValue b
UVSession ComputedFieldImplicitArguments b
_scfComputedFieldImplicitArgs
          fieldSelect :: ComputedFieldSelect b Void (UnpreparedValue b)
fieldSelect =
            (ComputedFieldScalarSelect b (UnpreparedValue b)
 -> Maybe (AnnColumnCaseBoolExp b (UnpreparedValue b))
 -> ComputedFieldSelect b Void (UnpreparedValue b))
-> Maybe (AnnColumnCaseBoolExp b (UnpreparedValue b))
-> ComputedFieldScalarSelect b (UnpreparedValue b)
-> ComputedFieldSelect b Void (UnpreparedValue b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComputedFieldScalarSelect b (UnpreparedValue b)
-> Maybe (AnnColumnCaseBoolExp b (UnpreparedValue b))
-> ComputedFieldSelect b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
ComputedFieldScalarSelect b v
-> Maybe (AnnColumnCaseBoolExp b v) -> ComputedFieldSelect b r v
CFSScalar Maybe (AnnColumnCaseBoolExp b (UnpreparedValue b))
forall a. Maybe a
Nothing (ComputedFieldScalarSelect b (UnpreparedValue b)
 -> ComputedFieldSelect b Void (UnpreparedValue b))
-> ComputedFieldScalarSelect b (UnpreparedValue b)
-> ComputedFieldSelect b Void (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$
              FunctionName b
-> FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
-> ScalarType b
-> Maybe (ScalarSelectionArguments b)
-> ComputedFieldScalarSelect b (UnpreparedValue b)
forall (b :: BackendType) v.
FunctionName b
-> FunctionArgsExp b v
-> ScalarType b
-> Maybe (ScalarSelectionArguments b)
-> ComputedFieldScalarSelect b v
ComputedFieldScalarSelect FunctionName b
_scfFunction FunctionArgsExpG (FunctionArgumentExp b (UnpreparedValue b))
functionArgs ScalarType b
_scfType Maybe (ScalarSelectionArguments b)
forall a. Maybe a
Nothing
       in XComputedField b
-> ComputedFieldName
-> ComputedFieldSelect b Void (UnpreparedValue b)
-> AnnFieldG b Void (UnpreparedValue b)
forall (b :: BackendType) r v.
XComputedField b
-> ComputedFieldName
-> ComputedFieldSelect b r v
-> AnnFieldG b r v
AFComputedField XComputedField b
_scfXField ComputedFieldName
_scfName ComputedFieldSelect b Void (UnpreparedValue b)
fieldSelect

-- | Transforms an action's selection set.
--
-- This function takes an 'ActionFieldsG', which corresponds to a selection of
-- fields on the result of an action, and extracts remote joins: for every field
-- we encounter that maps to a remote destination (either a source or a remote
-- schema), we replace it with a phantom field and 'collect' the corresponding
-- 'RemoteJoin'.
transformActionFields ::
  ActionFieldsG (RemoteRelationshipField UnpreparedValue) ->
  Collector ActionFields
transformActionFields :: ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> Collector ActionFields
transformActionFields ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fields = do
  -- Produces a list of transformed fields that may or may not have an
  -- associated remote join.
  Fields (ActionFieldG Void, Maybe RemoteJoin)
annotatedFields <-
    ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fields ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> (ActionFieldsG (RemoteRelationshipField UnpreparedValue)
    -> Collector (Fields (ActionFieldG Void, Maybe RemoteJoin)))
-> Collector (Fields (ActionFieldG Void, Maybe RemoteJoin))
forall a b. a -> (a -> b) -> b
& (ActionFieldG (RemoteRelationshipField UnpreparedValue)
 -> Collector (ActionFieldG Void, Maybe RemoteJoin))
-> ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> Collector (Fields (ActionFieldG Void, Maybe RemoteJoin))
forall a b. (a -> Collector b) -> Fields a -> Collector (Fields b)
traverseFields \case
      -- ActionFields which do not need to be transformed.
      ACFScalar Name
c -> (ActionFieldG Void, Maybe RemoteJoin)
-> Collector (ActionFieldG Void, Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> ActionFieldG Void
forall r. Name -> ActionFieldG r
ACFScalar Name
c, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      ACFExpression Text
t -> (ActionFieldG Void, Maybe RemoteJoin)
-> Collector (ActionFieldG Void, Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ActionFieldG Void
forall r. Text -> ActionFieldG r
ACFExpression Text
t, Maybe RemoteJoin
forall a. Maybe a
Nothing)
      -- Remote ActionFields, whose elements require annotation so that they can be
      -- used to construct a remote join.
      ACFRemote ActionRemoteRelationshipSelect {HashMap FieldName Name
RemoteRelationshipField UnpreparedValue
_arrsRelationship :: forall r. ActionRemoteRelationshipSelect r -> r
_arrsLHSJoinFields :: forall r.
ActionRemoteRelationshipSelect r -> HashMap FieldName Name
_arrsRelationship :: RemoteRelationshipField UnpreparedValue
_arrsLHSJoinFields :: HashMap FieldName Name
..} ->
        (ActionFieldG Void, Maybe RemoteJoin)
-> Collector (ActionFieldG Void, Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( -- We generate this so that the response has a key with the relationship,
            -- without which preserving the order of fields in the final response
            -- would require a lot of bookkeeping.
            ActionFieldG Void
remoteActionPlaceholder,
            RemoteJoin -> Maybe RemoteJoin
forall a. a -> Maybe a
Just (RemoteJoin -> Maybe RemoteJoin) -> RemoteJoin -> Maybe RemoteJoin
forall a b. (a -> b) -> a -> b
$ HashMap FieldName JoinColumnAlias
-> RemoteRelationshipField UnpreparedValue -> RemoteJoin
createRemoteJoin HashMap FieldName JoinColumnAlias
joinColumnAliases RemoteRelationshipField UnpreparedValue
_arrsRelationship
          )
      ACFNestedObject Name
fn ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fs ->
        (,Maybe RemoteJoin
forall a. Maybe a
Nothing) (ActionFieldG Void -> (ActionFieldG Void, Maybe RemoteJoin))
-> (ActionFields -> ActionFieldG Void)
-> ActionFields
-> (ActionFieldG Void, Maybe RemoteJoin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ActionFields -> ActionFieldG Void
forall r. Name -> ActionFieldsG r -> ActionFieldG r
ACFNestedObject Name
fn (ActionFields -> (ActionFieldG Void, Maybe RemoteJoin))
-> Collector ActionFields
-> Collector (ActionFieldG Void, Maybe RemoteJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> Collector ActionFields
transformActionFields ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fs

  let transformedFields :: ActionFields
transformedFields = (((FieldName, (ActionFieldG Void, Maybe RemoteJoin))
 -> (FieldName, ActionFieldG Void))
-> Fields (ActionFieldG Void, Maybe RemoteJoin) -> ActionFields
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FieldName, (ActionFieldG Void, Maybe RemoteJoin))
  -> (FieldName, ActionFieldG Void))
 -> Fields (ActionFieldG Void, Maybe RemoteJoin) -> ActionFields)
-> (((ActionFieldG Void, Maybe RemoteJoin) -> ActionFieldG Void)
    -> (FieldName, (ActionFieldG Void, Maybe RemoteJoin))
    -> (FieldName, ActionFieldG Void))
-> ((ActionFieldG Void, Maybe RemoteJoin) -> ActionFieldG Void)
-> Fields (ActionFieldG Void, Maybe RemoteJoin)
-> ActionFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ActionFieldG Void, Maybe RemoteJoin) -> ActionFieldG Void)
-> (FieldName, (ActionFieldG Void, Maybe RemoteJoin))
-> (FieldName, ActionFieldG Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (ActionFieldG Void, Maybe RemoteJoin) -> ActionFieldG Void
forall a b. (a, b) -> a
fst Fields (ActionFieldG Void, Maybe RemoteJoin)
annotatedFields
      remoteJoins :: [(QualifiedFieldName, RemoteJoin)]
remoteJoins =
        Fields (ActionFieldG Void, Maybe RemoteJoin)
annotatedFields Fields (ActionFieldG Void, Maybe RemoteJoin)
-> (Fields (ActionFieldG Void, Maybe RemoteJoin)
    -> [(QualifiedFieldName, RemoteJoin)])
-> [(QualifiedFieldName, RemoteJoin)]
forall a b. a -> (a -> b) -> b
& ((FieldName, (ActionFieldG Void, Maybe RemoteJoin))
 -> Maybe (QualifiedFieldName, RemoteJoin))
-> Fields (ActionFieldG Void, Maybe RemoteJoin)
-> [(QualifiedFieldName, RemoteJoin)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(FieldName
fieldName, (ActionFieldG Void
_, Maybe RemoteJoin
mRemoteJoin)) ->
          (Maybe Text -> Text -> QualifiedFieldName
QualifiedFieldName Maybe Text
forall a. Maybe a
Nothing (FieldName -> Text
getFieldNameTxt FieldName
fieldName),) (RemoteJoin -> (QualifiedFieldName, RemoteJoin))
-> Maybe RemoteJoin -> Maybe (QualifiedFieldName, RemoteJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RemoteJoin
mRemoteJoin

  case [(QualifiedFieldName, RemoteJoin)]
-> Maybe (NEHashMap QualifiedFieldName RemoteJoin)
forall k v. (Eq k, Hashable k) => [(k, v)] -> Maybe (NEHashMap k v)
NEMap.fromList [(QualifiedFieldName, RemoteJoin)]
remoteJoins of
    Maybe (NEHashMap QualifiedFieldName RemoteJoin)
Nothing -> ActionFields -> Collector ActionFields
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionFields
transformedFields
    Just NEHashMap QualifiedFieldName RemoteJoin
neRemoteJoins -> do
      NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
collect NEHashMap QualifiedFieldName RemoteJoin
neRemoteJoins
      ActionFields -> Collector ActionFields
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionFields -> Collector ActionFields)
-> ActionFields -> Collector ActionFields
forall a b. (a -> b) -> a -> b
$ ActionFields
transformedFields ActionFields -> ActionFields -> ActionFields
forall a. Semigroup a => a -> a -> a
<> ActionFields
phantomFields
  where
    -- Placeholder text to annotate a remote relationship field.
    remoteActionPlaceholder :: ActionFieldG Void
    remoteActionPlaceholder :: ActionFieldG Void
remoteActionPlaceholder = Text -> ActionFieldG Void
forall r. Text -> ActionFieldG r
ACFExpression Text
"remote relationship placeholder"

    -- This is a map of column name to its alias of all columns in the
    -- selection set.
    scalarFields :: HashMap G.Name FieldName
    scalarFields :: HashMap Name FieldName
scalarFields =
      [(Name, FieldName)] -> HashMap Name FieldName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, FieldName)] -> HashMap Name FieldName)
-> [(Name, FieldName)] -> HashMap Name FieldName
forall a b. (a -> b) -> a -> b
$
        [ (Name
name, FieldName
alias)
          | (FieldName
alias, Name
name) <- Traversal'
  (ActionFieldG (RemoteRelationshipField UnpreparedValue)) Name
-> ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> [(FieldName, Name)]
forall super sub any.
Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields forall r. Prism' (ActionFieldG r) Name
Traversal'
  (ActionFieldG (RemoteRelationshipField UnpreparedValue)) Name
_ACFScalar ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fields
        ]

    -- Annotate a join field with its field name and an alias so that it may
    -- be used to construct a remote join.
    annotateJoinField ::
      FieldName -> G.Name -> (G.Name, JoinColumnAlias)
    annotateJoinField :: FieldName -> Name -> (Name, JoinColumnAlias)
annotateJoinField FieldName
fieldName Name
field =
      let alias :: JoinColumnAlias
alias = FieldName
-> Name -> HashMap Name FieldName -> [FieldName] -> JoinColumnAlias
forall field.
(Eq field, Hashable field) =>
FieldName
-> field
-> HashMap field FieldName
-> [FieldName]
-> JoinColumnAlias
getJoinColumnAlias FieldName
fieldName Name
field HashMap Name FieldName
scalarFields [FieldName]
allAliases
       in (Name
field, JoinColumnAlias
alias)
      where
        allAliases :: [FieldName]
allAliases = ((FieldName,
  ActionFieldG (RemoteRelationshipField UnpreparedValue))
 -> FieldName)
-> ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, ActionFieldG (RemoteRelationshipField UnpreparedValue))
-> FieldName
forall a b. (a, b) -> a
fst ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fields

    -- goes through all the remote relationships in the selection set and emits
    -- 1. a map of join field names to their aliases in the lhs response
    -- 2. a list of extra fields that need to be included in the lhs query
    --    that are required for the join
    (HashMap FieldName JoinColumnAlias
joinColumnAliases, ActionFields
phantomFields :: ([(FieldName, ActionFieldG Void)])) =
      let lhsJoinFields :: HashMap FieldName Name
lhsJoinFields =
            [HashMap FieldName Name] -> HashMap FieldName Name
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
Map.unions ([HashMap FieldName Name] -> HashMap FieldName Name)
-> [HashMap FieldName Name] -> HashMap FieldName Name
forall a b. (a -> b) -> a -> b
$ ((FieldName,
  ActionRemoteRelationshipSelect
    (RemoteRelationshipField UnpreparedValue))
 -> HashMap FieldName Name)
-> [(FieldName,
     ActionRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))]
-> [HashMap FieldName Name]
forall a b. (a -> b) -> [a] -> [b]
map (ActionRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
-> HashMap FieldName Name
forall r.
ActionRemoteRelationshipSelect r -> HashMap FieldName Name
_arrsLHSJoinFields (ActionRemoteRelationshipSelect
   (RemoteRelationshipField UnpreparedValue)
 -> HashMap FieldName Name)
-> ((FieldName,
     ActionRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))
    -> ActionRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))
-> (FieldName,
    ActionRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))
-> HashMap FieldName Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName,
 ActionRemoteRelationshipSelect
   (RemoteRelationshipField UnpreparedValue))
-> ActionRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue)
forall a b. (a, b) -> b
snd) ([(FieldName,
   ActionRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue))]
 -> [HashMap FieldName Name])
-> [(FieldName,
     ActionRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))]
-> [HashMap FieldName Name]
forall a b. (a -> b) -> a -> b
$ Traversal'
  (ActionFieldG (RemoteRelationshipField UnpreparedValue))
  (ActionRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue))
-> ActionFieldsG (RemoteRelationshipField UnpreparedValue)
-> [(FieldName,
     ActionRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))]
forall super sub any.
Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields forall r.
Prism' (ActionFieldG r) (ActionRemoteRelationshipSelect r)
Traversal'
  (ActionFieldG (RemoteRelationshipField UnpreparedValue))
  (ActionRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue))
_ACFRemote ActionFieldsG (RemoteRelationshipField UnpreparedValue)
fields
          annotatedJoinColumns :: HashMap FieldName (Name, JoinColumnAlias)
annotatedJoinColumns = (FieldName -> Name -> (Name, JoinColumnAlias))
-> HashMap FieldName Name
-> HashMap FieldName (Name, JoinColumnAlias)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.mapWithKey FieldName -> Name -> (Name, JoinColumnAlias)
annotateJoinField (HashMap FieldName Name
 -> HashMap FieldName (Name, JoinColumnAlias))
-> HashMap FieldName Name
-> HashMap FieldName (Name, JoinColumnAlias)
forall a b. (a -> b) -> a -> b
$ HashMap FieldName Name
lhsJoinFields
          ActionFields
phantomFields_ :: ([(FieldName, ActionFieldG Void)]) =
            HashMap FieldName (Name, JoinColumnAlias)
-> [(Name, JoinColumnAlias)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashMap FieldName (Name, JoinColumnAlias)
annotatedJoinColumns [(Name, JoinColumnAlias)]
-> ([(Name, JoinColumnAlias)] -> ActionFields) -> ActionFields
forall a b. a -> (a -> b) -> b
& ((Name, JoinColumnAlias) -> Maybe (FieldName, ActionFieldG Void))
-> [(Name, JoinColumnAlias)] -> ActionFields
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(Name
joinField, JoinColumnAlias
alias) ->
              case JoinColumnAlias
alias of
                JCSelected FieldName
_ -> Maybe (FieldName, ActionFieldG Void)
forall a. Maybe a
Nothing
                JCPhantom FieldName
a ->
                  let annotatedColumn :: ActionFieldG Void
annotatedColumn =
                        Name -> ActionFieldG Void
forall r. Name -> ActionFieldG r
ACFScalar Name
joinField
                   in (FieldName, ActionFieldG Void)
-> Maybe (FieldName, ActionFieldG Void)
forall a. a -> Maybe a
Just (FieldName
a, ActionFieldG Void
annotatedColumn)
       in (((Name, JoinColumnAlias) -> JoinColumnAlias)
-> HashMap FieldName (Name, JoinColumnAlias)
-> HashMap FieldName JoinColumnAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, JoinColumnAlias) -> JoinColumnAlias
forall a b. (a, b) -> b
snd HashMap FieldName (Name, JoinColumnAlias)
annotatedJoinColumns, ActionFields
phantomFields_)

-- | Transforms a GraphQL selection set.
--
-- This function takes an 'SelectionSet', which corresponds to a selection of
-- fields on a remote GraphQL schema, and extracts remote joins: for every field
-- we encounter that maps to a remote destination (either a source or another
-- remote schema), we replace it with a phantom field and 'collect' the
-- corresponding 'RemoteJoin'.
transformObjectSelectionSet ::
  -- | The type name on which this selection set is defined; this is only
  -- expected to be provided for unions and interfaces, not for regular objects,
  -- as this is used to determine whether a selection set is potentially
  -- "ambiguous" or not, and regular objects cannot. This will be used as the
  -- type name in the 'QualifiedFieldName' key of the join tree if this
  -- selection set or its subselections contain remote joins.
  Maybe G.Name ->
  ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var ->
  Collector (ObjectSelectionSet Void var)
transformObjectSelectionSet :: Maybe Name
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector (ObjectSelectionSet Void var)
transformObjectSelectionSet Maybe Name
typename ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
selectionSet = do
  -- we need to keep track of whether any subfield contained a remote join
  (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)
annotatedFields, Bool
subfieldsContainRemoteJoins) <-
    (Maybe RemoteJoins -> Bool)
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin))
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin),
      Bool)
forall w (m :: * -> *) b a.
MonadWriter w m =>
(w -> b) -> m a -> m (a, b)
listens Maybe RemoteJoins -> Bool
forall a. Maybe a -> Bool
isJust (Collector
   (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin))
 -> Collector
      (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin),
       Bool))
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin))
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin),
      Bool)
forall a b. (a -> b) -> a -> b
$
      ((Name
  -> Field (RemoteRelationshipField UnpreparedValue) var
  -> Collector (GraphQLField Void var, Maybe RemoteJoin))
 -> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
 -> Collector
      (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)))
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> (Name
    -> Field (RemoteRelationshipField UnpreparedValue) var
    -> Collector (GraphQLField Void var, Maybe RemoteJoin))
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name
 -> Field (RemoteRelationshipField UnpreparedValue) var
 -> Collector (GraphQLField Void var, Maybe RemoteJoin))
-> ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> Collector
     (InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin))
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)
OMap.traverseWithKey ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
selectionSet \Name
alias Field (RemoteRelationshipField UnpreparedValue) var
field ->
        Maybe Text
-> Text
-> Collector (GraphQLField Void var, Maybe RemoteJoin)
-> Collector (GraphQLField Void var, Maybe RemoteJoin)
forall a. Maybe Text -> Text -> Collector a -> Collector a
withField (Name -> Text
G.unName (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
typename) (Name -> Text
G.unName Name
alias) do
          case Field (RemoteRelationshipField UnpreparedValue) var
field of
            FieldGraphQL GraphQLField (RemoteRelationshipField UnpreparedValue) var
f -> (,Maybe RemoteJoin
forall a. Maybe a
Nothing) (GraphQLField Void var
 -> (GraphQLField Void var, Maybe RemoteJoin))
-> Collector (GraphQLField Void var)
-> Collector (GraphQLField Void var, Maybe RemoteJoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> Collector (GraphQLField Void var)
forall var.
GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> Collector (GraphQLField Void var)
transformGraphQLField GraphQLField (RemoteRelationshipField UnpreparedValue) var
f
            FieldRemote SchemaRemoteRelationshipSelect {HashMap FieldName Name
RemoteRelationshipField UnpreparedValue
_srrsRelationship :: forall r. SchemaRemoteRelationshipSelect r -> r
_srrsLHSJoinFields :: forall r.
SchemaRemoteRelationshipSelect r -> HashMap FieldName Name
_srrsRelationship :: RemoteRelationshipField UnpreparedValue
_srrsLHSJoinFields :: HashMap FieldName Name
..} -> do
              (GraphQLField Void var, Maybe RemoteJoin)
-> Collector (GraphQLField Void var, Maybe RemoteJoin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( Name -> GraphQLField Void var
forall r var. Name -> GraphQLField r var
mkPlaceholderField Name
alias,
                  RemoteJoin -> Maybe RemoteJoin
forall a. a -> Maybe a
Just (RemoteJoin -> Maybe RemoteJoin) -> RemoteJoin -> Maybe RemoteJoin
forall a b. (a -> b) -> a -> b
$ HashMap FieldName JoinColumnAlias
-> RemoteRelationshipField UnpreparedValue -> RemoteJoin
createRemoteJoin HashMap FieldName JoinColumnAlias
joinColumnAliases RemoteRelationshipField UnpreparedValue
_srrsRelationship
                )
  let internalTypeAlias :: Name
internalTypeAlias = Name
Name.___hasura_internal_typename
      remoteJoins :: InsOrdHashMap Name RemoteJoin
remoteJoins = ((GraphQLField Void var, Maybe RemoteJoin) -> Maybe RemoteJoin)
-> InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)
-> InsOrdHashMap Name RemoteJoin
forall v1 v2 k.
(v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
OMap.mapMaybe (GraphQLField Void var, Maybe RemoteJoin) -> Maybe RemoteJoin
forall a b. (a, b) -> b
snd InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)
annotatedFields
      additionalFields :: InsOrdHashMap Name (GraphQLField Void var)
additionalFields =
        if
            | Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust Maybe Name
typename Bool -> Bool -> Bool
&& (Bool -> Bool
not (InsOrdHashMap Name RemoteJoin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null InsOrdHashMap Name RemoteJoin
remoteJoins) Bool -> Bool -> Bool
|| Bool
subfieldsContainRemoteJoins) ->
              -- We are in a situation in which the type name matters, and we know
              -- that there is at least one remote join in this part of tree, meaning
              -- we might need to branch on the typename when traversing the join
              -- tree: we insert a custom field that will return the type name.
              Name
-> GraphQLField Void var
-> InsOrdHashMap Name (GraphQLField Void var)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
OMap.singleton Name
internalTypeAlias (GraphQLField Void var
 -> InsOrdHashMap Name (GraphQLField Void var))
-> GraphQLField Void var
-> InsOrdHashMap Name (GraphQLField Void var)
forall a b. (a -> b) -> a -> b
$
                Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet Void var
-> GraphQLField Void var
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
mkGraphQLField
                  (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
internalTypeAlias)
                  Name
GName.___typename
                  HashMap Name (Value var)
forall a. Monoid a => a
mempty
                  [Directive var]
forall a. Monoid a => a
mempty
                  SelectionSet Void var
forall r var. SelectionSet r var
SelectionSetNone
            | Bool
otherwise ->
              -- Either the typename doesn't matter, or this tree doesn't have remote
              -- joins; this selection set isn't "ambiguous".
              InsOrdHashMap Name (GraphQLField Void var)
forall a. Monoid a => a
mempty
      transformedFields :: InsOrdHashMap Name (GraphQLField Void var)
transformedFields = ((GraphQLField Void var, Maybe RemoteJoin)
 -> GraphQLField Void var)
-> InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)
-> InsOrdHashMap Name (GraphQLField Void var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GraphQLField Void var, Maybe RemoteJoin) -> GraphQLField Void var
forall a b. (a, b) -> a
fst InsOrdHashMap Name (GraphQLField Void var, Maybe RemoteJoin)
annotatedFields InsOrdHashMap Name (GraphQLField Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap Name (GraphQLField Void var)
additionalFields
  case [(Name, RemoteJoin)] -> Maybe (NEHashMap Name RemoteJoin)
forall k v. (Eq k, Hashable k) => [(k, v)] -> Maybe (NEHashMap k v)
NEMap.fromList ([(Name, RemoteJoin)] -> Maybe (NEHashMap Name RemoteJoin))
-> [(Name, RemoteJoin)] -> Maybe (NEHashMap Name RemoteJoin)
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap Name RemoteJoin -> [(Name, RemoteJoin)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap Name RemoteJoin
remoteJoins of
    Maybe (NEHashMap Name RemoteJoin)
Nothing -> ObjectSelectionSet Void var
-> Collector (ObjectSelectionSet Void var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectSelectionSet Void var
 -> Collector (ObjectSelectionSet Void var))
-> ObjectSelectionSet Void var
-> Collector (ObjectSelectionSet Void var)
forall a b. (a -> b) -> a -> b
$ (GraphQLField Void var -> Field Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
-> ObjectSelectionSet Void var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GraphQLField Void var -> Field Void var
forall r var. GraphQLField r var -> Field r var
FieldGraphQL InsOrdHashMap Name (GraphQLField Void var)
transformedFields
    Just NEHashMap Name RemoteJoin
neRemoteJoins -> do
      NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
collect (NEHashMap QualifiedFieldName RemoteJoin -> Collector ())
-> NEHashMap QualifiedFieldName RemoteJoin -> Collector ()
forall a b. (a -> b) -> a -> b
$ (Name -> QualifiedFieldName)
-> NEHashMap Name RemoteJoin
-> NEHashMap QualifiedFieldName RemoteJoin
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> NEHashMap k1 v -> NEHashMap k2 v
NEMap.mapKeys (\Name
fieldGName -> Maybe Text -> Text -> QualifiedFieldName
QualifiedFieldName (Name -> Text
G.unName (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
typename) (Name -> Text
G.unName Name
fieldGName)) NEHashMap Name RemoteJoin
neRemoteJoins
      ObjectSelectionSet Void var
-> Collector (ObjectSelectionSet Void var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectSelectionSet Void var
 -> Collector (ObjectSelectionSet Void var))
-> ObjectSelectionSet Void var
-> Collector (ObjectSelectionSet Void var)
forall a b. (a -> b) -> a -> b
$
        (GraphQLField Void var -> Field Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
-> ObjectSelectionSet Void var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          GraphQLField Void var -> Field Void var
forall r var. GraphQLField r var -> Field r var
FieldGraphQL
          (InsOrdHashMap Name (GraphQLField Void var)
transformedFields InsOrdHashMap Name (GraphQLField Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
-> InsOrdHashMap Name (GraphQLField Void var)
forall a. Semigroup a => a -> a -> a
<> [(Name, GraphQLField Void var)]
-> InsOrdHashMap Name (GraphQLField Void var)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
OMap.fromList [(GraphQLField Void var -> Name
forall r var. GraphQLField r var -> Name
_fAlias GraphQLField Void var
fld, GraphQLField Void var
fld) | GraphQLField Void var
fld <- HashMap FieldName (GraphQLField Void var)
-> [GraphQLField Void var]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashMap FieldName (GraphQLField Void var)
phantomFields])
  where
    nameToField :: Name -> FieldName
nameToField = Text -> FieldName
FieldName (Text -> FieldName) -> (Name -> Text) -> Name -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName
    allAliases :: [FieldName]
allAliases = ((Name, Field (RemoteRelationshipField UnpreparedValue) var)
 -> FieldName)
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
-> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> FieldName
nameToField (Name -> FieldName)
-> ((Name, Field (RemoteRelationshipField UnpreparedValue) var)
    -> Name)
-> (Name, Field (RemoteRelationshipField UnpreparedValue) var)
-> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Field (RemoteRelationshipField UnpreparedValue) var) -> Name
forall a b. (a, b) -> a
fst) ([(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
 -> [FieldName])
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
-> [FieldName]
forall a b. (a -> b) -> a -> b
$ ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
selectionSet

    mkPlaceholderField :: Name -> GraphQLField r var
mkPlaceholderField Name
alias =
      Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
mkGraphQLField (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
alias) Name
GName.___typename HashMap Name (Value var)
forall a. Monoid a => a
mempty [Directive var]
forall a. Monoid a => a
mempty SelectionSet r var
forall r var. SelectionSet r var
SelectionSetNone

    -- A map of graphql scalar fields (without any arguments) to their aliases
    -- in the selection set. We do not yet support lhs join fields which take
    -- arguments. To be consistent with that, we ignore fields with arguments
    noArgsGraphQLFields :: HashMap Name FieldName
noArgsGraphQLFields =
      [(Name, FieldName)] -> HashMap Name FieldName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, FieldName)] -> HashMap Name FieldName)
-> [(Name, FieldName)] -> HashMap Name FieldName
forall a b. (a -> b) -> a -> b
$
        (((Name, Field (RemoteRelationshipField UnpreparedValue) var)
  -> Maybe (Name, FieldName))
 -> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
 -> [(Name, FieldName)])
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
-> ((Name, Field (RemoteRelationshipField UnpreparedValue) var)
    -> Maybe (Name, FieldName))
-> [(Name, FieldName)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Name, Field (RemoteRelationshipField UnpreparedValue) var)
 -> Maybe (Name, FieldName))
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
-> [(Name, FieldName)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> [(Name, Field (RemoteRelationshipField UnpreparedValue) var)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
selectionSet) \(Name
alias, Field (RemoteRelationshipField UnpreparedValue) var
field) -> case Field (RemoteRelationshipField UnpreparedValue) var
field of
          FieldGraphQL GraphQLField (RemoteRelationshipField UnpreparedValue) var
f ->
            if HashMap Name (Value var) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> HashMap Name (Value var)
forall r var. GraphQLField r var -> HashMap Name (Value var)
_fArguments GraphQLField (RemoteRelationshipField UnpreparedValue) var
f)
              then (Name, FieldName) -> Maybe (Name, FieldName)
forall a. a -> Maybe a
Just (GraphQLField (RemoteRelationshipField UnpreparedValue) var -> Name
forall r var. GraphQLField r var -> Name
_fName GraphQLField (RemoteRelationshipField UnpreparedValue) var
f, Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
alias)
              else Maybe (Name, FieldName)
forall a. Maybe a
Nothing
          FieldRemote SchemaRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
_ -> Maybe (Name, FieldName)
forall a. Maybe a
Nothing

    annotateLHSJoinField :: FieldName -> Name -> (GraphQLField Void var, JoinColumnAlias)
annotateLHSJoinField FieldName
fieldName Name
lhsJoinField =
      let columnAlias :: JoinColumnAlias
columnAlias =
            FieldName
-> Name -> HashMap Name FieldName -> [FieldName] -> JoinColumnAlias
forall field.
(Eq field, Hashable field) =>
FieldName
-> field
-> HashMap field FieldName
-> [FieldName]
-> JoinColumnAlias
getJoinColumnAlias FieldName
fieldName Name
lhsJoinField HashMap Name FieldName
noArgsGraphQLFields [FieldName]
allAliases
          -- This alias is generated in 'getJoinColumnAlias', and is guaranteed
          -- to be a valid GraphQLName.
          columnGraphQLName :: Maybe Name
columnGraphQLName =
            Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt (FieldName -> Text) -> FieldName -> Text
forall a b. (a -> b) -> a -> b
$ JoinColumnAlias -> FieldName
getAliasFieldName JoinColumnAlias
columnAlias
       in ( Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet Void var
-> GraphQLField Void var
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
mkGraphQLField
              Maybe Name
columnGraphQLName
              Name
lhsJoinField
              HashMap Name (Value var)
forall a. Monoid a => a
mempty
              [Directive var]
forall a. Monoid a => a
mempty
              SelectionSet Void var
forall r var. SelectionSet r var
SelectionSetNone,
            JoinColumnAlias
columnAlias
          )

    (HashMap FieldName JoinColumnAlias
joinColumnAliases, HashMap FieldName (GraphQLField Void var)
phantomFields) =
      let lhsJoinFields :: HashMap FieldName Name
lhsJoinFields =
            [HashMap FieldName Name] -> HashMap FieldName Name
forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
Map.unions ([HashMap FieldName Name] -> HashMap FieldName Name)
-> [HashMap FieldName Name] -> HashMap FieldName Name
forall a b. (a -> b) -> a -> b
$ (SchemaRemoteRelationshipSelect
   (RemoteRelationshipField UnpreparedValue)
 -> HashMap FieldName Name)
-> [SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue)]
-> [HashMap FieldName Name]
forall a b. (a -> b) -> [a] -> [b]
map SchemaRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
-> HashMap FieldName Name
forall r.
SchemaRemoteRelationshipSelect r -> HashMap FieldName Name
_srrsLHSJoinFields ([SchemaRemoteRelationshipSelect
    (RemoteRelationshipField UnpreparedValue)]
 -> [HashMap FieldName Name])
-> [SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue)]
-> [HashMap FieldName Name]
forall a b. (a -> b) -> a -> b
$ (Field (RemoteRelationshipField UnpreparedValue) var
 -> Maybe
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue)))
-> [Field (RemoteRelationshipField UnpreparedValue) var]
-> [SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Getting
  (First
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue)))
  (Field (RemoteRelationshipField UnpreparedValue) var)
  (SchemaRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue))
-> Field (RemoteRelationshipField UnpreparedValue) var
-> Maybe
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue))
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue)))
  (Field (RemoteRelationshipField UnpreparedValue) var)
  (SchemaRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue))
forall r var.
Prism' (Field r var) (SchemaRemoteRelationshipSelect r)
_FieldRemote) ([Field (RemoteRelationshipField UnpreparedValue) var]
 -> [SchemaRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue)])
-> [Field (RemoteRelationshipField UnpreparedValue) var]
-> [SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
-> [Field (RemoteRelationshipField UnpreparedValue) var]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ObjectSelectionSet (RemoteRelationshipField UnpreparedValue) var
selectionSet
          annotatedJoinColumns :: HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
annotatedJoinColumns = (FieldName -> Name -> (GraphQLField Void var, JoinColumnAlias))
-> HashMap FieldName Name
-> HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.mapWithKey FieldName -> Name -> (GraphQLField Void var, JoinColumnAlias)
annotateLHSJoinField HashMap FieldName Name
lhsJoinFields
       in (((GraphQLField Void var, JoinColumnAlias) -> JoinColumnAlias)
-> HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
-> HashMap FieldName JoinColumnAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GraphQLField Void var, JoinColumnAlias) -> JoinColumnAlias
forall a b. (a, b) -> b
snd HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
annotatedJoinColumns, ((GraphQLField Void var, JoinColumnAlias) -> GraphQLField Void var)
-> HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
-> HashMap FieldName (GraphQLField Void var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GraphQLField Void var, JoinColumnAlias) -> GraphQLField Void var
forall a b. (a, b) -> a
fst HashMap FieldName (GraphQLField Void var, JoinColumnAlias)
annotatedJoinColumns)

-------------------------------------------------------------------------------
-- Internal helpers

-- | Converts a remote relationship field into a 'RemoteJoin' that
-- the execution engine understands.
createRemoteJoin ::
  -- We need information about 'how' the lhs join fields appear in the lhs
  -- response to construct a 'RemoteJoin' node
  Map.HashMap FieldName JoinColumnAlias ->
  -- The remote relationship field as captured in the IR
  RemoteRelationshipField UnpreparedValue ->
  RemoteJoin
createRemoteJoin :: HashMap FieldName JoinColumnAlias
-> RemoteRelationshipField UnpreparedValue -> RemoteJoin
createRemoteJoin HashMap FieldName JoinColumnAlias
joinColumnAliases = \case
  RemoteSchemaField RemoteSchemaSelect {[RemoteFieldArgument]
NonEmpty FieldCall
ResultCustomizer
RemoteSchemaInfo
SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselRemoteSchema :: forall r. RemoteSchemaSelect r -> RemoteSchemaInfo
_rselFieldCall :: forall r. RemoteSchemaSelect r -> NonEmpty FieldCall
_rselSelection :: forall r.
RemoteSchemaSelect r -> SelectionSet r RemoteSchemaVariable
_rselResultCustomizer :: forall r. RemoteSchemaSelect r -> ResultCustomizer
_rselArgs :: forall r. RemoteSchemaSelect r -> [RemoteFieldArgument]
_rselRemoteSchema :: RemoteSchemaInfo
_rselFieldCall :: NonEmpty FieldCall
_rselSelection :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselResultCustomizer :: ResultCustomizer
_rselArgs :: [RemoteFieldArgument]
..} ->
    let inputArgsToMap :: [RemoteFieldArgument]
-> HashMap Name (InputValue RemoteSchemaVariable)
inputArgsToMap = [(Name, InputValue RemoteSchemaVariable)]
-> HashMap Name (InputValue RemoteSchemaVariable)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, InputValue RemoteSchemaVariable)]
 -> HashMap Name (InputValue RemoteSchemaVariable))
-> ([RemoteFieldArgument]
    -> [(Name, InputValue RemoteSchemaVariable)])
-> [RemoteFieldArgument]
-> HashMap Name (InputValue RemoteSchemaVariable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteFieldArgument -> (Name, InputValue RemoteSchemaVariable))
-> [RemoteFieldArgument]
-> [(Name, InputValue RemoteSchemaVariable)]
forall a b. (a -> b) -> [a] -> [b]
map (RemoteFieldArgument -> Name
_rfaArgument (RemoteFieldArgument -> Name)
-> (RemoteFieldArgument -> InputValue RemoteSchemaVariable)
-> RemoteFieldArgument
-> (Name, InputValue RemoteSchemaVariable)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& RemoteFieldArgument -> InputValue RemoteSchemaVariable
_rfaValue)
        (SelectionSet Void RemoteSchemaVariable
transformedSchemaRelationship, Maybe RemoteJoins
schemaRelationshipJoins) =
          SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> (SelectionSet Void RemoteSchemaVariable, Maybe RemoteJoins)
forall var.
SelectionSet (RemoteRelationshipField UnpreparedValue) var
-> (SelectionSet Void var, Maybe RemoteJoins)
getRemoteJoinsGraphQLSelectionSet SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_rselSelection
        remoteJoin :: RemoteSchemaJoin
remoteJoin =
          HashMap Name (InputValue RemoteSchemaVariable)
-> ResultCustomizer
-> SelectionSet Void RemoteSchemaVariable
-> HashMap FieldName JoinColumnAlias
-> NonEmpty FieldCall
-> RemoteSchemaInfo
-> RemoteSchemaJoin
RemoteSchemaJoin
            ([RemoteFieldArgument]
-> HashMap Name (InputValue RemoteSchemaVariable)
inputArgsToMap [RemoteFieldArgument]
_rselArgs)
            ResultCustomizer
_rselResultCustomizer
            SelectionSet Void RemoteSchemaVariable
transformedSchemaRelationship
            HashMap FieldName JoinColumnAlias
joinColumnAliases
            NonEmpty FieldCall
_rselFieldCall
            RemoteSchemaInfo
_rselRemoteSchema
     in RemoteSchemaJoin -> Maybe RemoteJoins -> RemoteJoin
RemoteJoinRemoteSchema RemoteSchemaJoin
remoteJoin Maybe RemoteJoins
schemaRelationshipJoins
  RemoteSourceField AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
anySourceSelect ->
    AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> (forall (b :: BackendType).
    Backend b =>
    RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
    -> RemoteJoin)
-> RemoteJoin
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
anySourceSelect \RemoteSourceSelect {HashMap FieldName (ScalarType b, Column b)
SourceName
SourceConfig b
SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
$sel:_rssJoinMapping:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
$sel:_rssSelection:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceRelationshipSelection tgt r vf
$sel:_rssConfig:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceConfig tgt
$sel:_rssName:RemoteSourceSelect :: forall r (vf :: BackendType -> *) (tgt :: BackendType).
RemoteSourceSelect r vf tgt -> SourceName
_rssJoinMapping :: HashMap FieldName (ScalarType b, Column b)
_rssSelection :: SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssConfig :: SourceConfig b
_rssName :: SourceName
..} ->
      let (SourceRelationshipSelection b Void UnpreparedValue
transformedSourceRelationship, Maybe RemoteJoins
sourceRelationshipJoins) =
            SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
-> (SourceRelationshipSelection b Void UnpreparedValue,
    Maybe RemoteJoins)
forall (b :: BackendType).
Backend b =>
SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
-> (SourceRelationshipSelection b Void UnpreparedValue,
    Maybe RemoteJoins)
getRemoteJoinsSourceRelation SourceRelationshipSelection
  b (RemoteRelationshipField UnpreparedValue) UnpreparedValue
_rssSelection

          -- the invariant here is that the the keys in joinColumnAliases and
          -- _rssJoinMapping are the same. We could've opted for a more type
          -- safe representation Map k (a, b) instead of (Map k a, Map k b)
          -- but that would make the type of lhs join columns creep into
          -- RemoteRelationshipField which would make the type a little
          -- unweildy
          joinColumns :: HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
joinColumns =
            HashMap FieldName (ScalarType b, Column b)
_rssJoinMapping HashMap FieldName (ScalarType b, Column b)
-> (HashMap FieldName (ScalarType b, Column b)
    -> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b)))
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
forall a b. a -> (a -> b) -> b
& (FieldName
 -> (ScalarType b, Column b)
 -> Maybe (JoinColumnAlias, (Column b, ScalarType b)))
-> HashMap FieldName (ScalarType b, Column b)
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
Map.mapMaybeWithKey
              \FieldName
joinFieldName (ScalarType b
rhsColumnType, Column b
rhsColumn) ->
                (,(Column b
rhsColumn, ScalarType b
rhsColumnType))
                  (JoinColumnAlias -> (JoinColumnAlias, (Column b, ScalarType b)))
-> Maybe JoinColumnAlias
-> Maybe (JoinColumnAlias, (Column b, ScalarType b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> HashMap FieldName JoinColumnAlias -> Maybe JoinColumnAlias
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup FieldName
joinFieldName HashMap FieldName JoinColumnAlias
joinColumnAliases
          anySourceJoin :: AnyBackend RemoteSourceJoin
anySourceJoin =
            RemoteSourceJoin b -> AnyBackend RemoteSourceJoin
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (RemoteSourceJoin b -> AnyBackend RemoteSourceJoin)
-> RemoteSourceJoin b -> AnyBackend RemoteSourceJoin
forall a b. (a -> b) -> a -> b
$
              SourceName
-> SourceConfig b
-> SourceRelationshipSelection b Void UnpreparedValue
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
-> RemoteSourceJoin b
forall (b :: BackendType).
SourceName
-> SourceConfig b
-> SourceRelationshipSelection b Void UnpreparedValue
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
-> RemoteSourceJoin b
RemoteSourceJoin
                SourceName
_rssName
                SourceConfig b
_rssConfig
                SourceRelationshipSelection b Void UnpreparedValue
transformedSourceRelationship
                HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
joinColumns
       in AnyBackend RemoteSourceJoin -> Maybe RemoteJoins -> RemoteJoin
RemoteJoinSource AnyBackend RemoteSourceJoin
anySourceJoin Maybe RemoteJoins
sourceRelationshipJoins

-- | Constructs a 'JoinColumnAlias' for a given field in a selection set.
--
-- If the field was already requested, we leave it unchanged, to avoid
-- double-fetching the same information. However, if this field is a "phantom"
-- field, that we only add for the purpose of fetching a join key, we rename it
-- in a way that is guaranteed to avoid conflicts.
--
-- NOTE: if the @fieldName@ argument is a valid GraphQL name, then the
-- constructed alias MUST also be a valid GraphQL name.
getJoinColumnAlias ::
  (Eq field, Hashable field) =>
  FieldName ->
  field ->
  HashMap field FieldName ->
  [FieldName] ->
  JoinColumnAlias
getJoinColumnAlias :: FieldName
-> field
-> HashMap field FieldName
-> [FieldName]
-> JoinColumnAlias
getJoinColumnAlias FieldName
fieldName field
field HashMap field FieldName
selectedFields [FieldName]
allAliases =
  case field -> HashMap field FieldName -> Maybe FieldName
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup field
field HashMap field FieldName
selectedFields of
    Maybe FieldName
Nothing -> FieldName -> JoinColumnAlias
JCPhantom FieldName
uniqueAlias
    Just FieldName
fieldAlias -> FieldName -> JoinColumnAlias
JCSelected FieldName
fieldAlias
  where
    -- This generates an alias for a phantom field that does not conflict with
    -- any of the existing aliases in the selection set
    --
    -- If we generate a unique name for each field name which is longer than
    -- the longest alias in the selection set, the generated name would be
    -- unique.
    uniqueAlias :: FieldName
    uniqueAlias :: FieldName
uniqueAlias =
      let suffix :: Text
suffix =
            Text
"_join_column"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              -- 12 is the length of "_join_column"
              Int -> Text -> Text
T.replicate ((Int
longestAliasLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Text -> Int
T.length (FieldName -> Text
coerce FieldName
fieldName) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
"_"
       in FieldName
fieldName FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> Text -> FieldName
FieldName Text
suffix
      where
        longestAliasLength :: Int
longestAliasLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (FieldName -> Int) -> [FieldName] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> (FieldName -> Text) -> FieldName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
coerce) [FieldName]
allAliases

-- | Get the fields targeted by some 'Traversal' for an arbitrary list of
-- tuples, discarding any elements whose fields cannot be focused upon.
getFields :: Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields :: Traversal' super sub -> [(any, super)] -> [(any, sub)]
getFields Traversal' super sub
focus = ((any, super) -> Maybe (any, sub))
-> [(any, super)] -> [(any, sub)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((super -> Maybe sub) -> (any, super) -> Maybe (any, sub)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((super -> Maybe sub) -> (any, super) -> Maybe (any, sub))
-> (super -> Maybe sub) -> (any, super) -> Maybe (any, sub)
forall a b. (a -> b) -> a -> b
$ Getting (First sub) super sub -> super -> Maybe sub
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First sub) super sub
Traversal' super sub
focus)