-- | Tools to analyze the structure of a GraphQL request.
module Hasura.GraphQL.Analyse
  ( -- * Query structure
    Structure (..),
    FieldInfo (..),
    InputFieldInfo (..),
    VariableInfo (..),
    ScalarInfo (..),
    EnumInfo (..),
    ObjectInfo (..),
    InputObjectInfo (..),

    -- * Analysis
    diagnoseGraphQLQuery,
    analyzeGraphQLQuery,
  )
where

import Control.Monad.Circular
import Control.Monad.Writer (Writer, runWriter)
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.Sequence ((|>))
import Data.Text qualified as T
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Name qualified as Name
import Hasura.Prelude
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- GraphQL query structure

-- | Overall structure of a given query. We extract the tree of fields in the
-- output, and the graph of input variables.
data Structure = Structure
  { Structure -> HashMap Name FieldInfo
_stSelection :: HashMap G.Name FieldInfo,
    Structure -> HashMap Name VariableInfo
_stVariables :: HashMap G.Name VariableInfo
  }

-- | Information about the type of an output field; whether the base type is an
-- object or a scalar, we store the correspoding 'GType' to keep track of the
-- modifiers applied to it (list or non-nullability).
data FieldInfo
  = FieldObjectInfo G.GType ObjectInfo
  | FieldScalarInfo G.GType ScalarInfo
  | FieldEnumInfo G.GType EnumInfo

data ScalarInfo = ScalarInfo
  { ScalarInfo -> ScalarTypeDefinition
_siTypeDefinition :: G.ScalarTypeDefinition
  }

data EnumInfo = EnumInfo
  { EnumInfo -> EnumTypeDefinition
_eiTypeDefinition :: G.EnumTypeDefinition
  }

data ObjectInfo = ObjectInfo
  { ObjectInfo -> ObjectTypeDefinition InputValueDefinition
_oiTypeDefinition :: G.ObjectTypeDefinition G.InputValueDefinition,
    ObjectInfo -> HashMap Name FieldInfo
_oiSelection :: HashMap G.Name FieldInfo
  }

-- | Information about a single variable of the query.
data VariableInfo = VariableInfo
  { VariableInfo -> GType
_viType :: G.GType,
    VariableInfo -> InputFieldInfo
_viTypeInfo :: InputFieldInfo,
    VariableInfo -> Maybe (Value Void)
_viDefaultValue :: Maybe (G.Value Void)
  }

-- | Information about the type of an input field; whether the base type is an
-- object or a scalar, we store the correspoding 'GType' to keep track of the
-- modifiers applied to it (list or non-nullability).
data InputFieldInfo
  = InputFieldScalarInfo ScalarInfo
  | InputFieldEnumInfo EnumInfo
  | InputFieldObjectInfo InputObjectInfo

data InputObjectInfo = InputObjectInfo
  { InputObjectInfo -> InputObjectTypeDefinition InputValueDefinition
_ioiTypeDefinition :: G.InputObjectTypeDefinition G.InputValueDefinition,
    -- | lazy for knot-tying, as we build a graph
    InputObjectInfo -> HashMap Name (GType, InputFieldInfo)
_ioiFields :: ~(HashMap G.Name (G.GType, InputFieldInfo))
  }

--------------------------------------------------------------------------------
-- Analysis

-- | Given the schema's definition, and a query, validate that the query is
-- consistent. We do this by running the analysis, but discarding the result: we
-- do not care about the structure, only about the validity of the query.
--
-- Returns 'Nothing' if the query is valid, or a list of messages otherwise.
diagnoseGraphQLQuery ::
  G.SchemaIntrospection ->
  G.TypedOperationDefinition G.NoFragments G.Name ->
  Maybe [Text]
diagnoseGraphQLQuery :: SchemaIntrospection
-> TypedOperationDefinition NoFragments Name -> Maybe [Text]
diagnoseGraphQLQuery SchemaIntrospection
schema TypedOperationDefinition NoFragments Name
query =
  let (Maybe Structure
_structure, [Text]
errors) = SchemaIntrospection
-> TypedOperationDefinition NoFragments Name
-> (Maybe Structure, [Text])
analyzeGraphQLQuery SchemaIntrospection
schema TypedOperationDefinition NoFragments Name
query
   in if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
errors
        then Maybe [Text]
forall a. Maybe a
Nothing
        else [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
errors

-- | Given the schema's definition, and a query, run the analysis.
--
-- We process all possible fields, and return a partially filled structure if
-- necessary. Given the following query:
--
--   > query {
--   >   foo {
--   >     bar
--   >   }
--   >   does_not_exist {
--   >     ghsdflgh
--   >   }
--   > }
--
-- We would return a structure containing:
--
--   > foo: {
--   >   bar: {
--   >   }
--   > }
--
-- AND an error about "does_not_exist" not existing.
--
-- In some cases, however, we might not be able to produce a structure at all,
-- in which case we return 'Nothing'. This either indicates that something was
-- fundamentally wrong with the structure of the query (such as not finding an
-- object at the top level), or that a recoverable error was not caught properly
-- (see 'withCatchAndRecord').
analyzeGraphQLQuery ::
  G.SchemaIntrospection ->
  G.TypedOperationDefinition G.NoFragments G.Name ->
  (Maybe Structure, [Text])
analyzeGraphQLQuery :: SchemaIntrospection
-> TypedOperationDefinition NoFragments Name
-> (Maybe Structure, [Text])
analyzeGraphQLQuery SchemaIntrospection
schema G.TypedOperationDefinition {[Directive Name]
SelectionSet NoFragments Name
[VariableDefinition]
Maybe Name
OperationType
_todType :: OperationType
_todName :: Maybe Name
_todVariableDefinitions :: [VariableDefinition]
_todDirectives :: [Directive Name]
_todSelectionSet :: SelectionSet NoFragments Name
_todType :: forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> OperationType
_todName :: forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> Maybe Name
_todVariableDefinitions :: forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> [VariableDefinition]
_todDirectives :: forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> [Directive var]
_todSelectionSet :: forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> SelectionSet frag var
..} = SchemaIntrospection
-> Analysis Structure -> (Maybe Structure, [Text])
forall a. SchemaIntrospection -> Analysis a -> (Maybe a, [Text])
runAnalysis SchemaIntrospection
schema do
  -- analyze the selection
  Maybe (HashMap Name FieldInfo)
selection <- Analysis (HashMap Name FieldInfo)
-> Analysis (Maybe (HashMap Name FieldInfo))
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadWriter [AnalysisError] m, MonadError AnalysisError m) =>
m a -> m (Maybe a)
withCatchAndRecord do
    let rootTypeName :: Name
rootTypeName = case OperationType
_todType of
          OperationType
G.OperationTypeQuery -> Name
queryRootName
          OperationType
G.OperationTypeMutation -> Name
mutationRootName
          OperationType
G.OperationTypeSubscription -> Name
subscriptionRootName
    TypeDefinition [Name] InputValueDefinition
rootTypeDefinition <-
      Name
