{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-}

module Hasura.GraphQL.Schema.Remote
  ( buildRemoteParser,
    remoteField,
    makeResultCustomizer,
    withRemoteSchemaCustomization,
  )
where

import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as Set
import Data.List.NonEmpty qualified as NE
import Data.Monoid (Any (..))
import Data.Text.Extended
import Data.Type.Equality
import Hasura.Base.Error
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.Parser.Internal.Parser qualified as P (NullableInput (..), inputParserInput, nonNullableField, nullableExact, nullableField)
import Hasura.GraphQL.Parser.Internal.TypeChecking qualified as P
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser as P
import Hasura.GraphQL.Schema.Typename
import Hasura.Prelude
import Hasura.RQL.IR.RemoteSchema qualified as IR
import Hasura.RQL.IR.Root qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.ResultCustomization
import Hasura.RQL.Types.SchemaCache
import Hasura.RemoteSchema.SchemaCache.Types
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Top level function

buildRemoteParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  IntrospectionResult ->
  RemoteSchemaRelationships ->
  RemoteSchemaInfo ->
  SchemaT r m (RemoteSchemaParser n)
buildRemoteParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> SchemaT r m (RemoteSchemaParser n)
buildRemoteParser IntrospectionResult
introspectionResult RemoteSchemaRelationships
remoteRelationships remoteSchemaInfo :: RemoteSchemaInfo
remoteSchemaInfo@RemoteSchemaInfo {RemoteSchemaCustomizer
ValidatedRemoteSchemaDef
rsDef :: ValidatedRemoteSchemaDef
rsCustomizer :: RemoteSchemaCustomizer
rsDef :: RemoteSchemaInfo -> ValidatedRemoteSchemaDef
rsCustomizer :: RemoteSchemaInfo -> RemoteSchemaCustomizer
..} = do
  ([FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawQueryParsers, Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawMutationParsers, Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawSubscriptionParsers) <-
    RemoteSchemaCustomizer
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r,
 Has CustomizeRemoteFieldName r) =>