-> Analysis (Maybe (TypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *).
MonadReader (Path, SchemaIntrospection) m =>
Name -> m (Maybe (TypeDefinition [Name] InputValueDefinition))
lookupType Name
rootTypeName
        Analysis (Maybe (TypeDefinition [Name] InputValueDefinition))
-> Analysis (TypeDefinition [Name] InputValueDefinition)
-> Analysis (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`onNothingM` Diagnosis -> Analysis (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Name -> Diagnosis
TypeNotFound Name
rootTypeName)
    case TypeDefinition [Name] InputValueDefinition
rootTypeDefinition of
      G.TypeDefinitionObject ObjectTypeDefinition InputValueDefinition
otd ->
        ObjectTypeDefinition InputValueDefinition
-> SelectionSet NoFragments Name
-> Analysis (HashMap Name FieldInfo)
analyzeObjectSelectionSet ObjectTypeDefinition InputValueDefinition
otd SelectionSet NoFragments Name
_todSelectionSet
      TypeDefinition [Name] InputValueDefinition
_ ->
        Diagnosis -> Analysis (HashMap Name FieldInfo)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis Diagnosis
RootTypeNotAnObject
  -- analyze the variables
  HashMap Name VariableInfo
variables <- [VariableDefinition] -> Analysis (HashMap Name VariableInfo)
analyzeVariables [VariableDefinition]
_todVariableDefinitions
  Structure -> Analysis Structure
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Structure -> Analysis Structure)
-> Structure -> Analysis Structure
forall a b. (a -> b) -> a -> b
$ HashMap Name FieldInfo -> HashMap Name VariableInfo -> Structure
Structure
      (HashMap Name FieldInfo
-> Maybe (HashMap Name FieldInfo) -> HashMap Name FieldInfo
forall a. a -> Maybe a -> a
fromMaybe HashMap Name FieldInfo
forall a. Monoid a => a
mempty Maybe (HashMap Name FieldInfo)
selection)
      HashMap Name VariableInfo
variables

--------------------------------------------------------------------------------
-- Selection analysis

-- | Analyze the fields of an object selection set against its definition, and
-- emit the corresponding 'Selection'. We ignore the fields that fail, and we
-- continue accumulating the others.
analyzeObjectSelectionSet ::
  G.ObjectTypeDefinition G.InputValueDefinition ->
  G.SelectionSet G.NoFragments G.Name ->
  Analysis (HashMap G.Name FieldInfo)
analyzeObjectSelectionSet :: ObjectTypeDefinition InputValueDefinition
-> SelectionSet NoFragments Name
-> Analysis (HashMap Name FieldInfo)
analyzeObjectSelectionSet (G.ObjectTypeDefinition {[Name]
[FieldDefinition InputValueDefinition]
[Directive Void]
Maybe Description
Name
_otdDescription :: Maybe Description
_otdName :: Name
_otdImplementsInterfaces :: [Name]
_otdDirectives :: [Directive Void]
_otdFieldsDefinition :: [FieldDefinition InputValueDefinition]
_otdDescription :: forall inputType.
ObjectTypeDefinition inputType -> Maybe Description
_otdName :: forall inputType. ObjectTypeDefinition inputType -> Name
_otdImplementsInterfaces :: forall inputType. ObjectTypeDefinition inputType -> [Name]
_otdDirectives :: forall inputType.
ObjectTypeDefinition inputType -> [Directive Void]
_otdFieldsDefinition :: forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
..}) SelectionSet NoFragments Name
selectionSet = do
  [Maybe (HashMap Name FieldInfo)]
fields <- (Selection NoFragments Name
 -> Analysis (Maybe (HashMap Name FieldInfo)))
-> SelectionSet NoFragments Name
-> Analysis [Maybe (HashMap Name FieldInfo)]
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 Selection NoFragments Name
-> Analysis (Maybe (HashMap Name FieldInfo))
analyzeSelection SelectionSet NoFragments Name
selectionSet
  (HashMap Name FieldInfo
 -> HashMap Name FieldInfo -> Analysis (HashMap Name FieldInfo))
-> HashMap Name FieldInfo
-> [HashMap Name FieldInfo]
-> Analysis (HashMap Name FieldInfo)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo)
-> HashMap Name FieldInfo
-> HashMap Name FieldInfo
-> Analysis (HashMap Name FieldInfo)
forall (m :: * -> *) k v.
(Monad m, Hashable k) =>
(k -> v -> v -> m v)
-> HashMap k v -> HashMap k v -> m (HashMap k v)
HashMap.unionWithM Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo
mergeFields) HashMap Name FieldInfo
forall a. Monoid a => a
mempty ([HashMap Name FieldInfo] -> Analysis (HashMap Name FieldInfo))
-> [HashMap Name FieldInfo] -> Analysis (HashMap Name FieldInfo)
forall a b. (a -> b) -> a -> b
$ [Maybe (HashMap Name FieldInfo)] -> [HashMap Name FieldInfo]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (HashMap Name FieldInfo)]
fields
  where
    analyzeSelection :: G.Selection G.NoFragments G.Name -> Analysis (Maybe (HashMap G.Name FieldInfo))
    analyzeSelection :: Selection NoFragments Name
-> Analysis (Maybe (HashMap Name FieldInfo))
analyzeSelection = \case
      G.SelectionInlineFragment InlineFragment NoFragments Name
inlineFrag ->
        [Maybe (HashMap Name FieldInfo)] -> Maybe (HashMap Name FieldInfo)
forall a. Monoid a => [a] -> a
mconcat ([Maybe (HashMap Name FieldInfo)]
 -> Maybe (HashMap Name FieldInfo))
-> Analysis [Maybe (HashMap Name FieldInfo)]
-> Analysis (Maybe (HashMap Name FieldInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection NoFragments Name
 -> Analysis (Maybe (HashMap Name FieldInfo)))
-> SelectionSet NoFragments Name
-> Analysis [Maybe (HashMap Name FieldInfo)]
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 Selection NoFragments Name
-> Analysis (Maybe (HashMap Name FieldInfo))
analyzeSelection (InlineFragment NoFragments Name -> SelectionSet NoFragments Name
forall (frag :: * -> *) var.
InlineFragment frag var -> SelectionSet frag var
G._ifSelectionSet InlineFragment NoFragments Name
inlineFrag)
      G.SelectionField field :: Field NoFragments Name
field@G.Field {[Directive Name]
SelectionSet NoFragments Name
Maybe Name
HashMap Name (Value Name)
Name
_fAlias :: Maybe Name
_fName :: Name
_fArguments :: HashMap Name (Value Name)
_fDirectives :: [Directive Name]
_fSelectionSet :: SelectionSet NoFragments Name
_fAlias :: forall (frag :: * -> *) var. Field frag var -> Maybe Name
_fName :: forall (frag :: * -> *) var. Field frag var -> Name
_fArguments :: forall (frag :: * -> *) var.
Field frag var -> HashMap Name (Value var)
_fDirectives :: forall (frag :: * -> *) var. Field frag var -> [Directive var]
_fSelectionSet :: forall (frag :: * -> *) var.
Field frag var -> SelectionSet frag var
..} ->
        (Maybe (Maybe (HashMap Name FieldInfo))
 -> Maybe (HashMap Name FieldInfo))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
-> Analysis (Maybe (HashMap Name FieldInfo))
forall a b. (a -> b) -> Analysis a -> Analysis b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (HashMap Name FieldInfo))
-> Maybe (HashMap Name FieldInfo)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          (Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
 -> Analysis (Maybe (HashMap Name FieldInfo)))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
-> Analysis (Maybe (HashMap Name FieldInfo))
forall a b. (a -> b) -> a -> b
$ Name
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
forall (m :: * -> *) a.
MonadReader (Path, SchemaIntrospection) m =>
Name -> m a -> m a
withField Name
_fName
          (Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
 -> Analysis (Maybe (Maybe (HashMap Name FieldInfo))))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
forall a b. (a -> b) -> a -> b
$ Analysis (Maybe (HashMap Name FieldInfo))
-> Analysis (Maybe (Maybe (HashMap Name FieldInfo)))
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadWriter [AnalysisError] m, MonadError AnalysisError m) =>
m a -> m (Maybe a)
withCatchAndRecord do
            -- attempt to find that field in the object's definition
            G.FieldDefinition {ArgumentsDefinition InputValueDefinition
[Directive Void]
Maybe Description
Name
GType
_fldDescription :: Maybe Description
_fldName :: Name
_fldArgumentsDefinition :: ArgumentsDefinition InputValueDefinition
_fldType :: GType
_fldDirectives :: [Directive Void]
_fldDescription :: forall inputType. FieldDefinition inputType -> Maybe Description
_fldName :: forall inputType. FieldDefinition inputType -> Name
_fldArgumentsDefinition :: forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
_fldType :: forall inputType. FieldDefinition inputType -> GType
_fldDirectives :: forall inputType. FieldDefinition inputType -> [Directive Void]
..} <-
              Name -> Maybe (FieldDefinition InputValueDefinition)
findDefinition Name
_fName
                Maybe (FieldDefinition InputValueDefinition)
-> Analysis (FieldDefinition InputValueDefinition)
-> Analysis (FieldDefinition InputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Diagnosis -> Analysis (FieldDefinition InputValueDefinition)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Name -> Name -> Diagnosis
ObjectFieldNotFound Name
_otdName Name
_fName)
            -- attempt to find its type in the schema
            let baseType :: Name
baseType = GType -> Name
G.getBaseType GType
_fldType
            TypeDefinition [Name] InputValueDefinition
typeDefinition <-
              Name
-> Analysis (Maybe (TypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *).
MonadReader (Path, SchemaIntrospection) m =>
Name -> m (Maybe (TypeDefinition [Name] InputValueDefinition))
lookupType Name
baseType
                Analysis (Maybe (TypeDefinition [Name] InputValueDefinition))
-> Analysis (TypeDefinition [Name] InputValueDefinition)
-> Analysis (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`onNothingM` Diagnosis -> Analysis (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Name -> Diagnosis
TypeNotFound Name
baseType)
            -- attempt to build a corresponding FieldInfo
            Maybe FieldInfo
maybeFieldInfo <- GType
-> TypeDefinition [Name] InputValueDefinition
-> Field NoFragments Name
-> Analysis (Maybe FieldInfo)
analyzeField GType
_fldType TypeDefinition [Name] InputValueDefinition
typeDefinition Field NoFragments Name
field
            Maybe (HashMap Name FieldInfo)
-> Analysis (Maybe (HashMap Name FieldInfo))
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap Name FieldInfo)
 -> Analysis (Maybe (HashMap Name FieldInfo)))
-> Maybe (HashMap Name FieldInfo)
-> Analysis (Maybe (HashMap Name FieldInfo))
forall a b. (a -> b) -> a -> b
$ Name -> FieldInfo -> HashMap Name FieldInfo
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
_fName Maybe Name
_fAlias) (FieldInfo -> HashMap Name FieldInfo)
-> Maybe FieldInfo -> Maybe (HashMap Name FieldInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FieldInfo
maybeFieldInfo

    -- Additional hidden fields that are allowed despite not being listed in the
    -- schema.
    systemFields :: [G.FieldDefinition G.InputValueDefinition]
    systemFields :: [FieldDefinition InputValueDefinition]
systemFields =
      if Name
_otdName Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
queryRootName, Name
mutationRootName, Name
subscriptionRootName]
        then [FieldDefinition InputValueDefinition
typenameField, FieldDefinition InputValueDefinition
schemaField, FieldDefinition InputValueDefinition
typeField]
        else [FieldDefinition InputValueDefinition
typenameField]

    -- Search for that field in the schema's definition.
    findDefinition :: G.Name -> Maybe (G.FieldDefinition G.InputValueDefinition)
    findDefinition :: Name -> Maybe (FieldDefinition InputValueDefinition)
findDefinition Name
name =
      (FieldDefinition InputValueDefinition -> Bool)
-> [FieldDefinition InputValueDefinition]
-> Maybe (FieldDefinition InputValueDefinition)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
        (\FieldDefinition InputValueDefinition
fieldDef -> FieldDefinition InputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition InputValueDefinition
fieldDef Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name)
        ([FieldDefinition InputValueDefinition]
_otdFieldsDefinition [FieldDefinition InputValueDefinition]
-> [FieldDefinition InputValueDefinition]
-> [FieldDefinition InputValueDefinition]
forall a. Semigroup a => a -> a -> a
<> [FieldDefinition InputValueDefinition]
systemFields)

    -- We collect fields in a @Hashmap Name FieldInfo@; in some cases, we might
    -- end up with two entries with the same name, in the case where a query
    -- selects the same field twice; when that happens we attempt to gracefully
    -- merge the info.
    mergeFields :: G.Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo
    mergeFields :: Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo
mergeFields Name
name FieldInfo
field1 FieldInfo
field2 = case (FieldInfo
field1, FieldInfo
field2) of
      -- both are scalars: we check that they're the same
      (FieldScalarInfo GType
t1 ScalarInfo
s1, FieldScalarInfo GType
t2 ScalarInfo
_) -> do
        Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GType