RemoteSchemaCustomizer -> m a -> m a
withRemoteSchemaCustomization RemoteSchemaCustomizer
rsCustomizer
      (SchemaT
   r
   m
   ([FieldParser
       n
       (RemoteSchemaRootField
          (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
    Maybe
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
    Maybe
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
 -> SchemaT
      r
      m
      ([FieldParser
          n
          (RemoteSchemaRootField
             (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
       Maybe
         [FieldParser
            n
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
       Maybe
         [FieldParser
            n
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]))
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a b. (a -> b) -> a -> b
$ IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
buildRawRemoteParser IntrospectionResult
introspectionResult RemoteSchemaRelationships
remoteRelationships RemoteSchemaInfo
remoteSchemaInfo
  RemoteSchemaParser n -> SchemaT r m (RemoteSchemaParser n)
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (RemoteSchemaParser n -> SchemaT r m (RemoteSchemaParser n))
-> RemoteSchemaParser n -> SchemaT r m (RemoteSchemaParser n)
forall a b. (a -> b) -> a -> b
$ [FieldParser
   n
   (NamespacedField
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> RemoteSchemaParser n
forall (n :: * -> *).
[FieldParser
   n
   (NamespacedField
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
-> RemoteSchemaParser n
RemoteSchemaParser
      (RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall (n :: * -> *).
MonadParse n =>
RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
customizeRemoteNamespace RemoteSchemaInfo
remoteSchemaInfo (IntrospectionResult -> Name
irQueryRoot IntrospectionResult
introspectionResult) [FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawQueryParsers)
      (RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall (n :: * -> *).
MonadParse n =>
RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
customizeRemoteNamespace RemoteSchemaInfo
remoteSchemaInfo (Name
 -> [FieldParser
       n
       (RemoteSchemaRootField
          (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
 -> [FieldParser
       n
       (NamespacedField
          (RemoteSchemaRootField
             (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
-> Maybe Name
-> Maybe
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
      -> [FieldParser
            n
            (NamespacedField
               (RemoteSchemaRootField
                  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntrospectionResult -> Maybe Name
irMutationRoot IntrospectionResult
introspectionResult Maybe
  ([FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
   -> [FieldParser
         n
         (NamespacedField
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
-> Maybe
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawMutationParsers)
      (RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall (n :: * -> *).
MonadParse n =>
RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
customizeRemoteNamespace RemoteSchemaInfo
remoteSchemaInfo (Name
 -> [FieldParser
       n
       (RemoteSchemaRootField
          (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
 -> [FieldParser
       n
       (NamespacedField
          (RemoteSchemaRootField
             (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
-> Maybe Name
-> Maybe
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
      -> [FieldParser
            n
            (NamespacedField
               (RemoteSchemaRootField
                  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntrospectionResult -> Maybe Name
irSubscriptionRoot IntrospectionResult
introspectionResult Maybe
  ([FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
   -> [FieldParser
         n
         (NamespacedField
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))])
-> Maybe
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
rawSubscriptionParsers)

makeResultCustomizer ::
  RemoteSchemaCustomizer -> IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer
makeResultCustomizer :: RemoteSchemaCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
makeResultCustomizer RemoteSchemaCustomizer
remoteSchemaCustomizer IR.GraphQLField {[Directive RemoteSchemaVariable]
HashMap Name (Value RemoteSchemaVariable)
Name
SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_fAlias :: Name
_fName :: Name
_fArguments :: HashMap Name (Value RemoteSchemaVariable)
_fDirectives :: [Directive RemoteSchemaVariable]
_fSelectionSet :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_fAlias :: forall r var. GraphQLField r var -> Name
_fName :: forall r var. GraphQLField r var -> Name
_fArguments :: forall r var. GraphQLField r var -> HashMap Name (Value var)
_fDirectives :: forall r var. GraphQLField r var -> [Directive var]
_fSelectionSet :: forall r var. GraphQLField r var -> SelectionSet r var
..} =
  Name -> ResultCustomizer -> ResultCustomizer
modifyFieldByName Name
_fAlias
    (ResultCustomizer -> ResultCustomizer)
-> ResultCustomizer -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ if Name
_fName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName.___typename
      then HashMap Name Name -> ResultCustomizer
customizeTypeNameString (RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeTypeName RemoteSchemaCustomizer
remoteSchemaCustomizer)
      else SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
resultCustomizerFromSelection SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
_fSelectionSet
  where
    resultCustomizerFromSelection ::
      IR.SelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer
    resultCustomizerFromSelection :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
resultCustomizerFromSelection = \case
      IR.SelectionSetObject ObjectSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s -> (Field
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ResultCustomizer)
-> ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
forall m a. Monoid m => (a -> m) -> InsOrdHashMap Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Field
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
customizeField ObjectSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s
      IR.SelectionSetUnion DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s -> (ObjectSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ResultCustomizer)
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ResultCustomizer
forall m a. Monoid m => (a -> m) -> HashMap Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Field
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ResultCustomizer)
-> ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
forall m a. Monoid m => (a -> m) -> InsOrdHashMap Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Field
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
customizeField) (HashMap
   Name
   (ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> ResultCustomizer)
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall r var.
DeduplicatedSelectionSet r var
-> HashMap Name (ObjectSelectionSet r var)
IR._dssMemberSelectionSets DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s
      IR.SelectionSetInterface DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s -> (ObjectSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ResultCustomizer)
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ResultCustomizer
forall m a. Monoid m => (a -> m) -> HashMap Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Field
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ResultCustomizer)
-> ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
forall m a. Monoid m => (a -> m) -> InsOrdHashMap Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Field
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
customizeField) (HashMap
   Name
   (ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> ResultCustomizer)
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> HashMap
     Name
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall r var.
DeduplicatedSelectionSet r var
-> HashMap Name (ObjectSelectionSet r var)
IR._dssMemberSelectionSets DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
s
      SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
IR.SelectionSetNone -> ResultCustomizer
forall a. Monoid a => a
mempty

    customizeField :: IR.Field (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable -> ResultCustomizer
    customizeField :: Field
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
customizeField = \case
      IR.FieldGraphQL GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
f -> RemoteSchemaCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
makeResultCustomizer RemoteSchemaCustomizer
remoteSchemaCustomizer GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
f
      -- we do not traverse the remote because that part of the response is
      -- never exists in the response by a remote schema - it is only added
      -- later by the remote joins execution engine, which in turn would have
      -- been processed by its own result customizer if applicable
      IR.FieldRemote SchemaRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
_ -> ResultCustomizer
forall a. Monoid a => a
mempty

buildRawRemoteParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  IntrospectionResult ->
  RemoteSchemaRelationships ->
  RemoteSchemaInfo ->
  -- | parsers for, respectively: queries, mutations, and subscriptions
  SchemaT
    r
    m
    ( [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)],
      Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)],
      Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)]
    )
buildRawRemoteParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
buildRawRemoteParser (IntrospectionResult RemoteSchemaIntrospection
sdoc Name
queryRoot Maybe Name
mutationRoot Maybe Name
subscriptionRoot) RemoteSchemaRelationships
remoteRelationships RemoteSchemaInfo
info = do
  [FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
queryT <- Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
makeParsers Name
queryRoot
  Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
mutationT <- Maybe Name
-> Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
makeNonQueryRootFieldParser Maybe Name
mutationRoot Name
GName._Mutation
  Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subscriptionT <- Maybe Name
-> Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
makeNonQueryRootFieldParser Maybe Name
subscriptionRoot Name
GName._Subscription
  ([FieldParser
    n
    (RemoteSchemaRootField
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
 Maybe
   [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
 Maybe
   [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> SchemaT
     r
     m
     ([FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)],
      Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a. a -> SchemaT r m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
queryT, Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
mutationT, Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subscriptionT)
  where
    makeFieldParser :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> SchemaT r m (P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
    makeFieldParser :: Name
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
makeFieldParser Name
rootTypeName FieldDefinition RemoteSchemaInputValueDefinition
fieldDef =
      (GraphQLField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     MetadataObjId
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
makeRemoteField (FieldParser
   MetadataObjId
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromDefinition RemoteSchemaIntrospection
sdoc Name
rootTypeName RemoteSchemaRelationships
remoteRelationships FieldDefinition RemoteSchemaInputValueDefinition
fieldDef

    makeRemoteField :: IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable -> (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)
    makeRemoteField :: GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
makeRemoteField GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fld = RemoteSchemaInfo
-> ResultCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var.
RemoteSchemaInfo
-> ResultCustomizer
-> GraphQLField r var
-> RemoteSchemaRootField r var
IR.RemoteSchemaRootField RemoteSchemaInfo
info (RemoteSchemaCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
makeResultCustomizer (RemoteSchemaInfo -> RemoteSchemaCustomizer
rsCustomizer RemoteSchemaInfo
info) GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fld) GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fld

    makeParsers :: G.Name -> SchemaT r m [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)]
    makeParsers :: Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
makeParsers Name
rootName =
      case RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
sdoc Name
rootName of
        Just (G.TypeDefinitionObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
o) ->
          (FieldDefinition RemoteSchemaInputValueDefinition
 -> SchemaT
      r
      m
      (FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Name
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
makeFieldParser Name
rootName) ([FieldDefinition RemoteSchemaInputValueDefinition]
 -> SchemaT
      r
      m
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a b. (a -> b) -> a -> b
$ ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> [FieldDefinition RemoteSchemaInputValueDefinition]
forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
G._otdFieldsDefinition ObjectTypeDefinition RemoteSchemaInputValueDefinition
o
        Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
_ -> Code
-> Text
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected (Text
 -> SchemaT
      r
      m
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> Text
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a b. (a -> b) -> a -> b
$ Name
rootName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has to be an object type"

    makeNonQueryRootFieldParser :: Maybe G.Name -> G.Name -> SchemaT r m (Maybe [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)])
    makeNonQueryRootFieldParser :: Maybe Name
-> Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
makeNonQueryRootFieldParser Maybe Name
userProvidedRootName Name
defaultRootName =
      case Maybe Name
userProvidedRootName of
        Just Name
_rootName -> (Name
 -> SchemaT
      r
      m
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> Maybe Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
makeParsers Maybe Name
userProvidedRootName
        Maybe Name
Nothing ->
          let isDefaultRootObjectExists :: Bool
isDefaultRootObjectExists = Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
 -> Bool)
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> Bool
forall a b. (a -> b) -> a -> b
$ RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
sdoc Name
defaultRootName
           in SchemaT
  r
  m
  (Maybe
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> Bool
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a. a -> a -> Bool -> a
bool (Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  [FieldParser
     n
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a. Maybe a
Nothing) ((Name
 -> SchemaT
      r
      m
      [FieldParser
         n
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
-> Maybe Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (RemoteSchemaRootField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
makeParsers (Maybe Name
 -> SchemaT
      r
      m
      (Maybe
         [FieldParser
            n
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]))
-> Maybe Name
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
defaultRootName) (Bool
 -> SchemaT
      r
      m
      (Maybe
         [FieldParser
            n
            (RemoteSchemaRootField
               (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]))
-> Bool
-> SchemaT
     r
     m
     (Maybe
        [FieldParser
           n
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)])
forall a b. (a -> b) -> a -> b
$ Bool
isDefaultRootObjectExists

--------------------------------------------------------------------------------
-- Remote schema input parsers

{- Note [Variable expansion in remote schema input parsers]

=== Input parsers as lightweight type checkers

The purpose of input parsers for remote schemas is not to translate the provided input values into
an internal representation: those values will be transmitted more or less unmodified to the remote
service; their main purpose is simply to check the shape of the input against the remote schema.

Consider, for instance, the following remote schema:

    input Foo {
      bar: Int!
    }

    type Query {
      run(foo: Foo!): Int!
    }

Our parsers will need to decide which invocations of `run` are valid:

    query {
      run(null)             # invalid: foo is non-nullable
      run(foo: {baz: 0})    # invalid: Foo doesn't have a "baz" field
      run(foo: {bar: "0"})  # actually valid!
    }

That last example is surprising: why would we accept a string literal for an Int? It simply is
because we delegate the task of translating the literal into a scalar to the remote server. After
all, *we* advertise some values as Int in the schema, despite accepting string literals.

=== Inserting remote permissions presets

Where things get more complicated is with remote permissions. We allow users to specify "presets":
values that will always be provided to the remote schema, and that the user cannot customize in
their query. For instance, given the following schema with permissions:

    input Range {
      low:  Int! @preset(value: 0)
      high: Int!
    }

    type Query {
      getValues(range: Range!): [Int]
    }

a user cannot specify "low" in OUR schema, as we will insert its value when parsing the incoming
query. This is the second purpose of those input parsers: they insert remote schema presets where
required. In this case:

    # we receive
    query {
      getValues(range: {high: 42})
    }

    # we emit
    query {
      getValues(range: {low: 0, high: 42})
    }

=== Variable expansion

But where this gets even more complicated is with variables. As much as possible, we simply forward
variables without interpeting them (not all JSON values are representable in GraphQL). We do so
whenever possible; for instance, using the previously established remote schema:

    # we receive
    query:
      query($h: Int!) {
        getValues(range: {high: $h})
      }
    variables:
      { "h": 42 }

    # we emit
    query:
      query($h: Int!) {
        getValues(range: {low: 0, high: $h})
      }
    variables:
      { "h": 42 }

The tricky case is when a preset field is *within a variable*. We then have no choice: we have to
expand the variable, and rewrap the value as best as we can, to minimize the amount of JSON
evaluation. For instance:

    # we receive
    query:
      query($r: Range!) {
        getValues(range: $r)
      }
    variables:
      { "r": {"high": 42} }

    # we emit
    query:
      query($hasura_json_var_1: Int!) {
        getValues(range: {low: 0, high: $hasura_json_var_1})
      }
    variables:
      { "hasura_json_var_1": 42 }

Our parsers, like all others in our model, expand the variables as they traverse the tree, and add
the preset values where required. But the downside of this is that we will create one such JSON
variable per scalar within a JSON variable!

=== Short-circuiting optimization

To avoid this, we track in the parsers whether an alteration has occured: if we had to insert a
preset value. As long as we don't, we can discard the output of the parser, as it will contain the
exact same value as the input (if perhaps represented differently); by discarding the output and
just forwarding the input, we avoid expanding variables if no preset needs be inserted.
-}

-- | Helper, used to track whether an input value was altered during its parsing.
-- There are two possible sources of alteration:
--   - preset values, and
--   - type name customizations.
-- They might force evaluation of variables, and encapsulation of sub-JSON expressions as new variables.
-- Each parser indicates whether such alteration took place within its part of the tree.
-- See Note [Variable expansion in remote schema input parsers] for more information.
newtype Altered = Altered {Altered -> Bool
getAltered :: Bool}
  deriving (Int -> Altered -> ShowS
[Altered] -> ShowS
Altered -> String
(Int -> Altered -> ShowS)
-> (Altered -> String) -> ([Altered] -> ShowS) -> Show Altered
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Altered -> ShowS
showsPrec :: Int -> Altered -> ShowS
$cshow :: Altered -> String
show :: Altered -> String
$cshowList :: [Altered] -> ShowS
showList :: [Altered] -> ShowS
Show)
  deriving (NonEmpty Altered -> Altered
Altered -> Altered -> Altered
(Altered -> Altered -> Altered)
-> (NonEmpty Altered -> Altered)
-> (forall b. Integral b => b -> Altered -> Altered)
-> Semigroup Altered
forall b. Integral b => b -> Altered -> Altered
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Altered -> Altered -> Altered
<> :: Altered -> Altered -> Altered
$csconcat :: NonEmpty Altered -> Altered
sconcat :: NonEmpty Altered -> Altered
$cstimes :: forall b. Integral b => b -> Altered -> Altered
stimes :: forall b. Integral b => b -> Altered -> Altered
Semigroup, Semigroup Altered
Altered
Semigroup Altered
-> Altered
-> (Altered -> Altered -> Altered)
-> ([Altered] -> Altered)
-> Monoid Altered
[Altered] -> Altered
Altered -> Altered -> Altered
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Altered
mempty :: Altered
$cmappend :: Altered -> Altered -> Altered
mappend :: Altered -> Altered -> Altered
$cmconcat :: [Altered] -> Altered
mconcat :: [Altered] -> Altered
Monoid) via Any

-- | 'inputValueDefinitionParser' accepts a 'G.InputValueDefinition' and will return an
-- 'InputFieldsParser' for it. If a non 'Input' GraphQL type is found in the 'type' of the
-- 'InputValueDefinition' then an error will be thrown.
--
-- Each parser also returns a boolean that indicates whether the parsed value was altered by
-- presets. Presets might force the evaluation of variables that would otherwise be transmitted
-- unmodified.
inputValueDefinitionParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  G.InputValueDefinition ->
  SchemaT r m (InputFieldsParser n (Maybe (Altered, G.Value RemoteSchemaVariable)))
inputValueDefinitionParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> InputValueDefinition
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
inputValueDefinitionParser RemoteSchemaIntrospection
schemaDoc (G.InputValueDefinition Maybe Description
desc Name
name GType
fieldType Maybe (Value Void)
maybeDefaultVal [Directive Void]
_directives) =
  (forall (k :: Kind).
 ('Input <: k) =>
 Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> GType
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
buildField Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
fieldConstructor GType
fieldType
  where
    doNullability ::
      forall k.
      ('Input <: k) =>
      G.Nullability ->
      Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable)) ->
      Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable))
    doNullability :: forall (k :: Kind).
('Input <: k) =>
Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
doNullability (G.Nullability Bool
True) Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser =
      Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     k
     n
     (NullableInput (Maybe (Altered, Value RemoteSchemaVariable)))
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (NullableInput a)
P.nullableExact Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser Parser
  MetadataObjId
  k
  n
  (NullableInput (Maybe (Altered, Value RemoteSchemaVariable)))
-> (NullableInput (Maybe (Altered, Value RemoteSchemaVariable))
    -> n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall (m :: * -> *) origin (k :: Kind) a b.
Monad m =>
Parser origin k m a -> (a -> m b) -> Parser origin k m b
`bind` \case
        P.NullableInputValue Maybe (Altered, Value RemoteSchemaVariable)
x -> Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Altered, Value RemoteSchemaVariable)
x
        NullableInput (Maybe (Altered, Value RemoteSchemaVariable))
P.NullableInputNull -> Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Altered, Value RemoteSchemaVariable)
 -> n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just (Bool -> Altered
Altered Bool
False, Value RemoteSchemaVariable
forall var. Value var
G.VNull)
        NullableInput (Maybe (Altered, Value RemoteSchemaVariable))
P.NullableInputAbsent -> Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Altered, Value RemoteSchemaVariable)
forall a. Maybe a
Nothing
    doNullability (G.Nullability Bool
False) Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser = Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser

    fieldConstructor ::
      forall k.
      ('Input <: k) =>
      Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable)) ->
      InputFieldsParser n (Maybe (Altered, G.Value RemoteSchemaVariable))
    fieldConstructor :: forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
fieldConstructor (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind) (n :: * -> *).
('Input <: k, MonadParse n) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
shortCircuitIfUnaltered -> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser) =
      case Maybe (Value Void)
maybeDefaultVal of
        Maybe (Value Void)
Nothing ->
          if GType -> Bool
G.isNullable GType
fieldType
            then Maybe (Maybe (Altered, Value RemoteSchemaVariable))
-> Maybe (Altered, Value RemoteSchemaVariable)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Altered, Value RemoteSchemaVariable))
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (Maybe (Altered, Value RemoteSchemaVariable)))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (Maybe (Altered, Value RemoteSchemaVariable)))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
fieldOptional' Name
name Maybe Description
desc Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser
            else Name
-> Maybe Description
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
field Name
name Maybe Description
desc Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser
        Just Value Void
defaultVal -> Name
-> Maybe Description
-> Value Void
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Value Void
-> Parser origin k m a
-> InputFieldsParser origin m a
fieldWithDefault' Name
name Maybe Description
desc Value Void
defaultVal Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser

    buildField ::
      ( forall k.
        ('Input <: k) =>
        Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable)) ->
        InputFieldsParser n (Maybe (Altered, G.Value RemoteSchemaVariable))
      ) ->
      G.GType ->
      SchemaT r m (InputFieldsParser n (Maybe (Altered, G.Value RemoteSchemaVariable)))
    buildField :: (forall (k :: Kind).
 ('Input <: k) =>
 Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> GType
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
buildField forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
mkInputFieldsParser = \case
      G.TypeNamed Nullability
nullability Name
typeName ->
        case RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
schemaDoc Name
typeName of
          Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
Nothing -> Code
-> Text
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError (Text
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Maybe (Altered, Value RemoteSchemaVariable))))
-> Text
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ Text
"Could not find type with name " Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
typeName
          Just TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDef -> do
            MkTypename
customizeTypename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter
            case TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDef of
              G.TypeDefinitionScalar ScalarTypeDefinition
scalarTypeDefn ->
                InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Maybe (Altered, Value RemoteSchemaVariable))))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
mkInputFieldsParser (Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Nullability
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
doNullability Nullability
nullability (Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
 -> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkTypename
-> ScalarTypeDefinition
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall (n :: * -> *).
MonadParse n =>
MkTypename
-> ScalarTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldScalarParser MkTypename
customizeTypename ScalarTypeDefinition
scalarTypeDefn
              G.TypeDefinitionEnum EnumTypeDefinition
defn ->
                InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Maybe (Altered, Value RemoteSchemaVariable))))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
mkInputFieldsParser (Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Nullability
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
doNullability Nullability
nullability (Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
 -> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n (Maybe (Altered, Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkTypename
-> EnumTypeDefinition
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall (n :: * -> *).
MonadParse n =>
MkTypename
-> EnumTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldEnumParser MkTypename
customizeTypename EnumTypeDefinition
defn
              G.TypeDefinitionObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
_ ->
                Code
-> Text
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError Text
"expected input type, but got output type"
              G.TypeDefinitionInputObject InputObjectTypeDefinition RemoteSchemaInputValueDefinition
defn -> do
                Either
  (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
  (Parser 'Input n (Altered, Value RemoteSchemaVariable))
potentialObject <- RemoteSchemaIntrospection
-> InputObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Either
        (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> InputObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Either
        (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
remoteInputObjectParser RemoteSchemaIntrospection
schemaDoc InputObjectTypeDefinition RemoteSchemaInputValueDefinition
defn
                InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Maybe (Altered, Value RemoteSchemaVariable))))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ case Either
  (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
  (Parser 'Input n (Altered, Value RemoteSchemaVariable))
potentialObject of
                  Left InputFieldsParser n (Altered, Value RemoteSchemaVariable)
dummyInputFieldsParser -> do
                    -- We couln't create a parser, meaning we can't create a field for this
                    -- object. Instead we must return a "pure" InputFieldsParser that always yields
                    -- the needed result without containing a field definition.
                    --
                    -- !!! WARNING #1 !!!
                    -- Since we have no input field in the schema for this field, we can't make the
                    -- distinction between it being actually present at parsing time or not. We
                    -- therefore choose to behave as if it was always present, and we always
                    -- include the preset values in the result.
                    --
                    -- !!! WARNING #2 !!!
                    -- We are re-using an 'InputFieldsParser' that was created earlier! Won't that
                    -- create new fields in the current context? No, it won't, but only because in
                    -- this case we know that it was created from the preset fields in
                    -- 'argumentsParser', and therefore contains no field definition.
                    (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser n (Altered, Value RemoteSchemaVariable)
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldsParser n (Altered, Value RemoteSchemaVariable)
dummyInputFieldsParser
                  Right Parser 'Input n (Altered, Value RemoteSchemaVariable)
actualParser -> do
                    -- We're in the normal case: we do have a parser for the input object, which is
                    -- therefore valid (non-empty).
                    Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
mkInputFieldsParser (Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Nullability
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
doNullability Nullability
nullability (Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
 -> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> Parser 'Input n (Altered, Value RemoteSchemaVariable)
-> Parser 'Input n (Maybe (Altered, Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Input n (Altered, Value RemoteSchemaVariable)
actualParser
              G.TypeDefinitionUnion UnionTypeDefinition
_ ->
                Code
-> Text
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError Text
"expected input type, but got output type"
              G.TypeDefinitionInterface InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
_ ->
                Code
-> Text
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError Text
"expected input type, but got output type"
      G.TypeList Nullability
nullability GType
subType -> do
        (forall (k :: Kind).
 ('Input <: k) =>
 Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> GType
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
buildField (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
mkInputFieldsParser (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
    -> Parser k n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall (k :: Kind).
('Input <: k) =>
Nullability
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
doNullability Nullability
nullability (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
 -> Parser k n (Maybe (Altered, Value RemoteSchemaVariable)))
-> (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
    -> Parser k n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe (Altered, Value RemoteSchemaVariable)]
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId k n [Maybe (Altered, Value RemoteSchemaVariable)]
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b.
(a -> b)
-> Parser MetadataObjId k n a -> Parser MetadataObjId k n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> ([Maybe (Altered, Value RemoteSchemaVariable)]
    -> (Altered, Value RemoteSchemaVariable))
-> [Maybe (Altered, Value RemoteSchemaVariable)]
-> Maybe (Altered, Value RemoteSchemaVariable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Value RemoteSchemaVariable] -> Value RemoteSchemaVariable)
-> (Altered, [Value RemoteSchemaVariable])
-> (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> (Altered, a) -> (Altered, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value RemoteSchemaVariable] -> Value RemoteSchemaVariable
forall var. [Value var] -> Value var
G.VList ((Altered, [Value RemoteSchemaVariable])
 -> (Altered, Value RemoteSchemaVariable))
-> ([Maybe (Altered, Value RemoteSchemaVariable)]
    -> (Altered, [Value RemoteSchemaVariable]))
-> [Maybe (Altered, Value RemoteSchemaVariable)]
-> (Altered, Value RemoteSchemaVariable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Altered, Value RemoteSchemaVariable)]
-> (Altered, [Value RemoteSchemaVariable])
forall a. [Maybe (Altered, a)] -> (Altered, [a])
aggregateListAndAlteration) (Parser
   MetadataObjId k n [Maybe (Altered, Value RemoteSchemaVariable)]
 -> Parser k n (Maybe (Altered, Value RemoteSchemaVariable)))
-> (Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
    -> Parser
         MetadataObjId k n [Maybe (Altered, Value RemoteSchemaVariable)])
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId k n [Maybe (Altered, Value RemoteSchemaVariable)]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list) GType
subType

-- | remoteFieldScalarParser attempts to parse a scalar value for a given remote field
--
-- We do not attempt to verify that the literal is correct! Some GraphQL implementations, including
-- ours, are a bit flexible with the intepretations of literals; for instance, there are several
-- places in our schema where we declare something to be an `Int`, but actually accept `String`
-- literals. We do however peform variable type-checking.
--
-- If we encounter a JSON value, it means that we were introspecting a query variable. To call the
-- remote schema, we need a graphql value; we therefore need to treat that JSON expression as if it
-- were a query variable of its own. To avoid ending up with one such variable per scalar in the
-- query, we also track alterations, to apply optimizations.
-- See Note [Variable expansion in remote schema input parsers] for more information.
--
-- If the value contains a variable with a customized type name then we need to consider it to be
-- altered to ensure that the original type name is passed to the remote server.
remoteFieldScalarParser ::
  (MonadParse n) =>
  MkTypename ->
  G.ScalarTypeDefinition ->
  P.Parser 'Both n (Altered, G.Value RemoteSchemaVariable)
remoteFieldScalarParser :: forall (n :: * -> *).
MonadParse n =>
MkTypename
-> ScalarTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldScalarParser MkTypename
customizeTypename (G.ScalarTypeDefinition Maybe Description
description Name
name [Directive Void]
_directives) =
  P.Parser
    { pType :: Type MetadataObjId 'Both
pType = Type MetadataObjId 'Both
schemaType,
      pParser :: ParserInput 'Both -> n (Altered, Value RemoteSchemaVariable)
pParser = \case
        JSONValue Value
v ->
          -- Disallow short-circuit optimisation if the type name has been changed by remote schema customization
          (Altered, Value RemoteSchemaVariable)
-> n (Altered, Value RemoteSchemaVariable)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Altered, Value RemoteSchemaVariable)
 -> n (Altered, Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
-> n (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ (Bool -> Altered
Altered (Bool -> Altered) -> Bool -> Altered
forall a b. (a -> b) -> a -> b
$ GType -> Name
G.getBaseType GType
gType Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name, RemoteSchemaVariable -> Value RemoteSchemaVariable
forall var. var -> Value var
G.VVariable (RemoteSchemaVariable -> Value RemoteSchemaVariable)
-> RemoteSchemaVariable -> Value RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ GType -> Value -> RemoteSchemaVariable
RemoteJSONValue (GType -> GType
mkRemoteGType GType
gType) Value
v)
        GraphQLValue Value Variable
v -> case Value Variable
v of
          G.VVariable Variable
var -> do
            Bool -> GType -> Variable -> n ()
forall (m :: * -> *).
MonadParse m =>
Bool -> GType -> Variable -> m ()
P.typeCheck Bool
False GType
gType Variable
var
            -- Disallow short-circuit optimisation if the type name has been changed by remote schema customization
            (Altered, Value RemoteSchemaVariable)
-> n (Altered, Value RemoteSchemaVariable)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Altered, Value RemoteSchemaVariable)
 -> n (Altered, Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
-> n (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ (Bool -> Altered
Altered (Bool -> Altered) -> Bool -> Altered
forall a b. (a -> b) -> a -> b
$ GType -> Name
G.getBaseType (Variable -> GType
vType Variable
var) Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name, RemoteSchemaVariable -> Value RemoteSchemaVariable
forall var. var -> Value var
G.VVariable (RemoteSchemaVariable -> Value RemoteSchemaVariable)
-> RemoteSchemaVariable -> Value RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ Variable -> RemoteSchemaVariable
QueryVariable Variable
var {vType :: GType
vType = GType -> GType
mkRemoteGType (Variable -> GType
vType Variable
var)})
          Value Variable
_ -> (Altered, Value RemoteSchemaVariable)
-> n (Altered, Value RemoteSchemaVariable)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Altered
Altered Bool
False, Variable -> RemoteSchemaVariable
QueryVariable (Variable -> RemoteSchemaVariable)
-> Value Variable -> Value RemoteSchemaVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Variable
v)
    }
  where
    customizedTypename :: Name
customizedTypename = MkTypename -> Name -> Name
runMkTypename MkTypename
customizeTypename Name
name
    schemaType :: Type MetadataObjId 'Both
schemaType = Nullability
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall origin (k :: Kind).
Nullability
-> Definition origin (TypeInfo origin k) -> Type origin k
TNamed Nullability
NonNullable (Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
 -> Type MetadataObjId 'Both)
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
-> Type MetadataObjId 'Both
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> TypeInfo MetadataObjId 'Both
-> Definition MetadataObjId (TypeInfo MetadataObjId 'Both)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
Definition Name
customizedTypename Maybe Description
description Maybe MetadataObjId
forall a. Maybe a
Nothing [] TypeInfo MetadataObjId 'Both
forall origin. TypeInfo origin 'Both
TIScalar
    gType :: GType
gType = Type MetadataObjId 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
toGraphQLType Type MetadataObjId 'Both
schemaType

    mkRemoteGType :: GType -> GType
mkRemoteGType = \case
      G.TypeNamed Nullability
n Name
_ -> Nullability -> Name -> GType
G.TypeNamed Nullability
n Name
name
      G.TypeList Nullability
n GType
l -> Nullability -> GType -> GType
G.TypeList Nullability
n (GType -> GType) -> GType -> GType
forall a b. (a -> b) -> a -> b
$ GType -> GType
mkRemoteGType GType
l

remoteFieldEnumParser ::
  (MonadParse n) =>
  MkTypename ->
  G.EnumTypeDefinition ->
  Parser 'Both n (Altered, G.Value RemoteSchemaVariable)
remoteFieldEnumParser :: forall (n :: * -> *).
MonadParse n =>
MkTypename
-> EnumTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldEnumParser MkTypename
customizeTypename (G.EnumTypeDefinition Maybe Description
desc Name
name [Directive Void]
_directives [EnumValueDefinition]
valueDefns) =
  let enumValDefns :: [(Definition MetadataObjId EnumValueInfo,
  Value RemoteSchemaVariable)]
enumValDefns =
        [EnumValueDefinition]
valueDefns [EnumValueDefinition]
-> (EnumValueDefinition
    -> (Definition MetadataObjId EnumValueInfo,
        Value RemoteSchemaVariable))
-> [(Definition MetadataObjId EnumValueInfo,
     Value RemoteSchemaVariable)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(G.EnumValueDefinition Maybe Description
enumDesc EnumValue
enumName [Directive Void]
_) ->
          ( Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> EnumValueInfo
-> Definition MetadataObjId EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
Definition (EnumValue -> Name
G.unEnumValue EnumValue
enumName) Maybe Description
enumDesc Maybe MetadataObjId
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo,
            EnumValue -> Value RemoteSchemaVariable
forall var. EnumValue -> Value var
G.VEnum EnumValue
enumName
          )
      customizedTypeName :: Name
customizedTypeName = MkTypename -> Name -> Name
runMkTypename MkTypename
customizeTypename Name
name
   in (Value RemoteSchemaVariable
 -> (Altered, Value RemoteSchemaVariable))
-> Parser MetadataObjId 'Both n (Value RemoteSchemaVariable)
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Both n a -> Parser MetadataObjId 'Both n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Altered
Altered (Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
customizedTypeName),) (Parser MetadataObjId 'Both n (Value RemoteSchemaVariable)
 -> Parser
      MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable))
-> Parser MetadataObjId 'Both n (Value RemoteSchemaVariable)
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo,
      Value RemoteSchemaVariable)
-> Parser MetadataObjId 'Both n (Value RemoteSchemaVariable)
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
customizedTypeName Maybe Description
desc (NonEmpty
   (Definition MetadataObjId EnumValueInfo,
    Value RemoteSchemaVariable)
 -> Parser MetadataObjId 'Both n (Value RemoteSchemaVariable))
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo,
      Value RemoteSchemaVariable)
-> Parser MetadataObjId 'Both n (Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ [(Definition MetadataObjId EnumValueInfo,
  Value RemoteSchemaVariable)]
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo,
      Value RemoteSchemaVariable)
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [(Definition MetadataObjId EnumValueInfo,
  Value RemoteSchemaVariable)]
enumValDefns

-- | remoteInputObjectParser returns an input parser for a given 'G.InputObjectTypeDefinition'
--
-- Now, this is tricky! We are faced with two contradicting constraints here. On one hand, the
-- GraphQL spec forbids us from creating empty input objects. This means that if all the arguments
-- have presets, we CANNOT use the parser this function creates, and the caller cannot create a
-- field for this object (and instead should use @pure@ to include the preset values in the result
-- of parsing the fields).
--
-- One way we could fix this would be to change the type of this function to return a `Maybe
-- Parser`, inspect the result of 'argumentsParser', and return @Nothing@ when we realize that there
-- aren't any actual field in it (or at least return a value that propagates the preset values). But
-- this would contradict our second constraint: this function needs to be memoized!
--
-- At time of writing, we can't memoize functions that return arbitrary functors of Parsers; so no
-- memoizing Maybe Parser or Either Presets Parser. Which means that we would need to first call
-- `argumentsParser`, then memoize the "Just" branch that builds the actual Parser. The problem is
-- that the recursive call ro remoteSchemaInputObject is within 'argumentsParser', meaning the call
-- to it MUST be in the memoized branch!
--
-- This is why, in the end, we do the following: we first test whether there is any non-preset
-- field: if yes, we memoize that branch and proceed as normal. Otherwise we can omit the
-- memoization: we know for sure that the preset fields won't generate a recursive call!
remoteInputObjectParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  G.InputObjectTypeDefinition RemoteSchemaInputValueDefinition ->
  SchemaT
    r
    m
    ( Either
        (InputFieldsParser n (Altered, G.Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, G.Value RemoteSchemaVariable))
    )
remoteInputObjectParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> InputObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Either
        (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
remoteInputObjectParser RemoteSchemaIntrospection
schemaDoc defn :: InputObjectTypeDefinition RemoteSchemaInputValueDefinition
defn@(G.InputObjectTypeDefinition Maybe Description
desc Name
name [Directive Void]
_ [RemoteSchemaInputValueDefinition]
valueDefns) =
  if (RemoteSchemaInputValueDefinition -> Bool)
-> [RemoteSchemaInputValueDefinition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (Value RemoteSchemaVariable) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Value RemoteSchemaVariable) -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> Maybe (Value RemoteSchemaVariable))
-> RemoteSchemaInputValueDefinition
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaInputValueDefinition
-> Maybe (Value RemoteSchemaVariable)
_rsitdPresetArgument) [RemoteSchemaInputValueDefinition]
valueDefns
    then -- All the fields are preset: we can't create a parser, that would result in an invalid type in
    -- the schema (an input object with no field). We therefore forward the InputFieldsParser
    -- unmodified. No need to memoize this branch: since all arguments are preset, 'argumentsParser'
    -- won't be recursively calling this function.
      InputFieldsParser n (Altered, Value RemoteSchemaVariable)
-> Either
     (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
     (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall a b. a -> Either a b
Left (InputFieldsParser n (Altered, Value RemoteSchemaVariable)
 -> Either
      (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
      (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
-> (InputFieldsParser
      MetadataObjId
      n
      (Altered, HashMap Name (Value RemoteSchemaVariable))
    -> InputFieldsParser n (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Either
     (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
     (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Altered, HashMap Name (Value RemoteSchemaVariable))
 -> (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
-> InputFieldsParser n (Altered, Value RemoteSchemaVariable)
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HashMap Name (Value RemoteSchemaVariable)
 -> Value RemoteSchemaVariable)
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> (Altered, a) -> (Altered, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashMap Name (Value RemoteSchemaVariable)
-> Value RemoteSchemaVariable
forall var. HashMap Name (Value var) -> Value var
G.VObject) (InputFieldsParser
   MetadataObjId
   n
   (Altered, HashMap Name (Value RemoteSchemaVariable))
 -> Either
      (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
      (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (Either
        (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
[RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
argumentsParser [RemoteSchemaInputValueDefinition]
valueDefns RemoteSchemaIntrospection
schemaDoc
    else -- At least one field is not a preset, meaning we have the guarantee that there will be at least
    -- one field in the input object. We have to memoize this branch as we might recursively call
    -- the same parser.

      Parser 'Input n (Altered, Value RemoteSchemaVariable)
-> Either
     (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
     (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall a b. b -> Either a b
Right (Parser 'Input n (Altered, Value RemoteSchemaVariable)
 -> Either
      (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
      (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
-> SchemaT
     r m (Parser 'Input n (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (Either
        (InputFieldsParser n (Altered, Value RemoteSchemaVariable))
        (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> InputObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r m (Parser 'Input n (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r m (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'remoteInputObjectParser InputObjectTypeDefinition RemoteSchemaInputValueDefinition
defn do
        Name
typename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter SchemaT r m MkTypename -> (MkTypename -> Name) -> SchemaT r m Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MkTypename
mkTypename -> MkTypename -> Name -> Name
runMkTypename MkTypename
mkTypename Name
name

        -- Disallow short-circuit optimisation if the type name has been changed by remote schema customization
        let altered :: Altered
altered = Bool -> Altered
Altered (Bool -> Altered) -> Bool -> Altered
forall a b. (a -> b) -> a -> b
$ Name
typename Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
        InputFieldsParser
  MetadataObjId
  n
  (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser <- ((Altered, HashMap Name (Value RemoteSchemaVariable))
 -> (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> InputFieldsParser
     MetadataObjId
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Altered -> Altered)
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Altered -> Altered -> Altered
forall a. Semigroup a => a -> a -> a
<> Altered
altered)) (InputFieldsParser
   MetadataObjId
   n
   (Altered, HashMap Name (Value RemoteSchemaVariable))
 -> InputFieldsParser
      MetadataObjId
      n
      (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
[RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
argumentsParser [RemoteSchemaInputValueDefinition]
valueDefns RemoteSchemaIntrospection
schemaDoc
        Parser 'Input n (Altered, Value RemoteSchemaVariable)
-> SchemaT
     r m (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Input n (Altered, Value RemoteSchemaVariable)
 -> SchemaT
      r m (Parser 'Input n (Altered, Value RemoteSchemaVariable)))
-> Parser 'Input n (Altered, Value RemoteSchemaVariable)
-> SchemaT
     r m (Parser 'Input n (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (HashMap Name (Value RemoteSchemaVariable)
 -> Value RemoteSchemaVariable)
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> (Altered, a) -> (Altered, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashMap Name (Value RemoteSchemaVariable)
-> Value RemoteSchemaVariable
forall var. HashMap Name (Value var) -> Value var
G.VObject ((Altered, HashMap Name (Value RemoteSchemaVariable))
 -> (Altered, Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Input
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser 'Input n (Altered, Value RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Input
     n
     (Altered, HashMap Name (Value RemoteSchemaVariable))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
typename Maybe Description
desc InputFieldsParser
  MetadataObjId
  n
  (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser

-- | Variable expansion optimization.
-- Since each parser returns a value that indicates whether it was altered, we can detect when no
-- alteration took place, and replace the parsed and expanded value by its original.
-- See Note [Variable expansion in remote schema input parsers] for more information.
shortCircuitIfUnaltered ::
  forall k n.
  ('Input <: k, MonadParse n) =>
  Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable)) ->
  Parser k n (Maybe (Altered, G.Value RemoteSchemaVariable))
shortCircuitIfUnaltered :: forall (k :: Kind) (n :: * -> *).
('Input <: k, MonadParse n) =>
Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
shortCircuitIfUnaltered Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser =
  P.Parser
    { pType :: Type MetadataObjId k
pType = Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Type MetadataObjId k
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> Type origin k
P.pType Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser,
      pParser :: ParserInput k -> n (Maybe (Altered, Value RemoteSchemaVariable))
pParser = \ParserInput k
value -> do
        Maybe (Altered, Value RemoteSchemaVariable)
result <- Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> ParserInput k -> n (Maybe (Altered, Value RemoteSchemaVariable))
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> ParserInput k -> m a
P.pParser Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser ParserInput k
value
        Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Altered, Value RemoteSchemaVariable)
 -> n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Maybe (Altered, Value RemoteSchemaVariable)
-> n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ case Maybe (Altered, Value RemoteSchemaVariable)
result of
          -- The parser did yield a value, and it was unmodified by presets
          -- we can short-circuit by transforming the input value, therefore
          -- "unpeeling" variables and avoiding extraneous JSON variables.
          Just (Altered Bool
False, Value RemoteSchemaVariable
_) -> (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
Just
            ((Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ (Bool -> Altered
Altered Bool
False,)
            (Value RemoteSchemaVariable
 -> (Altered, Value RemoteSchemaVariable))
-> Value RemoteSchemaVariable
-> (Altered, Value RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ case (ParserInput k :~: InputValue Variable)
-> ParserInput k -> InputValue Variable
forall a b. (a :~: b) -> a -> b
castWith (forall (k :: Kind).
('Input <: k) =>
ParserInput k :~: InputValue Variable
P.inputParserInput @k) ParserInput k
value of
              -- The input was a GraphQL value: just forward it.
              GraphQLValue Value Variable
v -> Variable -> RemoteSchemaVariable
QueryVariable (Variable -> RemoteSchemaVariable)
-> Value Variable -> Value RemoteSchemaVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Variable
v
              -- The input value was already a JSON value: we still have to create
              -- a new JSON variable, but it will still be more efficient than having
              -- all the leaves of said value each be their own distinct value.
              JSONValue Value
v -> RemoteSchemaVariable -> Value RemoteSchemaVariable
forall var. var -> Value var
G.VVariable (RemoteSchemaVariable -> Value RemoteSchemaVariable)
-> RemoteSchemaVariable -> Value RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ GType -> Value -> RemoteSchemaVariable
RemoteJSONValue (Type MetadataObjId k -> GType
forall origin (k :: Kind). Type origin k -> GType
toGraphQLType (Type MetadataObjId k -> GType) -> Type MetadataObjId k -> GType
forall a b. (a -> b) -> a -> b
$ Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
-> Type MetadataObjId k
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> Type origin k
P.pType Parser k n (Maybe (Altered, Value RemoteSchemaVariable))
parser) Value
v
          -- Otherwise either the parser did not yield any value, or a value
          -- that has been altered by presets, permissions or type name customization; we forward it
          -- unoptimized.
          Maybe (Altered, Value RemoteSchemaVariable)
_ -> Maybe (Altered, Value RemoteSchemaVariable)
result
    }

-- | argumentsParser is used for creating an argument parser for remote fields,
-- This function is called for field arguments and input object fields. This
-- function works in the following way:
--
--   * if a field is not preset, we recursively call `inputValueDefinitionParser` on it
--   * otherwise, we use the preset
--
-- For example, consider the following input objects:
--
--   input MessageWhereInpObj {
--     id:   IntCompareObj
--     name: StringCompareObj
--   }
--
--   input IntCompareObj {
--     eq : Int @preset(value: 2)
--     gt : Int
--     lt : Int
--   }
--
-- parsing a MessageWhereInpObj will result in the following call tree:
--
--   -> argumentsParser MessageWhereInpObj
--     -> id => inputValueDefinitionParser IntCompareObj
--       -> remoteInputObjectParser IntCompareObj
--         -> argumentsParser IntCompareObj
--           -> eq => using preset, no recursion
--           -> gt => inputValueDefinitionParser Int
--             -> remoteFieldScalarParser Int
--           -> lt => inputValueDefinitionParser Int
--             -> remoteFieldScalarParser Int
--     -> name => inputValueDefinitionParser StringCompareObj
--       -> ...
--
-- Furthermore, like all other input parsers in this file, 'argumentsParser' indicates whether this
-- part of the tree was altered during parsing; if any of the fields is preset, or recursively
-- contains values that contain presets further down, then this result is labelled as altered.
argumentsParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
  RemoteSchemaIntrospection ->
  SchemaT r m (InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)))
argumentsParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
[RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
argumentsParser [RemoteSchemaInputValueDefinition]
args RemoteSchemaIntrospection
schemaDoc = do
  -- ! DANGER !
  --
  -- This function is mutually recursive with 'inputValueDefinitionParser': if one of the non-preset
  -- arguments is an input object, then recursively we'll end up using 'argumentsParser' to parse
  -- its arguments. Note however that if all arguments have a preset value, then this function will
  -- not call 'inputValueDefinitionParser', and will simply return without any recursion.
  --
  -- This is labelled as dangerous because another function in this module,
  -- 'remoteInputObjectParser', EXPLICITLY RELIES ON THIS BEHAVIOUR. Due to limitations of the
  -- GraphQL spec and of parser memoization functions, it cannot memoize the case where all
  -- arguments are preset, and therefore relies on the assumption that 'argumentsParser' is not
  -- recursive in this edge case.
  --
  -- This assumptions is unlikely to ever be broken; but if you ever modify this function, please
  -- nonetheless make sure that it is maintained.
  [InputFieldsParser
   MetadataObjId
   n
   (Maybe (Altered, (Name, Value RemoteSchemaVariable)))]
argsParsers <- [RemoteSchemaInputValueDefinition]
-> (RemoteSchemaInputValueDefinition
    -> SchemaT
         r
         m
         (InputFieldsParser
            MetadataObjId
            n
            (Maybe (Altered, (Name, Value RemoteSchemaVariable)))))
-> SchemaT
     r
     m
     [InputFieldsParser
        MetadataObjId
        n
        (Maybe (Altered, (Name, Value RemoteSchemaVariable)))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [RemoteSchemaInputValueDefinition]
args \RemoteSchemaInputValueDefinition
arg -> do
    let argDef :: InputValueDefinition
argDef = RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition RemoteSchemaInputValueDefinition
arg
        argName :: Name
argName = InputValueDefinition -> Name
G._ivdName InputValueDefinition
argDef
    InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
argParser <- case RemoteSchemaInputValueDefinition
-> Maybe (Value RemoteSchemaVariable)
_rsitdPresetArgument RemoteSchemaInputValueDefinition
arg of
      Maybe (Value RemoteSchemaVariable)
Nothing -> RemoteSchemaIntrospection
-> InputValueDefinition
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> InputValueDefinition
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
inputValueDefinitionParser RemoteSchemaIntrospection
schemaDoc InputValueDefinition
argDef
      -- This is the source of all possible alterations: one of the fields is preset; everything
      -- "above" this field in the tree will be considered "altered", and the optimizations will
      -- not apply.
      Just Value RemoteSchemaVariable
preset -> InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Maybe (Altered, Value RemoteSchemaVariable))))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ Maybe (Altered, Value RemoteSchemaVariable)
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall a. a -> InputFieldsParser MetadataObjId n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Altered, Value RemoteSchemaVariable)
 -> InputFieldsParser
      n (Maybe (Altered, Value RemoteSchemaVariable)))
-> Maybe (Altered, Value RemoteSchemaVariable)
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, Value RemoteSchemaVariable)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Altered
Altered Bool
True, Value RemoteSchemaVariable
preset)
    InputFieldsParser
  MetadataObjId
  n
  (Maybe (Altered, (Name, Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Maybe (Altered, (Name, Value RemoteSchemaVariable))))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser
   MetadataObjId
   n
   (Maybe (Altered, (Name, Value RemoteSchemaVariable)))
 -> SchemaT
      r
      m
      (InputFieldsParser
         MetadataObjId
         n
         (Maybe (Altered, (Name, Value RemoteSchemaVariable)))))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (Altered, (Name, Value RemoteSchemaVariable)))
-> SchemaT
     r
     m
     (InputFieldsParser
        MetadataObjId
        n
        (Maybe (Altered, (Name, Value RemoteSchemaVariable))))
forall a b. (a -> b) -> a -> b
$ ((Altered, Value RemoteSchemaVariable)
 -> (Altered, (Name, Value RemoteSchemaVariable)))
-> Maybe (Altered, Value RemoteSchemaVariable)
-> Maybe (Altered, (Name, Value RemoteSchemaVariable))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value RemoteSchemaVariable -> (Name, Value RemoteSchemaVariable))
-> (Altered, Value RemoteSchemaVariable)
-> (Altered, (Name, Value RemoteSchemaVariable))
forall a b. (a -> b) -> (Altered, a) -> (Altered, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name
argName,)) (Maybe (Altered, Value RemoteSchemaVariable)
 -> Maybe (Altered, (Name, Value RemoteSchemaVariable)))
-> InputFieldsParser
     n (Maybe (Altered, Value RemoteSchemaVariable))
-> InputFieldsParser
     MetadataObjId
     n
     (Maybe (Altered, (Name, Value RemoteSchemaVariable)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldsParser n (Maybe (Altered, Value RemoteSchemaVariable))
argParser
  InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldsParser
   n (Altered, HashMap Name (Value RemoteSchemaVariable))
 -> SchemaT
      r
      m
      (InputFieldsParser
         n (Altered, HashMap Name (Value RemoteSchemaVariable))))
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall a b. (a -> b) -> a -> b
$ [InputFieldsParser
   MetadataObjId
   n
   (Maybe (Altered, (Name, Value RemoteSchemaVariable)))]
-> InputFieldsParser
     MetadataObjId
     n
     [Maybe (Altered, (Name, Value RemoteSchemaVariable))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [InputFieldsParser
   MetadataObjId
   n
   (Maybe (Altered, (Name, Value RemoteSchemaVariable)))]
argsParsers InputFieldsParser
  MetadataObjId
  n
  [Maybe (Altered, (Name, Value RemoteSchemaVariable))]
-> ([Maybe (Altered, (Name, Value RemoteSchemaVariable))]
    -> (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([(Name, Value RemoteSchemaVariable)]
 -> HashMap Name (Value RemoteSchemaVariable))
-> (Altered, [(Name, Value RemoteSchemaVariable)])
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
forall a b. (a -> b) -> (Altered, a) -> (Altered, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Name, Value RemoteSchemaVariable)]
-> HashMap Name (Value RemoteSchemaVariable)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((Altered, [(Name, Value RemoteSchemaVariable)])
 -> (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> ([Maybe (Altered, (Name, Value RemoteSchemaVariable))]
    -> (Altered, [(Name, Value RemoteSchemaVariable)]))
-> [Maybe (Altered, (Name, Value RemoteSchemaVariable))]
-> (Altered, HashMap Name (Value RemoteSchemaVariable))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Altered, (Name, Value RemoteSchemaVariable))]
-> (Altered, [(Name, Value RemoteSchemaVariable)])
forall a. [Maybe (Altered, a)] -> (Altered, [a])
aggregateListAndAlteration

aggregateListAndAlteration :: [Maybe (Altered, a)] -> (Altered, [a])
aggregateListAndAlteration :: forall a. [Maybe (Altered, a)] -> (Altered, [a])
aggregateListAndAlteration = ([Altered] -> Altered) -> ([Altered], [a]) -> (Altered, [a])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Altered] -> Altered
forall a. Monoid a => [a] -> a
mconcat (([Altered], [a]) -> (Altered, [a]))
-> ([Maybe (Altered, a)] -> ([Altered], [a]))
-> [Maybe (Altered, a)]
-> (Altered, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Altered, a)] -> ([Altered], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Altered, a)] -> ([Altered], [a]))
-> ([Maybe (Altered, a)] -> [(Altered, a)])
-> [Maybe (Altered, a)]
-> ([Altered], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Altered, a)] -> [(Altered, a)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes

--------------------------------------------------------------------------------
-- Remote schema output parsers

remoteSchemaRelationships ::
  forall r n m.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaRelationships ->
  G.Name ->
  SchemaT r m [FieldParser n (IR.SchemaRemoteRelationshipSelect (IR.RemoteRelationshipField IR.UnpreparedValue))]
remoteSchemaRelationships :: forall r (n :: * -> *) (m :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaRelationships
-> Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
remoteSchemaRelationships RemoteSchemaRelationships
relationships Name
typeName =
  case Name
-> RemoteSchemaRelationships
-> Maybe (InsOrdHashMap RelName (RemoteFieldInfo Name))
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Name
typeName RemoteSchemaRelationships
relationships of
    Maybe (InsOrdHashMap RelName (RemoteFieldInfo Name))
Nothing -> [FieldParser
   n
   (SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just InsOrdHashMap RelName (RemoteFieldInfo Name)
rels ->
      [[FieldParser
    n
    (SchemaRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))]]
-> [FieldParser
      n
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FieldParser
     n
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue))]]
 -> [FieldParser
       n
       (SchemaRemoteRelationshipSelect
          (RemoteRelationshipField UnpreparedValue))])
-> SchemaT
     r
     m
     [[FieldParser
         n
         (SchemaRemoteRelationshipSelect
            (RemoteRelationshipField UnpreparedValue))]]
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RemoteFieldInfo Name]
-> (RemoteFieldInfo Name
    -> SchemaT
         r
         m
         [FieldParser
            n
            (SchemaRemoteRelationshipSelect
               (RemoteRelationshipField UnpreparedValue))])
-> SchemaT
     r
     m
     [[FieldParser
         n
         (SchemaRemoteRelationshipSelect
            (RemoteRelationshipField UnpreparedValue))]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (InsOrdHashMap RelName (RemoteFieldInfo Name)
-> [RemoteFieldInfo Name]
forall a. InsOrdHashMap RelName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList InsOrdHashMap RelName (RemoteFieldInfo Name)
rels) \RemoteFieldInfo Name
remoteFieldInfo -> do
        RemoteRelationshipParserBuilder forall lhsJoinField r (n :: * -> *) (m :: * -> *).
MonadBuildSchemaBase m n =>
RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
remoteRelationshipField <- (SchemaContext -> RemoteRelationshipParserBuilder)
-> SchemaT r m RemoteRelationshipParserBuilder
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RemoteRelationshipParserBuilder
scRemoteRelationshipParserBuilder
        [FieldParser n (RemoteRelationshipField UnpreparedValue)]
relationshipFields <- [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]
 -> [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> SchemaT
     r m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteFieldInfo Name
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall lhsJoinField r (n :: * -> *) (m :: * -> *).
MonadBuildSchemaBase m n =>
RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
remoteRelationshipField RemoteFieldInfo Name
remoteFieldInfo
        let lhsFields :: HashMap FieldName Name
lhsFields = RemoteFieldInfo Name -> HashMap FieldName Name
forall lhsJoinField.
RemoteFieldInfo lhsJoinField -> HashMap FieldName lhsJoinField
_rfiLHS RemoteFieldInfo Name
remoteFieldInfo
        [FieldParser
   n
   (SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    n
    (SchemaRemoteRelationshipSelect
       (RemoteRelationshipField UnpreparedValue))]
 -> SchemaT
      r
      m
      [FieldParser
         n
         (SchemaRemoteRelationshipSelect
            (RemoteRelationshipField UnpreparedValue))])
-> [FieldParser
      n
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))]
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
forall a b. (a -> b) -> a -> b
$ (FieldParser n (RemoteRelationshipField UnpreparedValue)
 -> FieldParser
      n
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue)))
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> [FieldParser
      n
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))]
forall a b. (a -> b) -> [a] -> [b]
map ((RemoteRelationshipField UnpreparedValue
 -> SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))
-> FieldParser n (RemoteRelationshipField UnpreparedValue)
-> FieldParser
     n
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue))
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashMap FieldName Name
-> RemoteRelationshipField UnpreparedValue
-> SchemaRemoteRelationshipSelect
     (RemoteRelationshipField UnpreparedValue)
forall r.
HashMap FieldName Name -> r -> SchemaRemoteRelationshipSelect r
IR.SchemaRemoteRelationshipSelect HashMap FieldName Name
lhsFields)) [FieldParser n (RemoteRelationshipField UnpreparedValue)]
relationshipFields

-- | 'remoteSchemaObject' returns a output parser for a given 'ObjectTypeDefinition'.
remoteSchemaObject ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  G.ObjectTypeDefinition RemoteSchemaInputValueDefinition ->
  SchemaT r m (Parser 'Output n (IR.ObjectSelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteSchemaObject :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaObject RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships defn :: ObjectTypeDefinition RemoteSchemaInputValueDefinition
defn@(G.ObjectTypeDefinition Maybe Description
description Name
name [Name]
interfaces [Directive Void]
_directives [FieldDefinition RemoteSchemaInputValueDefinition]
subFields) =
  Name
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'remoteSchemaObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
defn do
    [FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subFieldParsers <- (FieldDefinition RemoteSchemaInputValueDefinition
 -> SchemaT
      r
      m
      (FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     [FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromDefinition RemoteSchemaIntrospection
schemaDoc Name
name RemoteSchemaRelationships
remoteRelationships) [FieldDefinition RemoteSchemaInputValueDefinition]
subFields
    [FieldParser
   n
   (SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))]
remoteJoinParsers <- RemoteSchemaRelationships
-> Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
forall r (n :: * -> *) (m :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaRelationships
-> Name
-> SchemaT
     r
     m
     [FieldParser
        n
        (SchemaRemoteRelationshipSelect
           (RemoteRelationshipField UnpreparedValue))]
remoteSchemaRelationships RemoteSchemaRelationships
remoteRelationships Name
name
    [InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition]
interfaceDefs <- (Name
 -> SchemaT
      r
      m
      (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> [Name]
-> SchemaT
     r
     m
     [InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Name
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
getInterface [Name]
interfaces
    [Parser
   'Output
   n
   (DeduplicatedSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
implements <- (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
 -> SchemaT
      r
      m
      (Parser
         'Output
         n
         (DeduplicatedSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [InterfaceTypeDefinition
      [Name] RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     [Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaInterface RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships) [InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition]
interfaceDefs
    -- TODO: also check sub-interfaces, when these are supported in a future graphql spec
    (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
 -> SchemaT r m ())
-> [InterfaceTypeDefinition
      [Name] RemoteSchemaInputValueDefinition]
-> SchemaT r m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT r m ()
validateImplementsFields [InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition]
interfaceDefs
    Name
typename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter SchemaT r m MkTypename -> (MkTypename -> Name) -> SchemaT r m Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MkTypename
mkTypename -> MkTypename -> Name -> Name
runMkTypename MkTypename
mkTypename Name
name
    let allFields :: [FieldParser
   MetadataObjId
   n
   (Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
allFields = (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> [FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a b. (a -> b) -> [a] -> [b]
map ((GraphQLField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     MetadataObjId
     n
     (Field
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. GraphQLField r var -> Field r var
IR.FieldGraphQL) [FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subFieldParsers [FieldParser
   MetadataObjId
   n
   (Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a. Semigroup a => a -> a -> a
<> (FieldParser
   n
   (SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))
 -> FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> [FieldParser
      n
      (SchemaRemoteRelationshipSelect
         (RemoteRelationshipField UnpreparedValue))]
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a b. (a -> b) -> [a] -> [b]
map ((SchemaRemoteRelationshipSelect
   (RemoteRelationshipField UnpreparedValue)
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (SchemaRemoteRelationshipSelect
        (RemoteRelationshipField UnpreparedValue))
-> FieldParser
     MetadataObjId
     n
     (Field
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SchemaRemoteRelationshipSelect
  (RemoteRelationshipField UnpreparedValue)
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. SchemaRemoteRelationshipSelect r -> Field r var
IR.FieldRemote) [FieldParser
   n
   (SchemaRemoteRelationshipSelect
      (RemoteRelationshipField UnpreparedValue))]
remoteJoinParsers
    Parser
  MetadataObjId
  'Output
  n
  (ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Parser
   MetadataObjId
   'Output
   n
   (ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (Parser
         MetadataObjId
         'Output
         n
         (ObjectSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> Parser
     MetadataObjId
     'Output
     n
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [Parser
      'Output
      n
      (DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Parser
     MetadataObjId
     'Output
     n
     (InsOrdHashMap
        Name
        (ParsedSelection
           (Field
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> [Parser origin 'Output m b]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSetObject Name
typename Maybe Description
description [FieldParser
   MetadataObjId
   n
   (Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
allFields [Parser
   'Output
   n
   (DeduplicatedSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
implements
      Parser
  MetadataObjId
  'Output
  n
  (InsOrdHashMap
     Name
     (ParsedSelection
        (Field
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> (InsOrdHashMap
      Name
      (ParsedSelection
         (Field
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
    -> ObjectSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Name
 -> ParsedSelection
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> InsOrdHashMap
     Name
     (ParsedSelection
        (Field
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall k v1 v2.
(k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrdHashMap.mapWithKey \Name
alias ->
        (Name
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ParsedSelection
     (Field
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a. (Name -> a) -> ParsedSelection a -> a
handleTypename
          ((Name
  -> Field
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> ParsedSelection
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> (Name
    -> Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ParsedSelection
     (Field
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ Field
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Name
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. a -> b -> a
const
          (Field
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Name
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Name
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. GraphQLField r var -> Field r var
IR.FieldGraphQL
          (GraphQLField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> [Directive RemoteSchemaVariable]
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
IR.mkGraphQLField (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
alias) Name
GName.___typename HashMap Name (Value RemoteSchemaVariable)
forall a. Monoid a => a
mempty [Directive RemoteSchemaVariable]
forall a. Monoid a => a
mempty SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. SelectionSet r var
IR.SelectionSetNone
  where
    getInterface :: G.Name -> SchemaT r m (G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
    getInterface :: Name
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
getInterface Name
interfaceName =
      Maybe
  (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaIntrospection
-> Name
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupInterface RemoteSchemaIntrospection
schemaDoc Name
interfaceName)
        (SchemaT
   r
   m
   (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> SchemaT
      r
      m
      (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Code
-> Text
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
        (Text
 -> SchemaT
      r
      m
      (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> Text
-> SchemaT
     r
     m
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"Could not find interface "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" implemented by Object type "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
    validateImplementsFields :: G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition -> SchemaT r m ()
    validateImplementsFields :: InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT r m ()
validateImplementsFields InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
interface =
      (FieldDefinition RemoteSchemaInputValueDefinition
 -> SchemaT r m ())
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> SchemaT r m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Name
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT r m ()
validateImplementsField (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> Name
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
G._itdName InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
interface)) (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> [FieldDefinition RemoteSchemaInputValueDefinition]
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> [FieldDefinition inputType]
G._itdFieldsDefinition InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
interface)
    validateImplementsField :: G.Name -> G.FieldDefinition RemoteSchemaInputValueDefinition -> SchemaT r m ()
    validateImplementsField :: Name
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT r m ()
validateImplementsField Name
interfaceName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField =
      case Name
-> [(Name, FieldDefinition RemoteSchemaInputValueDefinition)]
-> Maybe (FieldDefinition RemoteSchemaInputValueDefinition)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField) ([Name]
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> [(Name, FieldDefinition RemoteSchemaInputValueDefinition)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FieldDefinition RemoteSchemaInputValueDefinition -> Name)
-> [FieldDefinition RemoteSchemaInputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName [FieldDefinition RemoteSchemaInputValueDefinition]
subFields) [FieldDefinition RemoteSchemaInputValueDefinition]
subFields) of
        Maybe (FieldDefinition RemoteSchemaInputValueDefinition)
Nothing ->
          Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
            (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"Interface field "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" expected, but "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not provide it"
        Just FieldDefinition RemoteSchemaInputValueDefinition
f -> do
          Bool -> SchemaT r m () -> SchemaT r m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GType -> GType -> Bool
validateSubType (FieldDefinition RemoteSchemaInputValueDefinition -> GType
forall inputType. FieldDefinition inputType -> GType
G._fldType FieldDefinition RemoteSchemaInputValueDefinition
f) (FieldDefinition RemoteSchemaInputValueDefinition -> GType
forall inputType. FieldDefinition inputType -> GType
G._fldType FieldDefinition RemoteSchemaInputValueDefinition
interfaceField))
            (SchemaT r m () -> SchemaT r m ())
-> SchemaT r m () -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
            (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"The type of Object field "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
f)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
G.showGT (FieldDefinition RemoteSchemaInputValueDefinition -> GType
forall inputType. FieldDefinition inputType -> GType
G._fldType FieldDefinition RemoteSchemaInputValueDefinition
f)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") is not the same type/sub type of Interface field "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
G.showGT (FieldDefinition RemoteSchemaInputValueDefinition -> GType
forall inputType. FieldDefinition inputType -> GType
G._fldType FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          (RemoteSchemaInputValueDefinition -> SchemaT r m ())
-> [RemoteSchemaInputValueDefinition] -> SchemaT r m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
            ( [InputValueDefinition] -> InputValueDefinition -> SchemaT r m ()
validateArgument
                ((RemoteSchemaInputValueDefinition -> InputValueDefinition)
-> [RemoteSchemaInputValueDefinition] -> [InputValueDefinition]
forall a b. (a -> b) -> [a] -> [b]
map RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition (FieldDefinition RemoteSchemaInputValueDefinition
-> [RemoteSchemaInputValueDefinition]
forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
G._fldArgumentsDefinition FieldDefinition RemoteSchemaInputValueDefinition
f))
                (InputValueDefinition -> SchemaT r m ())
-> (RemoteSchemaInputValueDefinition -> InputValueDefinition)
-> RemoteSchemaInputValueDefinition
-> SchemaT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition
            )
            (FieldDefinition RemoteSchemaInputValueDefinition
-> [RemoteSchemaInputValueDefinition]
forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
G._fldArgumentsDefinition FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
          (RemoteSchemaInputValueDefinition -> SchemaT r m ())
-> [RemoteSchemaInputValueDefinition] -> SchemaT r m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
            ( [InputValueDefinition] -> InputValueDefinition -> SchemaT r m ()
validateNoExtraNonNull
                ((RemoteSchemaInputValueDefinition -> InputValueDefinition)
-> [RemoteSchemaInputValueDefinition] -> [InputValueDefinition]
forall a b. (a -> b) -> [a] -> [b]
map RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition (FieldDefinition RemoteSchemaInputValueDefinition
-> [RemoteSchemaInputValueDefinition]
forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
G._fldArgumentsDefinition FieldDefinition RemoteSchemaInputValueDefinition
interfaceField))
                (InputValueDefinition -> SchemaT r m ())
-> (RemoteSchemaInputValueDefinition -> InputValueDefinition)
-> RemoteSchemaInputValueDefinition
-> SchemaT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition
            )
            (FieldDefinition RemoteSchemaInputValueDefinition
-> [RemoteSchemaInputValueDefinition]
forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
G._fldArgumentsDefinition FieldDefinition RemoteSchemaInputValueDefinition
f)
          where
            validateArgument :: [G.InputValueDefinition] -> G.InputValueDefinition -> SchemaT r m ()
            validateArgument :: [InputValueDefinition] -> InputValueDefinition -> SchemaT r m ()
validateArgument [InputValueDefinition]
objectFieldArgs InputValueDefinition
ifaceArgument =
              case Name
-> [(Name, InputValueDefinition)] -> Maybe InputValueDefinition
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (InputValueDefinition -> Name
G._ivdName InputValueDefinition
ifaceArgument) ([Name] -> [InputValueDefinition] -> [(Name, InputValueDefinition)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((InputValueDefinition -> Name) -> [InputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InputValueDefinition -> Name
G._ivdName [InputValueDefinition]
objectFieldArgs) [InputValueDefinition]
objectFieldArgs) of
                Maybe InputValueDefinition
Nothing ->
                  Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
                    (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"Interface field argument "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (InputValueDefinition -> Name
G._ivdName InputValueDefinition
ifaceArgument)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":) required, but Object field "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
f)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not provide it"
                Just InputValueDefinition
a ->
                  Bool -> SchemaT r m () -> SchemaT r m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InputValueDefinition -> GType
G._ivdType InputValueDefinition
a GType -> GType -> Bool
forall a. Eq a => a -> a -> Bool
== InputValueDefinition -> GType
G._ivdType InputValueDefinition
ifaceArgument)
                    (SchemaT r m () -> SchemaT r m ())
-> SchemaT r m () -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
                    (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"Interface field argument "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (InputValueDefinition -> Name
G._ivdName InputValueDefinition
ifaceArgument)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":) expects type "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
G.showGT (InputValueDefinition -> GType
G._ivdType InputValueDefinition
ifaceArgument)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
f)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (InputValueDefinition -> Name
G._ivdName InputValueDefinition
ifaceArgument)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":) has type "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
G.showGT (InputValueDefinition -> GType
G._ivdType InputValueDefinition
a)
            validateNoExtraNonNull :: [G.InputValueDefinition] -> G.InputValueDefinition -> SchemaT r m ()
            validateNoExtraNonNull :: [InputValueDefinition] -> InputValueDefinition -> SchemaT r m ()
validateNoExtraNonNull [InputValueDefinition]
ifaceArguments InputValueDefinition
objectFieldArg =
              case Name
-> [(Name, InputValueDefinition)] -> Maybe InputValueDefinition
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (InputValueDefinition -> Name
G._ivdName InputValueDefinition
objectFieldArg) ([Name] -> [InputValueDefinition] -> [(Name, InputValueDefinition)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((InputValueDefinition -> Name) -> [InputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InputValueDefinition -> Name
G._ivdName [InputValueDefinition]
ifaceArguments) [InputValueDefinition]
ifaceArguments) of
                Just InputValueDefinition
_ -> () -> SchemaT r m ()
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Maybe InputValueDefinition
Nothing ->
                  Bool -> SchemaT r m () -> SchemaT r m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GType -> Bool
G.isNullable (InputValueDefinition -> GType
G._ivdType InputValueDefinition
objectFieldArg))
                    (SchemaT r m () -> SchemaT r m ())
-> SchemaT r m () -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
                    (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"Object field argument "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
f)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (InputValueDefinition -> Name
G._ivdName InputValueDefinition
objectFieldArg)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":) is of required type "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
G.showGT (InputValueDefinition -> GType
G._ivdType InputValueDefinition
objectFieldArg)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but is not provided by Interface field "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
interfaceName
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote (FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
interfaceField)
    validateSubType :: G.GType -> G.GType -> Bool
    -- TODO this ignores nullability which is probably wrong, even though the GraphQL spec is ambiguous
    validateSubType :: GType -> GType -> Bool
validateSubType (G.TypeList Nullability
_ GType
x) (G.TypeList Nullability
_ GType
y) = GType -> GType -> Bool
validateSubType GType
x GType
y
    -- It is OK to "upgrade" the strictness
    validateSubType (G.TypeNamed (G.Nullability Bool
False) Name
x) (G.TypeNamed (G.Nullability Bool
True) Name
y) =
      GType -> GType -> Bool
validateSubType (Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
True) Name
x) (Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
True) Name
y)
    validateSubType (G.TypeNamed Nullability
nx Name
x) (G.TypeNamed Nullability
ny Name
y) =
      case (RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
schemaDoc Name
x, RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
schemaDoc Name
y) of
        (Just TypeDefinition [Name] RemoteSchemaInputValueDefinition
x', Just TypeDefinition [Name] RemoteSchemaInputValueDefinition
y') -> Nullability
nx Nullability -> Nullability -> Bool
forall a. Eq a => a -> a -> Bool
== Nullability
ny Bool -> Bool -> Bool
&& TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition -> Bool
forall {inputType} {t :: * -> *}.
(Eq inputType, Eq (t Name), Foldable t) =>
TypeDefinition (t Name) inputType
-> TypeDefinition (t Name) inputType -> Bool
validateSubTypeDefinition TypeDefinition [Name] RemoteSchemaInputValueDefinition
x' TypeDefinition [Name] RemoteSchemaInputValueDefinition
y'
        (Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition),
 Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
_ -> Bool
False
    validateSubType GType
_ GType
_ = Bool
False
    validateSubTypeDefinition :: TypeDefinition (t Name) inputType
-> TypeDefinition (t Name) inputType -> Bool
validateSubTypeDefinition TypeDefinition (t Name) inputType
x' TypeDefinition (t Name) inputType
y' | TypeDefinition (t Name) inputType
x' TypeDefinition (t Name) inputType
-> TypeDefinition (t Name) inputType -> Bool
forall a. Eq a => a -> a -> Bool
== TypeDefinition (t Name) inputType
y' = Bool
True
    validateSubTypeDefinition (G.TypeDefinitionObject ObjectTypeDefinition inputType
otd) (G.TypeDefinitionInterface InterfaceTypeDefinition (t Name) inputType
itd) =
      ObjectTypeDefinition inputType -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ObjectTypeDefinition inputType
otd Name -> t Name -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` InterfaceTypeDefinition (t Name) inputType -> t Name
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> possibleTypes
G._itdPossibleTypes InterfaceTypeDefinition (t Name) inputType
itd
    validateSubTypeDefinition (G.TypeDefinitionObject ObjectTypeDefinition inputType
_otd) (G.TypeDefinitionUnion UnionTypeDefinition
_utd) =
      Bool
True -- TODO write appropriate check (may require saving 'possibleTypes' in Syntax.hs)
    validateSubTypeDefinition TypeDefinition (t Name) inputType
_ TypeDefinition (t Name) inputType
_ = Bool
False

{- Note [Querying remote schema interfaces]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When querying Remote schema interfaces, we need to re-construct
the incoming query to be compliant with the upstream remote.
We need to do this because the `SelectionSet`(s) that are
inputted to this function have the fragments (if any) flattened.
(Check `flattenSelectionSet` in 'Hasura.GraphQL.Parser.Collect' module)
The `constructInterfaceSelectionSet` function makes a valid interface query by:
1. Getting the common interface fields in all the selection sets
2. Remove the common fields obtained in #1 from the selection sets
3. Construct a selection field for every common interface field
4. Construct inline fragments for non-common interface fields
   using the result of #2 for every object
5. Construct the final selection set by combining #3 and #4

Example: Suppose an interface 'Character' is defined in the upstream
and two objects 'Human' and 'Droid' implement the 'Character' Interface.

Suppose, a field 'hero' returns 'Character'.

{
   hero {
     id
     name
     ... on Droid {
       primaryFunction
     }
     ... on Human {
       homePlanet
     }
   }
}

When we parse the selection set of the `hero` field, we parse the selection set
twice: once for the `Droid` object type, which would be passed a selection set
containing the field(s) defined in the `Droid` object type and similarly once
for the 'Human' object type. The result of the interface selection set parsing
would then be the results of the parsing of the object types when passed their
corresponding flattened selection sets and the results of the parsing of the
interface fields.

After we parse the above GraphQL query, we get a selection set containing
the interface fields and the selection sets of the objects that were queried
in the GraphQL query. Since, we have the selection sets of the objects that
were being queried, we can convert them into inline fragments resembling
the original query and then query the remote schema with the newly
constructed query.
-}

-- | 'remoteSchemaInterface' returns a output parser for a given 'InterfaceTypeDefinition'.
--   Also check Note [Querying remote schema interfaces]
remoteSchemaInterface ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
  SchemaT r m (Parser 'Output n (IR.DeduplicatedSelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteSchemaInterface :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaInterface RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships defn :: InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
defn@(G.InterfaceTypeDefinition Maybe Description
description Name
name [Directive Void]
_directives [FieldDefinition RemoteSchemaInputValueDefinition]
fields [Name]
possibleTypes) =
  Name
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'remoteSchemaObject InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
defn do
    [FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subFieldParsers <- (FieldDefinition RemoteSchemaInputValueDefinition
 -> SchemaT
      r
      m
      (FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     [FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromDefinition RemoteSchemaIntrospection
schemaDoc Name
name RemoteSchemaRelationships
remoteRelationships) [FieldDefinition RemoteSchemaInputValueDefinition]
fields
    [Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
objs <- (Name
 -> SchemaT
      r
      m
      (Parser
         'Output
         n
         (Name,
          ObjectSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [Name]
-> SchemaT
     r
     m
     [Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> (Name
    -> SchemaT
         r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Name
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> (Name
    -> SchemaT
         r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Name
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
getObjectParser RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject) [Name]
possibleTypes
    -- In the Draft GraphQL spec (> June 2018), interfaces can themselves
    -- implement superinterfaces.  In the future, we may need to support this
    -- here.
    Bool -> SchemaT r m () -> SchemaT r m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subFieldParsers)
      (SchemaT r m () -> SchemaT r m ())
-> SchemaT r m () -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
      (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"List of fields cannot be empty for interface "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
    -- TODO: another way to obtain 'possibleTypes' is to lookup all the object
    -- types in the schema document that claim to implement this interface.  We
    -- should have a check that expresses that that collection of objects is equal
    -- to 'possibleTypes'.
    Name
typename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter SchemaT r m MkTypename -> (MkTypename -> Name) -> SchemaT r m Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MkTypename
mkTypename -> MkTypename -> Name -> Name
runMkTypename MkTypename
mkTypename Name
name
    let allFields :: [FieldParser
   MetadataObjId
   n
   (Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
allFields = (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> [FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall a b. (a -> b) -> [a] -> [b]
map ((GraphQLField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     MetadataObjId
     n
     (Field
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Field
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. GraphQLField r var -> Field r var
IR.FieldGraphQL) [FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
subFieldParsers
    Parser
  MetadataObjId
  'Output
  n
  (DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Parser
   MetadataObjId
   'Output
   n
   (DeduplicatedSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (Parser
         MetadataObjId
         'Output
         n
         (DeduplicatedSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> Parser
     MetadataObjId
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [FieldParser
      MetadataObjId
      n
      (Field
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [Parser
      'Output
      n
      (Name,
       ObjectSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Parser
     MetadataObjId
     'Output
     n
     [(Name,
       ObjectSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (n :: * -> *) (t :: * -> *) origin a b.
(MonadParse n, Traversable t) =>
Name
-> Maybe Description
-> [FieldParser origin n a]
-> t (Parser origin 'Output n b)
-> Parser origin 'Output n (t b)
P.selectionSetInterface Name
typename Maybe Description
description [FieldParser
   MetadataObjId
   n
   (Field
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
allFields [Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
objs
      Parser
  MetadataObjId
  'Output
  n
  [(Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> ([(Name,
      ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
    -> DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashSet Name
-> [(Name,
     ObjectSelectionSet
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var.
HashSet Name
-> [(Name, ObjectSelectionSet r var)]
-> DeduplicatedSelectionSet r var
IR.mkInterfaceSelectionSet ([Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ (FieldDefinition RemoteSchemaInputValueDefinition -> Name)
-> [FieldDefinition RemoteSchemaInputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName [FieldDefinition RemoteSchemaInputValueDefinition]
fields)
  where
    getObject :: G.Name -> SchemaT r m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
    getObject :: Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject Name
objectName =
      Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
schemaDoc Name
objectName)
        (SchemaT
   r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ case RemoteSchemaIntrospection
-> Name
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupInterface RemoteSchemaIntrospection
schemaDoc Name
objectName of
          Maybe
  (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
Nothing ->
            Code
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
              (Text
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"Could not find type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
objectName
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which is defined as a member type of Interface "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
          Just InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
_ ->
            Code
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
              (Text
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"Interface type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" can only include object types. It cannot include "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
objectName

-- | 'remoteSchemaUnion' returns a output parser for a given 'UnionTypeDefinition'.
remoteSchemaUnion ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  G.UnionTypeDefinition ->
  SchemaT r m (Parser 'Output n (IR.DeduplicatedSelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteSchemaUnion :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> UnionTypeDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaUnion RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships defn :: UnionTypeDefinition
defn@(G.UnionTypeDefinition Maybe Description
description Name
name [Directive Void]
_directives [Name]
objectNames) =
  Name
-> UnionTypeDefinition
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'remoteSchemaObject UnionTypeDefinition
defn do
    [Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
objs <- (Name
 -> SchemaT
      r
      m
      (Parser
         'Output
         n
         (Name,
          ObjectSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> [Name]
-> SchemaT
     r
     m
     [Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> (Name
    -> SchemaT
         r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Name
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> (Name
    -> SchemaT
         r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Name
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
getObjectParser RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject) [Name]
objectNames
    Bool -> SchemaT r m () -> SchemaT r m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
objs)
      (SchemaT r m () -> SchemaT r m ())
-> SchemaT r m () -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> SchemaT r m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
      (Text -> SchemaT r m ()) -> Text -> SchemaT r m ()
forall a b. (a -> b) -> a -> b
$ Text
"List of member types cannot be empty for union type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
    Name
typename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter SchemaT r m MkTypename -> (MkTypename -> Name) -> SchemaT r m Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \MkTypename
mkTypename -> MkTypename -> Name -> Name
runMkTypename MkTypename
mkTypename Name
name
    Parser
  MetadataObjId
  'Output
  n
  (DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser
   MetadataObjId
   'Output
   n
   (DeduplicatedSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (Parser
         MetadataObjId
         'Output
         n
         (DeduplicatedSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> Parser
     MetadataObjId
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [Parser
      'Output
      n
      (Name,
       ObjectSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> Parser
     MetadataObjId
     'Output
     n
     [(Name,
       ObjectSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
forall (n :: * -> *) (t :: * -> *) origin b.
(MonadParse n, Traversable t) =>
Name
-> Maybe Description
-> t (Parser origin 'Output n b)
-> Parser origin 'Output n (t b)
P.selectionSetUnion Name
typename Maybe Description
description [Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
objs Parser
  MetadataObjId
  'Output
  n
  [(Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> ([(Name,
      ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
    -> DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Name,
  ObjectSelectionSet
    (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> DeduplicatedSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var.
[(Name, ObjectSelectionSet r var)]
-> DeduplicatedSelectionSet r var
IR.mkUnionSelectionSet
  where
    getObject :: G.Name -> SchemaT r m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
    getObject :: Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject Name
objectName =
      Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
schemaDoc Name
objectName)
        (SchemaT
   r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ case RemoteSchemaIntrospection
-> Name
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupInterface RemoteSchemaIntrospection
schemaDoc Name
objectName of
          Maybe
  (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
Nothing ->
            Code
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
              (Text
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"Could not find type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
objectName
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", which is defined as a member type of Union "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
          Just InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
_ ->
            Code
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
              (Text
 -> SchemaT
      r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Text
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"Union type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
name
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" can only include object types. It cannot include "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
squote Name
objectName

remoteFieldFromDefinition ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  G.Name ->
  RemoteSchemaRelationships ->
  G.FieldDefinition RemoteSchemaInputValueDefinition ->
  SchemaT r m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromDefinition :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> Name
-> RemoteSchemaRelationships
-> FieldDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromDefinition RemoteSchemaIntrospection
schemaDoc Name
parentTypeName RemoteSchemaRelationships
remoteRelationships (G.FieldDefinition Maybe Description
description Name
name [RemoteSchemaInputValueDefinition]
argsDefinition GType
gType [Directive Void]
_) = do
  GType
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
convertType GType
gType
  where
    addNullableList :: FieldParser n a -> FieldParser n a
    addNullableList :: forall a. FieldParser n a -> FieldParser n a
addNullableList (P.FieldParser (Definition Name
name' Maybe Description
desc Maybe MetadataObjId
origin [Directive Void]
dLst (FieldInfo [Definition MetadataObjId (InputFieldInfo MetadataObjId)]
args Type MetadataObjId k
typ)) Field NoFragments Variable -> n a
parser) =
      Definition MetadataObjId (FieldInfo MetadataObjId)
-> (Field NoFragments Variable -> n a)
-> FieldParser MetadataObjId n a
forall origin (m :: * -> *) a.
Definition origin (FieldInfo origin)
-> (Field NoFragments Variable -> m a) -> FieldParser origin m a
P.FieldParser (Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> FieldInfo MetadataObjId
-> Definition MetadataObjId (FieldInfo MetadataObjId)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
Definition Name
name' Maybe Description
desc Maybe MetadataObjId
origin [Directive Void]
dLst ([Definition MetadataObjId (InputFieldInfo MetadataObjId)]
-> Type MetadataObjId k -> FieldInfo MetadataObjId
forall origin (k :: Kind).
('Output <: k) =>
[Definition origin (InputFieldInfo origin)]
-> Type origin k -> FieldInfo origin
FieldInfo [Definition MetadataObjId (InputFieldInfo MetadataObjId)]
args (Nullability -> Type MetadataObjId k -> Type MetadataObjId k
forall origin (k :: Kind).
Nullability -> Type origin k -> Type origin k
TList Nullability
Nullable Type MetadataObjId k
typ))) Field NoFragments Variable -> n a
parser

    addNonNullableList :: FieldParser n a -> FieldParser n a
    addNonNullableList :: forall a. FieldParser n a -> FieldParser n a
addNonNullableList (P.FieldParser (Definition Name
name' Maybe Description
desc Maybe MetadataObjId
origin [Directive Void]
dLst (FieldInfo [Definition MetadataObjId (InputFieldInfo MetadataObjId)]
args Type MetadataObjId k
typ)) Field NoFragments Variable -> n a
parser) =
      Definition MetadataObjId (FieldInfo MetadataObjId)
-> (Field NoFragments Variable -> n a)
-> FieldParser MetadataObjId n a
forall origin (m :: * -> *) a.
Definition origin (FieldInfo origin)
-> (Field NoFragments Variable -> m a) -> FieldParser origin m a
P.FieldParser (Name
-> Maybe Description
-> Maybe MetadataObjId
-> [Directive Void]
-> FieldInfo MetadataObjId
-> Definition MetadataObjId (FieldInfo MetadataObjId)
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
Definition Name
name' Maybe Description
desc Maybe MetadataObjId
origin [Directive Void]
dLst ([Definition MetadataObjId (InputFieldInfo MetadataObjId)]
-> Type MetadataObjId k -> FieldInfo MetadataObjId
forall origin (k :: Kind).
('Output <: k) =>
[Definition origin (InputFieldInfo origin)]
-> Type origin k -> FieldInfo origin
FieldInfo [Definition MetadataObjId (InputFieldInfo MetadataObjId)]
args (Nullability -> Type MetadataObjId k -> Type MetadataObjId k
forall origin (k :: Kind).
Nullability -> Type origin k -> Type origin k
TList Nullability
NonNullable Type MetadataObjId k
typ))) Field NoFragments Variable -> n a
parser

    -- TODO add directives, deprecation
    convertType ::
      G.GType ->
      SchemaT r m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
    convertType :: GType
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
convertType = \case
      G.TypeNamed (G.Nullability Bool
True) Name
fieldTypeName ->
        FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (m :: * -> *) origin a.
FieldParser origin m a -> FieldParser origin m a
P.nullableField (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> Name
-> [RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> Name
-> [RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromName RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships Name
parentTypeName Name
name Maybe Description
description Name
fieldTypeName [RemoteSchemaInputValueDefinition]
argsDefinition
      G.TypeList (G.Nullability Bool
True) GType
gType' ->
        FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a. FieldParser n a -> FieldParser n a
addNullableList (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GType
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
convertType GType
gType'
      G.TypeNamed (G.Nullability Bool
False) Name
fieldTypeName -> do
        FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (m :: * -> *) origin a.
FieldParser origin m a -> FieldParser origin m a
P.nonNullableField (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> Name
-> [RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> Name
-> [RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromName RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships Name
parentTypeName Name
name Maybe Description
description Name
fieldTypeName [RemoteSchemaInputValueDefinition]
argsDefinition
      G.TypeList (G.Nullability Bool
False) GType
gType' ->
        FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a. FieldParser n a -> FieldParser n a
addNonNullableList (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GType
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
convertType GType
gType'

-- | 'remoteFieldFromName' accepts a GraphQL name and searches for its definition
--   in the 'RemoteSchemaIntrospection'.
remoteFieldFromName ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  G.Name ->
  G.Name ->
  Maybe G.Description ->
  G.Name ->
  G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
  SchemaT r m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromName :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> Name
-> [RemoteSchemaInputValueDefinition]
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteFieldFromName RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships Name
parentTypeName Name
fieldName Maybe Description
description Name
fieldTypeName [RemoteSchemaInputValueDefinition]
argsDefns =
  case RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
sdoc Name
fieldTypeName of
    Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
Nothing -> Code
-> Text
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError (Text
 -> SchemaT
      r
      m
      (FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> Text
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Text
"Could not find type with name " Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
fieldTypeName
    Just TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDef -> RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> [RemoteSchemaInputValueDefinition]
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> [RemoteSchemaInputValueDefinition]
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteField RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships Name
parentTypeName Name
fieldName Maybe Description
description [RemoteSchemaInputValueDefinition]
argsDefns TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDef

-- | 'remoteField' accepts a 'G.TypeDefinition' and will returns a 'FieldParser' for it.
--   Note that the 'G.TypeDefinition' should be of the GraphQL 'Output' kind, when an
--   GraphQL 'Input' kind is provided, then error will be thrown.
remoteField ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  G.Name ->
  G.Name ->
  Maybe G.Description ->
  G.ArgumentsDefinition RemoteSchemaInputValueDefinition ->
  G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition ->
  SchemaT r m (FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
remoteField :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> [RemoteSchemaInputValueDefinition]
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteField RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships Name
parentTypeName Name
fieldName Maybe Description
description [RemoteSchemaInputValueDefinition]
argsDefn TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDefn = do
  -- TODO add directives
  InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser <- [RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
[RemoteSchemaInputValueDefinition]
-> RemoteSchemaIntrospection
-> SchemaT
     r
     m
     (InputFieldsParser
        n (Altered, HashMap Name (Value RemoteSchemaVariable)))
argumentsParser [RemoteSchemaInputValueDefinition]
argsDefn RemoteSchemaIntrospection
sdoc
  MkTypename
customizeTypename <- (r -> MkTypename) -> SchemaT r m MkTypename
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> MkTypename
forall a t. Has a t => t -> a
getter
  CustomizeRemoteFieldName
customizeFieldName <- (r -> CustomizeRemoteFieldName)
-> SchemaT r m CustomizeRemoteFieldName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> CustomizeRemoteFieldName
forall a t. Has a t => t -> a
getter
  let customizedFieldName :: Name
customizedFieldName = CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName CustomizeRemoteFieldName
customizeFieldName Name
parentTypeName Name
fieldName
  case TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDefn of
    G.TypeDefinitionObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
objTypeDefn -> do
      Parser
  'Output
  n
  (ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteSchemaObjFields <- RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaObject RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships ObjectTypeDefinition RemoteSchemaInputValueDefinition
objTypeDefn
      -- converting [Field NoFragments Name] to (SelectionSet NoFragments G.Name)
      let remoteSchemaObjSelSet :: Parser
  MetadataObjId
  'Output
  n
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteSchemaObjSelSet = ObjectSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. ObjectSelectionSet r var -> SelectionSet r var
IR.SelectionSetObject (ObjectSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     'Output
     n
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Output
  n
  (ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteSchemaObjFields
      Parser
  MetadataObjId
  'Output
  n
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        MetadataObjId
        'Output
        n
        (SelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Parser
  MetadataObjId
  'Output
  n
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteSchemaObjSelSet SchemaT
  r
  m
  (Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> (Parser
      MetadataObjId
      'Output
      n
      (SelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser
    G.TypeDefinitionScalar ScalarTypeDefinition
scalarTypeDefn ->
      FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithoutSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser (Parser 'Both n ()
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ Parser MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
 -> Parser 'Both n ())
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n ()
forall a b. (a -> b) -> a -> b
$ MkTypename
-> ScalarTypeDefinition
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall (n :: * -> *).
MonadParse n =>
MkTypename
-> ScalarTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldScalarParser MkTypename
customizeTypename ScalarTypeDefinition
scalarTypeDefn
    G.TypeDefinitionEnum EnumTypeDefinition
enumTypeDefn ->
      FieldParser
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithoutSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser (Parser 'Both n ()
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b. (a -> b) -> a -> b
$ Parser MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
 -> Parser 'Both n ())
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
-> Parser 'Both n ()
forall a b. (a -> b) -> a -> b
$ MkTypename
-> EnumTypeDefinition
-> Parser
     MetadataObjId 'Both n (Altered, Value RemoteSchemaVariable)
forall (n :: * -> *).
MonadParse n =>
MkTypename
-> EnumTypeDefinition
-> Parser 'Both n (Altered, Value RemoteSchemaVariable)
remoteFieldEnumParser MkTypename
customizeTypename EnumTypeDefinition
enumTypeDefn
    G.TypeDefinitionInterface InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
ifaceTypeDefn ->
      RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaInterface RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
ifaceTypeDefn
        SchemaT
  r
  m
  (Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> (Parser
      'Output
      n
      (DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser (Parser
   MetadataObjId
   'Output
   n
   (SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> (Parser
      'Output
      n
      (DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> Parser
         MetadataObjId
         'Output
         n
         (SelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeduplicatedSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Output n a
-> Parser MetadataObjId 'Output n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. DeduplicatedSelectionSet r var -> SelectionSet r var
IR.SelectionSetInterface)
    G.TypeDefinitionUnion UnionTypeDefinition
unionTypeDefn ->
      RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> UnionTypeDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> UnionTypeDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (DeduplicatedSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaUnion RemoteSchemaIntrospection
sdoc RemoteSchemaRelationships
remoteRelationships UnionTypeDefinition
unionTypeDefn
        SchemaT
  r
  m
  (Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> (Parser
      'Output
      n
      (DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> FieldParser
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser (Parser
   MetadataObjId
   'Output
   n
   (SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> (Parser
      'Output
      n
      (DeduplicatedSelectionSet
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> Parser
         MetadataObjId
         'Output
         n
         (SelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeduplicatedSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> SelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     'Output
     n
     (DeduplicatedSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Output n a
-> Parser MetadataObjId 'Output n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeduplicatedSelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. DeduplicatedSelectionSet r var -> SelectionSet r var
IR.SelectionSetUnion)
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Code
-> Text
-> SchemaT
     r
     m
     (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError Text
"expected output type, but got input type"
  where
    mkField ::
      Maybe G.Name ->
      G.Name ->
      HashMap G.Name (G.Value RemoteSchemaVariable) ->
      IR.SelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable ->
      IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable
    mkField :: Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
mkField Maybe Name
alias Name
customizedFieldName HashMap Name (Value RemoteSchemaVariable)
args SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet =
      -- If there's no alias then use customizedFieldName as the alias so the
      -- correctly customized field name will be returned from the remote server.
      let alias' :: Maybe Name
alias' = Maybe Name
alias Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Name
customizedFieldName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
fieldName) Maybe () -> Maybe Name -> Maybe Name
forall a b. Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
customizedFieldName
       in Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> [Directive RemoteSchemaVariable]
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
IR.mkGraphQLField Maybe Name
alias' Name
fieldName HashMap Name (Value RemoteSchemaVariable)
args [Directive RemoteSchemaVariable]
forall a. Monoid a => a
mempty SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet

    mkFieldParserWithoutSelectionSet ::
      G.Name ->
      InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
      Parser 'Both n () ->
      FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)
    mkFieldParserWithoutSelectionSet :: Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithoutSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser Parser 'Both n ()
outputParser =
      Name
-> Maybe Description
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser 'Both n ()
-> FieldParser
     MetadataObjId
     n
     (Maybe Name, HashMap Name (Value Variable),
      (Altered, HashMap Name (Value RemoteSchemaVariable)))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Both m b
-> FieldParser
     origin m (Maybe Name, HashMap Name (Value Variable), a)
P.rawSelection Name
customizedFieldName Maybe Description
description InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser Parser 'Both n ()
outputParser
        FieldParser
  MetadataObjId
  n
  (Maybe Name, HashMap Name (Value Variable),
   (Altered, HashMap Name (Value RemoteSchemaVariable)))
-> ((Maybe Name, HashMap Name (Value Variable),
     (Altered, HashMap Name (Value RemoteSchemaVariable)))
    -> GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe Name
alias, HashMap Name (Value Variable)
_, (Altered
_, HashMap Name (Value RemoteSchemaVariable)
args)) -> Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
mkField Maybe Name
alias Name
customizedFieldName HashMap Name (Value RemoteSchemaVariable)
args SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. SelectionSet r var
IR.SelectionSetNone

    mkFieldParserWithSelectionSet ::
      G.Name ->
      InputFieldsParser n (Altered, HashMap G.Name (G.Value RemoteSchemaVariable)) ->
      Parser 'Output n (IR.SelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable) ->
      FieldParser n (IR.GraphQLField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)
    mkFieldParserWithSelectionSet :: Name
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
mkFieldParserWithSelectionSet Name
customizedFieldName InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser Parser
  MetadataObjId
  'Output
  n
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
outputParser =
      Name
-> Maybe Description
-> InputFieldsParser
     n (Altered, HashMap Name (Value RemoteSchemaVariable))
-> Parser
     MetadataObjId
     'Output
     n
     (SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     MetadataObjId
     n
     (Maybe Name, HashMap Name (Value Variable),
      (Altered, HashMap Name (Value RemoteSchemaVariable)),
      SelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser
     origin m (Maybe Name, HashMap Name (Value Variable), a, b)
P.rawSubselection Name
customizedFieldName Maybe Description
description InputFieldsParser
  n (Altered, HashMap Name (Value RemoteSchemaVariable))
argsParser Parser
  MetadataObjId
  'Output
  n
  (SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
outputParser
        FieldParser
  MetadataObjId
  n
  (Maybe Name, HashMap Name (Value Variable),
   (Altered, HashMap Name (Value RemoteSchemaVariable)),
   SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ((Maybe Name, HashMap Name (Value Variable),
     (Altered, HashMap Name (Value RemoteSchemaVariable)),
     SelectionSet
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe Name
alias, HashMap Name (Value Variable)
_, (Altered
_, HashMap Name (Value RemoteSchemaVariable)
args), SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet) -> Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
mkField Maybe Name
alias Name
customizedFieldName HashMap Name (Value RemoteSchemaVariable)
args SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet

-- | helper function to get a parser of an object with it's name
--   This function is called from 'remoteSchemaInterface' and
--   'remoteSchemaObject' functions. Both of these have a slightly
--   different implementation of 'getObject', which is the
--   reason 'getObject' is an argument to this function
getObjectParser ::
  forall r m n.
  (MonadBuildRemoteSchema r m n) =>
  RemoteSchemaIntrospection ->
  RemoteSchemaRelationships ->
  (G.Name -> SchemaT r m (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)) ->
  G.Name ->
  SchemaT r m (Parser 'Output n (G.Name, IR.ObjectSelectionSet (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))
getObjectParser :: forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> (Name
    -> SchemaT
         r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Name
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
getObjectParser RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject Name
objName = do
  Parser
  'Output
  n
  (ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
obj <- RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteSchemaObject RemoteSchemaIntrospection
schemaDoc RemoteSchemaRelationships
remoteRelationships (ObjectTypeDefinition RemoteSchemaInputValueDefinition
 -> SchemaT
      r
      m
      (Parser
         'Output
         n
         (ObjectSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> SchemaT
     r m (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
getObject Name
objName
  Parser
  'Output
  n
  (Name,
   ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a. a -> SchemaT r m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser
   'Output
   n
   (Name,
    ObjectSelectionSet
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> SchemaT
      r
      m
      (Parser
         'Output
         n
         (Name,
          ObjectSelectionSet
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> Parser
     'Output
     n
     (Name,
      ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> SchemaT
     r
     m
     (Parser
        'Output
        n
        (Name,
         ObjectSelectionSet
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$ (Name
objName,) (ObjectSelectionSet
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> (Name,
     ObjectSelectionSet
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> Parser
     'Output
     n
     (ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> Parser
     'Output
     n
     (Name,
      ObjectSelectionSet
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser
  'Output
  n
  (ObjectSelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
obj

customizeRemoteNamespace ::
  forall n.
  (MonadParse n) =>
  RemoteSchemaInfo ->
  G.Name ->
  [P.FieldParser n (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable)] ->
  [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))]
customizeRemoteNamespace :: forall (n :: * -> *).
MonadParse n =>
RemoteSchemaInfo
-> Name
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
customizeRemoteNamespace remoteSchemaInfo :: RemoteSchemaInfo
remoteSchemaInfo@RemoteSchemaInfo {RemoteSchemaCustomizer
ValidatedRemoteSchemaDef
rsDef :: RemoteSchemaInfo -> ValidatedRemoteSchemaDef
rsCustomizer :: RemoteSchemaInfo -> RemoteSchemaCustomizer
rsDef :: ValidatedRemoteSchemaDef
rsCustomizer :: RemoteSchemaCustomizer
..} Name
rootTypeName [FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
fieldParsers =
  Maybe Name
-> (Name
    -> ParsedSelection
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
    -> RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> MkTypename
-> [FieldParser
      n
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
forall (n :: * -> *) a.
MonadParse n =>
Maybe Name
-> (Name -> ParsedSelection a -> a)
-> MkTypename
-> [FieldParser n a]
-> [FieldParser n (NamespacedField a)]
customizeNamespace (RemoteSchemaCustomizer -> Maybe Name
_rscNamespaceFieldName RemoteSchemaCustomizer
rsCustomizer) Name
-> ParsedSelection
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fromParsedSelection MkTypename
mkNamespaceTypename [FieldParser
   n
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)]
fieldParsers
  where
    fromParsedSelection :: Name
-> ParsedSelection
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fromParsedSelection Name
alias =
      (Name
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> ParsedSelection
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a. (Name -> a) -> ParsedSelection a -> a
handleTypename
        ((Name
  -> RemoteSchemaRootField
       (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> ParsedSelection
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
    -> Name
    -> RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ParsedSelection
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> Name
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. a -> b -> a
const
        (RemoteSchemaRootField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> ParsedSelection
      (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ParsedSelection
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$
        -- In P.selectionSet we lose the resultCustomizer from __typename fields so we need to put it back
        let resultCustomizer :: ResultCustomizer
resultCustomizer = Name -> ResultCustomizer -> ResultCustomizer
modifyFieldByName Name
alias (ResultCustomizer -> ResultCustomizer)
-> ResultCustomizer -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ HashMap Name Name -> ResultCustomizer
customizeTypeNameString (HashMap Name Name -> ResultCustomizer)
-> HashMap Name Name -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeTypeName RemoteSchemaCustomizer
rsCustomizer
         in RemoteSchemaInfo
-> ResultCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var.
RemoteSchemaInfo
-> ResultCustomizer
-> GraphQLField r var
-> RemoteSchemaRootField r var
IR.RemoteSchemaRootField RemoteSchemaInfo
remoteSchemaInfo ResultCustomizer
resultCustomizer (GraphQLField
   (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
 -> RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall a b. (a -> b) -> a -> b
$ Maybe Name
-> Name
-> HashMap Name (Value RemoteSchemaVariable)
-> [Directive RemoteSchemaVariable]
-> SelectionSet
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall var r.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet r var
-> GraphQLField r var
IR.mkGraphQLField (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
alias) Name
GName.___typename HashMap Name (Value RemoteSchemaVariable)
forall a. Monoid a => a
mempty [Directive RemoteSchemaVariable]
forall a. Monoid a => a
mempty SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
forall r var. SelectionSet r var
IR.SelectionSetNone
    mkNamespaceTypename :: MkTypename
mkNamespaceTypename = (Name -> Name) -> MkTypename
MkTypename ((Name -> Name) -> MkTypename) -> (Name -> Name) -> MkTypename
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
forall a b. a -> b -> a
const (Name -> Name -> Name) -> Name -> Name -> Name
forall a b. (a -> b) -> a -> b
$ MkTypename -> Name -> Name
runMkTypename (RemoteSchemaCustomizer -> MkTypename
remoteSchemaCustomizeTypeName RemoteSchemaCustomizer
rsCustomizer) Name
rootTypeName

withRemoteSchemaCustomization ::
  forall m r a.
  (MonadReader r m, Has MkTypename r, Has CustomizeRemoteFieldName r) =>
  RemoteSchemaCustomizer ->
  m a ->
  m a
withRemoteSchemaCustomization :: forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r,
 Has CustomizeRemoteFieldName r) =>
RemoteSchemaCustomizer -> m a -> m a
withRemoteSchemaCustomization RemoteSchemaCustomizer
remoteSchemaCustomizer =
  MkTypename -> m a -> m a
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r) =>
MkTypename -> m a -> m a
withTypenameCustomization (RemoteSchemaCustomizer -> MkTypename
remoteSchemaCustomizeTypeName RemoteSchemaCustomizer
remoteSchemaCustomizer)
    (m a -> m a) -> (m a -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomizeRemoteFieldName -> m a -> m a
forall (m :: * -> *) r a.
(MonadReader r m, Has CustomizeRemoteFieldName r) =>
CustomizeRemoteFieldName -> m a -> m a
withRemoteFieldNameCustomization (RemoteSchemaCustomizer -> CustomizeRemoteFieldName
remoteSchemaCustomizeFieldName RemoteSchemaCustomizer
remoteSchemaCustomizer)