t1 GType -> GType -> Bool
forall a. Eq a => a -> a -> Bool
/= GType
t2)
          (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
          (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> GType -> GType -> Diagnosis
MismatchedFields Name
name GType
t1 GType
t2
        FieldInfo -> Analysis FieldInfo
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldInfo -> Analysis FieldInfo)
-> FieldInfo -> Analysis FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> ScalarInfo -> FieldInfo
FieldScalarInfo GType
t1 ScalarInfo
s1
      -- both are enums: we check that they're the same
      (FieldEnumInfo GType
t1 EnumInfo
e1, FieldEnumInfo GType
t2 EnumInfo
_) -> do
        Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GType
t1 GType -> GType -> Bool
forall a. Eq a => a -> a -> Bool
/= GType
t2)
          (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
          (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> GType -> GType -> Diagnosis
MismatchedFields Name
name GType
t1 GType
t2
        FieldInfo -> Analysis FieldInfo
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldInfo -> Analysis FieldInfo)
-> FieldInfo -> Analysis FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> EnumInfo -> FieldInfo
FieldEnumInfo GType
t1 EnumInfo
e1
      -- both are objects, we merge their selection sets
      (FieldObjectInfo GType
t1 ObjectInfo
o1, FieldObjectInfo GType
t2 ObjectInfo
o2) -> do
        Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GType
t1 GType -> GType -> Bool
forall a. Eq a => a -> a -> Bool
/= GType
t2)
          (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
          (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> GType -> GType -> Diagnosis
MismatchedFields Name
name GType
t1 GType
t2
        HashMap Name FieldInfo
mergedSelection <-
          (Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo)
-> HashMap Name FieldInfo
-> HashMap Name FieldInfo
-> Analysis (HashMap Name FieldInfo)
forall (m :: * -> *) k v.
(Monad m, Hashable k) =>
(k -> v -> v -> m v)
-> HashMap k v -> HashMap k v -> m (HashMap k v)
HashMap.unionWithM
            Name -> FieldInfo -> FieldInfo -> Analysis FieldInfo
mergeFields
            (ObjectInfo -> HashMap Name FieldInfo
_oiSelection ObjectInfo
o1)
            (ObjectInfo -> HashMap Name FieldInfo
_oiSelection ObjectInfo
o2)
        FieldInfo -> Analysis FieldInfo
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldInfo -> Analysis FieldInfo)
-> FieldInfo -> Analysis FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> ObjectInfo -> FieldInfo
FieldObjectInfo GType
t1 ObjectInfo
o1 {_oiSelection :: HashMap Name FieldInfo
_oiSelection = HashMap Name FieldInfo
mergedSelection}
      -- they do not match
      (FieldInfo, FieldInfo)
_ ->
        Diagnosis -> Analysis FieldInfo
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Diagnosis -> Analysis FieldInfo)
-> Diagnosis -> Analysis FieldInfo
forall a b. (a -> b) -> a -> b
$ Name -> GType -> GType -> Diagnosis
MismatchedFields Name
name (FieldInfo -> GType
getFieldType FieldInfo
field1) (FieldInfo -> GType
getFieldType FieldInfo
field2)

    -- Extract the GType of a given field
    getFieldType :: FieldInfo -> GType
getFieldType = \case
      FieldEnumInfo GType
t EnumInfo
_ -> GType
t
      FieldScalarInfo GType
t ScalarInfo
_ -> GType
t
      FieldObjectInfo GType
t ObjectInfo
_ -> GType
t

-- | Analyze a given field, and attempt to build a corresponding 'FieldInfo'.
analyzeField ::
  G.GType ->
  G.TypeDefinition [G.Name] G.InputValueDefinition ->
  G.Field G.NoFragments G.Name ->
  Analysis (Maybe FieldInfo)
analyzeField :: GType
-> TypeDefinition [Name] InputValueDefinition
-> Field NoFragments Name
-> Analysis (Maybe FieldInfo)
analyzeField GType
gType TypeDefinition [Name] InputValueDefinition
typeDefinition G.Field {[Directive Name]
SelectionSet NoFragments Name
Maybe Name
HashMap Name (Value Name)
Name
_fAlias :: forall (frag :: * -> *) var. Field frag var -> Maybe Name
_fName :: forall (frag :: * -> *) var. Field frag var -> Name
_fArguments :: forall (frag :: * -> *) var.
Field frag var -> HashMap Name (Value var)
_fDirectives :: forall (frag :: * -> *) var. Field frag var -> [Directive var]
_fSelectionSet :: forall (frag :: * -> *) var.
Field frag var -> SelectionSet frag var
_fAlias :: Maybe Name
_fName :: Name
_fArguments :: HashMap Name (Value Name)
_fDirectives :: [Directive Name]
_fSelectionSet :: SelectionSet NoFragments Name
..} = case TypeDefinition [Name] InputValueDefinition
typeDefinition of
  G.TypeDefinitionInputObject InputObjectTypeDefinition InputValueDefinition
iotd -> do
    -- input objects aren't allowed in selection sets
    Diagnosis -> Analysis (Maybe FieldInfo)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Diagnosis -> Analysis (Maybe FieldInfo))
-> Diagnosis -> Analysis (Maybe FieldInfo)
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
InputObjectInOutput (Name -> Diagnosis) -> Name -> Diagnosis
forall a b. (a -> b) -> a -> b
$ InputObjectTypeDefinition InputValueDefinition -> Name
forall inputType. InputObjectTypeDefinition inputType -> Name
G._iotdName InputObjectTypeDefinition InputValueDefinition
iotd
  G.TypeDefinitionScalar ScalarTypeDefinition
std -> do
    -- scalars do not admit a selection set
    Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SelectionSet NoFragments Name -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SelectionSet NoFragments Name
_fSelectionSet)
      (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
      (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
ScalarSelectionSet
      (Name -> Diagnosis) -> Name -> Diagnosis
forall a b. (a -> b) -> a -> b
$ ScalarTypeDefinition -> Name
G._stdName ScalarTypeDefinition
std
    Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FieldInfo -> Analysis (Maybe FieldInfo))
-> Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a b. (a -> b) -> a -> b
$ FieldInfo -> Maybe FieldInfo
forall a. a -> Maybe a
Just (FieldInfo -> Maybe FieldInfo) -> FieldInfo -> Maybe FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> ScalarInfo -> FieldInfo
FieldScalarInfo GType
gType (ScalarInfo -> FieldInfo) -> ScalarInfo -> FieldInfo
forall a b. (a -> b) -> a -> b
$ ScalarTypeDefinition -> ScalarInfo
ScalarInfo ScalarTypeDefinition
std
  G.TypeDefinitionEnum EnumTypeDefinition
etd -> do
    -- enums do not admit a selection set
    Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SelectionSet NoFragments Name -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SelectionSet NoFragments Name
_fSelectionSet)
      (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
      (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
EnumSelectionSet
      (Name -> Diagnosis) -> Name -> Diagnosis
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> Name
G._etdName EnumTypeDefinition
etd
    Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FieldInfo -> Analysis (Maybe FieldInfo))
-> Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a b. (a -> b) -> a -> b
$ FieldInfo -> Maybe FieldInfo
forall a. a -> Maybe a
Just (FieldInfo -> Maybe FieldInfo) -> FieldInfo -> Maybe FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> EnumInfo -> FieldInfo
FieldEnumInfo GType
gType (EnumInfo -> FieldInfo) -> EnumInfo -> FieldInfo
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> EnumInfo
EnumInfo EnumTypeDefinition
etd
  G.TypeDefinitionUnion UnionTypeDefinition
_utd ->
    -- TODO: implement unions
    Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FieldInfo
forall a. Maybe a
Nothing
  G.TypeDefinitionInterface InterfaceTypeDefinition [Name] InputValueDefinition
_itd ->
    -- TODO: implement interfaces
    Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FieldInfo
forall a. Maybe a
Nothing
  G.TypeDefinitionObject ObjectTypeDefinition InputValueDefinition
otd -> do
    -- TODO: check field arguments?
    Bool -> Analysis () -> Analysis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SelectionSet NoFragments Name -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SelectionSet NoFragments Name
_fSelectionSet)
      (Analysis () -> Analysis ()) -> Analysis () -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Diagnosis -> Analysis ()
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis
      (Diagnosis -> Analysis ()) -> Diagnosis -> Analysis ()
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
ObjectMissingSelectionSet
      (Name -> Diagnosis) -> Name -> Diagnosis
forall a b. (a -> b) -> a -> b
$ ObjectTypeDefinition InputValueDefinition -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ObjectTypeDefinition InputValueDefinition
otd
    HashMap Name FieldInfo
subselection <- ObjectTypeDefinition InputValueDefinition
-> SelectionSet NoFragments Name
-> Analysis (HashMap Name FieldInfo)
analyzeObjectSelectionSet ObjectTypeDefinition InputValueDefinition
otd SelectionSet NoFragments Name
_fSelectionSet
    Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe FieldInfo -> Analysis (Maybe FieldInfo))
-> Maybe FieldInfo -> Analysis (Maybe FieldInfo)
forall a b. (a -> b) -> a -> b
$ FieldInfo -> Maybe FieldInfo
forall a. a -> Maybe a
Just
      (FieldInfo -> Maybe FieldInfo) -> FieldInfo -> Maybe FieldInfo
forall a b. (a -> b) -> a -> b
$ GType -> ObjectInfo -> FieldInfo
FieldObjectInfo GType
gType
      (ObjectInfo -> FieldInfo) -> ObjectInfo -> FieldInfo
forall a b. (a -> b) -> a -> b
$ ObjectInfo
        { _oiTypeDefinition :: ObjectTypeDefinition InputValueDefinition
_oiTypeDefinition = ObjectTypeDefinition InputValueDefinition
otd,
          _oiSelection :: HashMap Name FieldInfo
_oiSelection = HashMap Name FieldInfo
subselection
        }

--------------------------------------------------------------------------------
-- Variables analysis

-- | Analyzes the variables in the given query. This builds the graph of input
-- types associated with the variable. This process is, like any GraphQL schema
-- operation, inherently self-recursive, and we use 'CircularT' (a lesser
-- 'SchemaT') to tie the knot.
analyzeVariables ::
  [G.VariableDefinition] ->
  Analysis (HashMap G.Name VariableInfo)
analyzeVariables :: [VariableDefinition] -> Analysis (HashMap Name VariableInfo)
analyzeVariables [VariableDefinition]
variables = do
  [Maybe (HashMap Name VariableInfo)]
result <- CircularT
  Name InputFieldInfo Analysis [Maybe (HashMap Name VariableInfo)]
-> Analysis [Maybe (HashMap Name VariableInfo)]
forall k (m :: * -> *) v a.
(Hashable k, MonadFix m) =>
CircularT k v m a -> m a
runCircularT (CircularT
   Name InputFieldInfo Analysis [Maybe (HashMap Name VariableInfo)]
 -> Analysis [Maybe (HashMap Name VariableInfo)])
-> CircularT
     Name InputFieldInfo Analysis [Maybe (HashMap Name VariableInfo)]
-> Analysis [Maybe (HashMap Name VariableInfo)]
forall a b. (a -> b) -> a -> b
$ [VariableDefinition]
-> (VariableDefinition
    -> CircularT
         Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo)))
-> CircularT
     Name InputFieldInfo Analysis [Maybe (HashMap Name VariableInfo)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [VariableDefinition]
variables \G.VariableDefinition {Maybe (Value Void)
Name
GType
_vdName :: Name
_vdType :: GType
_vdDefaultValue :: Maybe (Value Void)
_vdName :: VariableDefinition -> Name
_vdType :: VariableDefinition -> GType
_vdDefaultValue :: VariableDefinition -> Maybe (Value Void)
..} -> do
    -- TODO: do we want to differentiate field from variable in the error path?
    Name
-> CircularT
     Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
-> CircularT
     Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
forall (m :: * -> *) a.
MonadReader (Path, SchemaIntrospection) m =>
Name -> m a -> m a
withField Name
_vdName (CircularT
   Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
 -> CircularT
      Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo)))
-> CircularT
     Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
-> CircularT
     Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
forall a b. (a -> b) -> a -> b
$ CircularT Name InputFieldInfo Analysis (HashMap Name VariableInfo)
-> CircularT
     Name InputFieldInfo Analysis (Maybe (HashMap Name VariableInfo))
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadWriter [AnalysisError] m, MonadError AnalysisError m) =>
m a -> m (Maybe a)
withCatchAndRecord do
      let baseType :: Name
baseType = GType -> Name
G.getBaseType GType
_vdType
      TypeDefinition [Name] InputValueDefinition
typeDefinition <-
        Name
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (TypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *).
MonadReader (Path, SchemaIntrospection) m =>
Name -> m (Maybe (TypeDefinition [Name] InputValueDefinition))
lookupType Name
baseType
          CircularT
  Name
  InputFieldInfo
  Analysis
  (Maybe (TypeDefinition [Name] InputValueDefinition))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`onNothingM` Diagnosis
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Name -> Diagnosis
TypeNotFound Name
baseType)
      InputFieldInfo
ifInfo <- Name
-> TypeDefinition [Name] InputValueDefinition
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
analyzeInputField Name
baseType TypeDefinition [Name] InputValueDefinition
typeDefinition
      HashMap Name VariableInfo
-> CircularT
     Name InputFieldInfo Analysis (HashMap Name VariableInfo)
forall a. a -> CircularT Name InputFieldInfo Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Name VariableInfo
 -> CircularT
      Name InputFieldInfo Analysis (HashMap Name VariableInfo))
-> HashMap Name VariableInfo
-> CircularT
     Name InputFieldInfo Analysis (HashMap Name VariableInfo)
forall a b. (a -> b) -> a -> b
$ Name -> VariableInfo -> HashMap Name VariableInfo
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
_vdName (VariableInfo -> HashMap Name VariableInfo)
-> VariableInfo -> HashMap Name VariableInfo
forall a b. (a -> b) -> a -> b
$ GType -> InputFieldInfo -> Maybe (Value Void) -> VariableInfo
VariableInfo GType
_vdType InputFieldInfo
ifInfo Maybe (Value Void)
_vdDefaultValue
  HashMap Name VariableInfo -> Analysis (HashMap Name VariableInfo)
forall a. a -> Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Name VariableInfo -> Analysis (HashMap Name VariableInfo))
-> HashMap Name VariableInfo
-> Analysis (HashMap Name VariableInfo)
forall a b. (a -> b) -> a -> b
$ [HashMap Name VariableInfo] -> HashMap Name VariableInfo
forall a. Monoid a => [a] -> a
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([HashMap Name VariableInfo] -> HashMap Name VariableInfo)
-> [HashMap Name VariableInfo] -> HashMap Name VariableInfo
forall a b. (a -> b) -> a -> b
$ [Maybe (HashMap Name VariableInfo)] -> [HashMap Name VariableInfo]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (HashMap Name VariableInfo)]
result

-- | Builds an 'InputFieldInfo' for a given typename.
--
-- This function is "memoized" using 'withCircular' to prevent processing the
-- same type more than once in case the input types are self-recursive.
analyzeInputField ::
  G.Name ->
  G.TypeDefinition [G.Name] G.InputValueDefinition ->
  CircularT G.Name InputFieldInfo Analysis InputFieldInfo
analyzeInputField :: Name
-> TypeDefinition [Name] InputValueDefinition
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
analyzeInputField Name
typeName TypeDefinition [Name] InputValueDefinition
typeDefinition =
  Name
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall k (m :: * -> *) v.
(Hashable k, MonadFix m) =>
k -> CircularT k v m v -> CircularT k v m v
withCircular Name
typeName (CircularT Name InputFieldInfo Analysis InputFieldInfo
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ case TypeDefinition [Name] InputValueDefinition
typeDefinition of
    G.TypeDefinitionScalar ScalarTypeDefinition
std ->
      InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a. a -> CircularT Name InputFieldInfo Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldInfo
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ ScalarInfo -> InputFieldInfo
InputFieldScalarInfo (ScalarTypeDefinition -> ScalarInfo
ScalarInfo ScalarTypeDefinition
std)
    G.TypeDefinitionEnum EnumTypeDefinition
etd ->
      InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a. a -> CircularT Name InputFieldInfo Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldInfo
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ EnumInfo -> InputFieldInfo
InputFieldEnumInfo (EnumTypeDefinition -> EnumInfo
EnumInfo EnumTypeDefinition
etd)
    G.TypeDefinitionInputObject InputObjectTypeDefinition InputValueDefinition
iotd -> do
      [Maybe (Name, (GType, InputFieldInfo))]
fields <- ArgumentsDefinition InputValueDefinition
-> (InputValueDefinition
    -> CircularT
         Name
         InputFieldInfo
         Analysis
         (Maybe (Name, (GType, InputFieldInfo))))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     [Maybe (Name, (GType, InputFieldInfo))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (InputObjectTypeDefinition InputValueDefinition
-> ArgumentsDefinition InputValueDefinition
forall inputType.
InputObjectTypeDefinition inputType -> [inputType]
G._iotdValueDefinitions InputObjectTypeDefinition InputValueDefinition
iotd) \G.InputValueDefinition {[Directive Void]
Maybe Description
Maybe (Value Void)
Name
GType
_ivdDescription :: Maybe Description
_ivdName :: Name
_ivdType :: GType
_ivdDefaultValue :: Maybe (Value Void)
_ivdDirectives :: [Directive Void]
_ivdDescription :: InputValueDefinition -> Maybe Description
_ivdName :: InputValueDefinition -> Name
_ivdType :: InputValueDefinition -> GType
_ivdDefaultValue :: InputValueDefinition -> Maybe (Value Void)
_ivdDirectives :: InputValueDefinition -> [Directive Void]
..} -> do
        Name
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (Name, (GType, InputFieldInfo)))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (Name, (GType, InputFieldInfo)))
forall (m :: * -> *) a.
MonadReader (Path, SchemaIntrospection) m =>
Name -> m a -> m a
withField Name
_ivdName (CircularT
   Name
   InputFieldInfo
   Analysis
   (Maybe (Name, (GType, InputFieldInfo)))
 -> CircularT
      Name
      InputFieldInfo
      Analysis
      (Maybe (Name, (GType, InputFieldInfo))))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (Name, (GType, InputFieldInfo)))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (Name, (GType, InputFieldInfo)))
forall a b. (a -> b) -> a -> b
$ CircularT
  Name InputFieldInfo Analysis (Name, (GType, InputFieldInfo))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (Name, (GType, InputFieldInfo)))
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadWriter [AnalysisError] m, MonadError AnalysisError m) =>
m a -> m (Maybe a)
withCatchAndRecord do
          let baseType :: Name
baseType = GType -> Name
G.getBaseType GType
_ivdType
          TypeDefinition [Name] InputValueDefinition
typeDef <-
            Name
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (Maybe (TypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *).
MonadReader (Path, SchemaIntrospection) m =>
Name -> m (Maybe (TypeDefinition [Name] InputValueDefinition))
lookupType Name
baseType
              CircularT
  Name
  InputFieldInfo
  Analysis
  (Maybe (TypeDefinition [Name] InputValueDefinition))
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`onNothingM` Diagnosis
-> CircularT
     Name
     InputFieldInfo
     Analysis
     (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Name -> Diagnosis
TypeNotFound Name
baseType)
          InputFieldInfo
info <- Name
-> TypeDefinition [Name] InputValueDefinition
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
analyzeInputField Name
baseType TypeDefinition [Name] InputValueDefinition
typeDef
          (Name, (GType, InputFieldInfo))
-> CircularT
     Name InputFieldInfo Analysis (Name, (GType, InputFieldInfo))
forall a. a -> CircularT Name InputFieldInfo Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
_ivdName, (GType
_ivdType, InputFieldInfo
info))
      InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a. a -> CircularT Name InputFieldInfo Analysis a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputFieldInfo
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> InputFieldInfo
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ InputObjectInfo -> InputFieldInfo
InputFieldObjectInfo (InputObjectTypeDefinition InputValueDefinition
-> HashMap Name (GType, InputFieldInfo) -> InputObjectInfo
InputObjectInfo InputObjectTypeDefinition InputValueDefinition
iotd (HashMap Name (GType, InputFieldInfo) -> InputObjectInfo)
-> HashMap Name (GType, InputFieldInfo) -> InputObjectInfo
forall a b. (a -> b) -> a -> b
$ [(Name, (GType, InputFieldInfo))]
-> HashMap Name (GType, InputFieldInfo)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, (GType, InputFieldInfo))]
 -> HashMap Name (GType, InputFieldInfo))
-> [(Name, (GType, InputFieldInfo))]
-> HashMap Name (GType, InputFieldInfo)
forall a b. (a -> b) -> a -> b
$ [Maybe (Name, (GType, InputFieldInfo))]
-> [(Name, (GType, InputFieldInfo))]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (Name, (GType, InputFieldInfo))]
fields)
    G.TypeDefinitionObject ObjectTypeDefinition InputValueDefinition
_otd -> Diagnosis -> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Diagnosis
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> Diagnosis
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
ObjectInInput Name
typeName
    G.TypeDefinitionInterface InterfaceTypeDefinition [Name] InputValueDefinition
_itd -> Diagnosis -> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Diagnosis
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> Diagnosis
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
InterfaceInInput Name
typeName
    G.TypeDefinitionUnion UnionTypeDefinition
_utd -> Diagnosis -> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis (Diagnosis
 -> CircularT Name InputFieldInfo Analysis InputFieldInfo)
-> Diagnosis
-> CircularT Name InputFieldInfo Analysis InputFieldInfo
forall a b. (a -> b) -> a -> b
$ Name -> Diagnosis
UnionInInput Name
typeName

--------------------------------------------------------------------------------
-- Internal Analysis monad and helpers

-- | The monad in which we run our analysis.
--
-- Has three capabilities:
--   - reader carries the current path, and the full schema for lookups
--   - writer logs all errors we have caught
--   - except allows for short-circuiting errors
newtype Analysis a
  = Analysis
      ( ExceptT
          AnalysisError
          ( ReaderT
              (Path, G.SchemaIntrospection)
              (Writer [AnalysisError])
          )
          a
      )
  deriving newtype
    ( (forall a b. (a -> b) -> Analysis a -> Analysis b)
-> (forall a b. a -> Analysis b -> Analysis a) -> Functor Analysis
forall a b. a -> Analysis b -> Analysis a
forall a b. (a -> b) -> Analysis a -> Analysis b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Analysis a -> Analysis b
fmap :: forall a b. (a -> b) -> Analysis a -> Analysis b
$c<$ :: forall a b. a -> Analysis b -> Analysis a
<$ :: forall a b. a -> Analysis b -> Analysis a
Functor,
      Functor Analysis
Functor Analysis
-> (forall a. a -> Analysis a)
-> (forall a b. Analysis (a -> b) -> Analysis a -> Analysis b)
-> (forall a b c.
    (a -> b -> c) -> Analysis a -> Analysis b -> Analysis c)
-> (forall a b. Analysis a -> Analysis b -> Analysis b)
-> (forall a b. Analysis a -> Analysis b -> Analysis a)
-> Applicative Analysis
forall a. a -> Analysis a
forall a b. Analysis a -> Analysis b -> Analysis a
forall a b. Analysis a -> Analysis b -> Analysis b
forall a b. Analysis (a -> b) -> Analysis a -> Analysis b
forall a b c.
(a -> b -> c) -> Analysis a -> Analysis b -> Analysis c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Analysis a
pure :: forall a. a -> Analysis a
$c<*> :: forall a b. Analysis (a -> b) -> Analysis a -> Analysis b
<*> :: forall a b. Analysis (a -> b) -> Analysis a -> Analysis b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Analysis a -> Analysis b -> Analysis c
liftA2 :: forall a b c.
(a -> b -> c) -> Analysis a -> Analysis b -> Analysis c
$c*> :: forall a b. Analysis a -> Analysis b -> Analysis b
*> :: forall a b. Analysis a -> Analysis b -> Analysis b
$c<* :: forall a b. Analysis a -> Analysis b -> Analysis a
<* :: forall a b. Analysis a -> Analysis b -> Analysis a
Applicative,
      Applicative Analysis
Applicative Analysis
-> (forall a b. Analysis a -> (a -> Analysis b) -> Analysis b)
-> (forall a b. Analysis a -> Analysis b -> Analysis b)
-> (forall a. a -> Analysis a)
-> Monad Analysis
forall a. a -> Analysis a
forall a b. Analysis a -> Analysis b -> Analysis b
forall a b. Analysis a -> (a -> Analysis b) -> Analysis b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Analysis a -> (a -> Analysis b) -> Analysis b
>>= :: forall a b. Analysis a -> (a -> Analysis b) -> Analysis b
$c>> :: forall a b. Analysis a -> Analysis b -> Analysis b
>> :: forall a b. Analysis a -> Analysis b -> Analysis b
$creturn :: forall a. a -> Analysis a
return :: forall a. a -> Analysis a
Monad,
      MonadReader (Path, G.SchemaIntrospection),
      MonadWriter [AnalysisError],
      MonadError AnalysisError,
      Monad Analysis
Monad Analysis
-> (forall a. (a -> Analysis a) -> Analysis a) -> MonadFix Analysis
forall a. (a -> Analysis a) -> Analysis a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall a. (a -> Analysis a) -> Analysis a
mfix :: forall a. (a -> Analysis a) -> Analysis a
MonadFix
    )

runAnalysis :: G.SchemaIntrospection -> Analysis a -> (Maybe a, [Text])
runAnalysis :: forall a. SchemaIntrospection -> Analysis a -> (Maybe a, [Text])
runAnalysis SchemaIntrospection
schema (Analysis ExceptT
  AnalysisError
  (ReaderT (Path, SchemaIntrospection) (Writer [AnalysisError]))
  a
a) =
  (Either AnalysisError a, [AnalysisError]) -> (Maybe a, [Text])
forall {a}.
(Either AnalysisError a, [AnalysisError]) -> (Maybe a, [Text])
postProcess
    ((Either AnalysisError a, [AnalysisError]) -> (Maybe a, [Text]))
-> (Either AnalysisError a, [AnalysisError]) -> (Maybe a, [Text])
forall a b. (a -> b) -> a -> b
$ Writer [AnalysisError] (Either AnalysisError a)
-> (Either AnalysisError a, [AnalysisError])
forall w a. Writer w a -> (a, w)
runWriter
    (Writer [AnalysisError] (Either AnalysisError a)
 -> (Either AnalysisError a, [AnalysisError]))
-> Writer [AnalysisError] (Either AnalysisError a)
-> (Either AnalysisError a, [AnalysisError])
forall a b. (a -> b) -> a -> b
$ (ReaderT
   (Path, SchemaIntrospection)
   (Writer [AnalysisError])
   (Either AnalysisError a)
 -> (Path, SchemaIntrospection)
 -> Writer [AnalysisError] (Either AnalysisError a))
-> (Path, SchemaIntrospection)
-> ReaderT
     (Path, SchemaIntrospection)
     (Writer [AnalysisError])
     (Either AnalysisError a)
-> Writer [AnalysisError] (Either AnalysisError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (Path, SchemaIntrospection)
  (Writer [AnalysisError])
  (Either AnalysisError a)
-> (Path, SchemaIntrospection)
-> Writer [AnalysisError] (Either AnalysisError a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Text -> Path
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"$", SchemaIntrospection
schema)
    (ReaderT
   (Path, SchemaIntrospection)
   (Writer [AnalysisError])
   (Either AnalysisError a)
 -> Writer [AnalysisError] (Either AnalysisError a))
-> ReaderT
     (Path, SchemaIntrospection)
     (Writer [AnalysisError])
     (Either AnalysisError a)
-> Writer [AnalysisError] (Either AnalysisError a)
forall a b. (a -> b) -> a -> b
$ ExceptT
  AnalysisError
  (ReaderT (Path, SchemaIntrospection) (Writer [AnalysisError]))
  a
-> ReaderT
     (Path, SchemaIntrospection)
     (Writer [AnalysisError])
     (Either AnalysisError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  AnalysisError
  (ReaderT (Path, SchemaIntrospection) (Writer [AnalysisError]))
  a
a
  where
    -- if there was an uncaught error, add it to the list
    postProcess :: (Either AnalysisError a, [AnalysisError]) -> (Maybe a, [Text])
postProcess = \case
      (Left AnalysisError
err, [AnalysisError]
errors) ->
        (Maybe a
forall a. Maybe a
Nothing, (AnalysisError -> Text) -> [AnalysisError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map AnalysisError -> Text
render ([AnalysisError] -> [Text]) -> [AnalysisError] -> [Text]
forall a b. (a -> b) -> a -> b
$ [AnalysisError]
errors [AnalysisError] -> [AnalysisError] -> [AnalysisError]
forall a. [a] -> [a] -> [a]
++ [AnalysisError
err])
      (Right a
result, [AnalysisError]
errors) ->
        (a -> Maybe a
forall a. a -> Maybe a
Just a
result, (AnalysisError -> Text) -> [AnalysisError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map AnalysisError -> Text
render [AnalysisError]
errors)

-- | Look up a type in the schema.
lookupType ::
  (MonadReader (Path, G.SchemaIntrospection) m) =>
  G.Name ->
  m (Maybe (G.TypeDefinition [G.Name] G.InputValueDefinition))
lookupType :: forall (m :: * -> *).
MonadReader (Path, SchemaIntrospection) m =>
Name -> m (Maybe (TypeDefinition [Name] InputValueDefinition))
lookupType Name
name = do
  G.SchemaIntrospection HashMap Name (TypeDefinition [Name] InputValueDefinition)
types <- ((Path, SchemaIntrospection) -> SchemaIntrospection)
-> m SchemaIntrospection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path, SchemaIntrospection) -> SchemaIntrospection
forall a b. (a, b) -> b
snd
  Maybe (TypeDefinition [Name] InputValueDefinition)
-> m (Maybe (TypeDefinition [Name] InputValueDefinition))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TypeDefinition [Name] InputValueDefinition)
 -> m (Maybe (TypeDefinition [Name] InputValueDefinition)))
-> Maybe (TypeDefinition [Name] InputValueDefinition)
-> m (Maybe (TypeDefinition [Name] InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ Name
-> HashMap Name (TypeDefinition [Name] InputValueDefinition)
-> Maybe (TypeDefinition [Name] InputValueDefinition)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name HashMap Name (TypeDefinition [Name] InputValueDefinition)
types

-- | Add the current field to the error path.
withField ::
  (MonadReader (Path, G.SchemaIntrospection) m) =>
  G.Name ->
  m a ->
  m a
withField :: forall (m :: * -> *) a.
MonadReader (Path, SchemaIntrospection) m =>
Name -> m a -> m a
withField Name
name = ((Path, SchemaIntrospection) -> (Path, SchemaIntrospection))
-> m a -> m a
forall a.
((Path, SchemaIntrospection) -> (Path, SchemaIntrospection))
-> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (((Path, SchemaIntrospection) -> (Path, SchemaIntrospection))
 -> m a -> m a)
-> ((Path, SchemaIntrospection) -> (Path, SchemaIntrospection))
-> m a
-> m a
forall a b. (a -> b) -> a -> b
$ (Path -> Path)
-> (Path, SchemaIntrospection) -> (Path, SchemaIntrospection)
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 (Path -> Text -> Path
forall a. Seq a -> a -> Seq a
|> Name -> Text
G.unName Name
name)

-- | Throws an 'AnalysisError' by combining the given diagnosis with the current
-- path. This interrupts the computation in the given branch, and must be caught
-- for the analysis to resume.
throwDiagnosis ::
  ( MonadReader (Path, G.SchemaIntrospection) m,
    MonadError AnalysisError m
  ) =>
  Diagnosis ->
  m a
throwDiagnosis :: forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadError AnalysisError m) =>
Diagnosis -> m a
throwDiagnosis Diagnosis
d = do
  Path
currentPath <- ((Path, SchemaIntrospection) -> Path) -> m Path
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path, SchemaIntrospection) -> Path
forall a b. (a, b) -> a
fst
  AnalysisError -> m a
forall a. AnalysisError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AnalysisError -> m a) -> AnalysisError -> m a
forall a b. (a -> b) -> a -> b
$ Path -> Diagnosis -> AnalysisError
AnalysisError Path
currentPath Diagnosis
d

-- | Runs the given computation. if it fails, cacthes the error, records it in
-- the monad, and return 'Nothing'. This allows for a clean recovery.
withCatchAndRecord ::
  ( MonadReader (Path, G.SchemaIntrospection) m,
    MonadWriter [AnalysisError] m,
    MonadError AnalysisError m
  ) =>
  m a ->
  m (Maybe a)
withCatchAndRecord :: forall (m :: * -> *) a.
(MonadReader (Path, SchemaIntrospection) m,
 MonadWriter [AnalysisError] m, MonadError AnalysisError m) =>
m a -> m (Maybe a)
withCatchAndRecord m a
action =
  (a -> Maybe a) -> m a -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just m a
action m (Maybe a) -> (AnalysisError -> m (Maybe a)) -> m (Maybe a)
forall a. m a -> (AnalysisError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \AnalysisError
e -> do
    [AnalysisError] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [AnalysisError
e]
    Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Analysis errors

data AnalysisError = AnalysisError
  { AnalysisError -> Path
_aePath :: Path,
    AnalysisError -> Diagnosis
_aeDiagnosis :: Diagnosis
  }

type Path = Seq Text

data Diagnosis
  = RootTypeNotAnObject
  | TypeNotFound G.Name
  | EnumSelectionSet G.Name
  | ScalarSelectionSet G.Name
  | InputObjectInOutput G.Name
  | UnionInInput G.Name
  | ObjectInInput G.Name
  | InterfaceInInput G.Name
  | ObjectFieldNotFound G.Name G.Name
  | ObjectMissingSelectionSet G.Name
  | MismatchedFields G.Name G.GType G.GType

render :: AnalysisError -> Text
render :: AnalysisError -> Text
render (AnalysisError Path
path Diagnosis
diagnosis) =
  Text -> [Text] -> Text
T.intercalate Text
"." (Path -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Path
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Diagnosis
diagnosis of
    Diagnosis
RootTypeNotAnObject ->
      Text
"the root type is not an object"
    TypeNotFound Name
name ->
      Text
"type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not found in the schema"
    EnumSelectionSet Name
name ->
      Text
"enum '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' does not accept a selection set"
    ScalarSelectionSet Name
name ->
      Text
"scalar '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' does not accept a selection set"
    InputObjectInOutput Name
name ->
      Text
"input object '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' cannot be used for output"
    UnionInInput Name
name ->
      Text
"union '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' cannot be used in an input type"
    ObjectInInput Name
name ->
      Text
"object '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' cannot be used in an input type"
    InterfaceInInput Name
name ->
      Text
"interface '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' cannot be used in an input type"
    ObjectFieldNotFound Name
objName Name
fieldName ->
      Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not found in object '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
objName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
    ObjectMissingSelectionSet Name
objName ->
      Text
"object of type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
objName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' must have a selection set"
    MismatchedFields Name
name GType
type1 GType
type2 ->
      Text
"field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' seen with two different types: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
forall a. Show a => a -> Text
tshow GType
type1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GType -> Text
forall a. Show a => a -> Text
tshow GType
type2

--------------------------------------------------------------------------------
-- GraphQL internals

-- Special type names

queryRootName :: G.Name
queryRootName :: Name
queryRootName = Name
Name._query_root

mutationRootName :: G.Name
mutationRootName :: Name
mutationRootName = Name
Name._mutation_root

subscriptionRootName :: G.Name
subscriptionRootName :: Name
subscriptionRootName = Name
Name._subscription_root

-- Reserved fields

typenameField :: G.FieldDefinition G.InputValueDefinition
typenameField :: FieldDefinition InputValueDefinition
typenameField = Name -> Name -> FieldDefinition InputValueDefinition
mkReservedField Name
GName.___typename Name
GName._String

schemaField :: G.FieldDefinition G.InputValueDefinition
schemaField :: FieldDefinition InputValueDefinition
schemaField = Name -> Name -> FieldDefinition InputValueDefinition
mkReservedField Name
GName.___schema Name
GName.___Schema

typeField :: G.FieldDefinition G.InputValueDefinition
typeField :: FieldDefinition InputValueDefinition
typeField = Name -> Name -> FieldDefinition InputValueDefinition
mkReservedField Name
GName.___type Name
GName.___Type

mkReservedField :: G.Name -> G.Name -> G.FieldDefinition G.InputValueDefinition
mkReservedField :: Name -> Name -> FieldDefinition InputValueDefinition
mkReservedField Name
fieldName Name
typeName =
  Maybe Description
-> Name
-> ArgumentsDefinition InputValueDefinition
-> GType
-> [Directive Void]
-> FieldDefinition InputValueDefinition
forall inputType.
Maybe Description
-> Name
-> ArgumentsDefinition inputType
-> GType
-> [Directive Void]
-> FieldDefinition inputType
G.FieldDefinition Maybe Description
forall a. Maybe a
Nothing Name
fieldName [] (Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
False) Name
typeName) []