module Hasura.RQL.DDL.CustomTypes
  ( runSetCustomTypes,
    clearCustomTypesInMetadata,
    resolveCustomTypes,
    lookupBackendScalar,
    ScalarParsingMap (..),
  )
where

import Control.Lens ((.~))
import Control.Monad.Validate
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.List.Extended
import Data.List.Extended qualified as L
import Data.Monoid
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Metadata API

runSetCustomTypes ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m
  ) =>
  CustomTypes ->
  m EncJSON
runSetCustomTypes :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
CustomTypes -> m EncJSON
runSetCustomTypes CustomTypes
customTypes = do
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
MOCustomTypes
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (CustomTypes -> Identity CustomTypes)
-> Metadata -> Identity Metadata
Lens' Metadata CustomTypes
metaCustomTypes
    ((CustomTypes -> Identity CustomTypes)
 -> Metadata -> Identity Metadata)
-> CustomTypes -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CustomTypes
customTypes
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

clearCustomTypesInMetadata :: MetadataModifier
clearCustomTypesInMetadata :: MetadataModifier
clearCustomTypesInMetadata =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (CustomTypes -> Identity CustomTypes)
-> Metadata -> Identity Metadata
Lens' Metadata CustomTypes
metaCustomTypes ((CustomTypes -> Identity CustomTypes)
 -> Metadata -> Identity Metadata)
-> CustomTypes -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CustomTypes
emptyCustomTypes

--------------------------------------------------------------------------------
-- Cache building functions

-- | A map from GraphQL name to equivalent scalar type for a given backend.
newtype ScalarParsingMap b = ScalarParsingMap (HashMap G.Name (ScalarWrapper b))
  deriving newtype (NonEmpty (ScalarParsingMap b) -> ScalarParsingMap b
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
(ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b)
-> (NonEmpty (ScalarParsingMap b) -> ScalarParsingMap b)
-> (forall b.
    Integral b =>
    b -> ScalarParsingMap b -> ScalarParsingMap b)
-> Semigroup (ScalarParsingMap b)
forall b.
Integral b =>
b -> ScalarParsingMap b -> ScalarParsingMap b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (b :: BackendType).
NonEmpty (ScalarParsingMap b) -> ScalarParsingMap b
forall (b :: BackendType).
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
forall (b :: BackendType) b.
Integral b =>
b -> ScalarParsingMap b -> ScalarParsingMap b
$c<> :: forall (b :: BackendType).
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
<> :: ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
$csconcat :: forall (b :: BackendType).
NonEmpty (ScalarParsingMap b) -> ScalarParsingMap b
sconcat :: NonEmpty (ScalarParsingMap b) -> ScalarParsingMap b
$cstimes :: forall (b :: BackendType) b.
Integral b =>
b -> ScalarParsingMap b -> ScalarParsingMap b
stimes :: forall b.
Integral b =>
b -> ScalarParsingMap b -> ScalarParsingMap b
Semigroup, Semigroup (ScalarParsingMap b)
ScalarParsingMap b
Semigroup (ScalarParsingMap b)
-> ScalarParsingMap b
-> (ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b)
-> ([ScalarParsingMap b] -> ScalarParsingMap b)
-> Monoid (ScalarParsingMap b)
[ScalarParsingMap b] -> ScalarParsingMap b
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (b :: BackendType). Semigroup (ScalarParsingMap b)
forall (b :: BackendType). ScalarParsingMap b
forall (b :: BackendType).
[ScalarParsingMap b] -> ScalarParsingMap b
forall (b :: BackendType).
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
$cmempty :: forall (b :: BackendType). ScalarParsingMap b
mempty :: ScalarParsingMap b
$cmappend :: forall (b :: BackendType).
ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
mappend :: ScalarParsingMap b -> ScalarParsingMap b -> ScalarParsingMap b
$cmconcat :: forall (b :: BackendType).
[ScalarParsingMap b] -> ScalarParsingMap b
mconcat :: [ScalarParsingMap b] -> ScalarParsingMap b
Monoid)

deriving stock instance (Backend b) => Eq (ScalarParsingMap b)

resolveCustomTypes ::
  (MonadError QErr m) =>
  SourceCache ->
  CustomTypes ->
  BackendMap ScalarParsingMap ->
  m AnnotatedCustomTypes
resolveCustomTypes :: forall (m :: * -> *).
MonadError QErr m =>
SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> m AnnotatedCustomTypes
resolveCustomTypes SourceCache
sources CustomTypes
customTypes BackendMap ScalarParsingMap
allScalars =
  Validate [CustomTypeValidationError] AnnotatedCustomTypes
-> Either [CustomTypeValidationError] AnnotatedCustomTypes
forall e a. Validate e a -> Either e a
runValidate (SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> Validate [CustomTypeValidationError] AnnotatedCustomTypes
forall (m :: * -> *).
MonadValidate [CustomTypeValidationError] m =>
SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> m AnnotatedCustomTypes
validateCustomTypeDefinitions SourceCache
sources CustomTypes
customTypes BackendMap ScalarParsingMap
allScalars)
    Either [CustomTypeValidationError] AnnotatedCustomTypes
-> ([CustomTypeValidationError] -> m AnnotatedCustomTypes)
-> m AnnotatedCustomTypes
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Code -> Text -> m AnnotatedCustomTypes
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation (Text -> m AnnotatedCustomTypes)
-> ([CustomTypeValidationError] -> Text)
-> [CustomTypeValidationError]
-> m AnnotatedCustomTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CustomTypeValidationError] -> Text
showErrors)
  where
    showErrors :: [CustomTypeValidationError] -> Text
    showErrors :: [CustomTypeValidationError] -> Text
showErrors [CustomTypeValidationError]
allErrors =
      Text
"validation for the given custom types failed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reasonsMessage
      where
        reasonsMessage :: Text
reasonsMessage = case [CustomTypeValidationError]
allErrors of
          [CustomTypeValidationError
singleError] -> Text
"because " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CustomTypeValidationError -> Text
showCustomTypeValidationError CustomTypeValidationError
singleError
          [CustomTypeValidationError]
_ ->
            Text
"for the following reasons:\n"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines
                ((CustomTypeValidationError -> Text)
-> [CustomTypeValidationError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  • " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (CustomTypeValidationError -> Text)
-> CustomTypeValidationError
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomTypeValidationError -> Text
showCustomTypeValidationError) [CustomTypeValidationError]
allErrors)

{- Note [Postgres scalars in custom types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It’s very convenient to be able to reference Postgres scalars in custom type
definitions. For example, we might have a type like this:

    type User {
      id: uuid!
      name: String!
      location: geography
    }

The uuid and geography types are Postgres scalars, not separately-defined
GraphQL types. To support this, we have to take a few extra steps:

  1. The set of Postgres base types is not fixed; extensions like PostGIS add
     new ones, and users can even define their own. Therefore, we fetch the
     currently defined base types from the @pg_catalog.pg_type@ system table as part of
     loading the metadata.

  2. It’s possible for a custom type definition to use a type that doesn’t
     appear elsewhere in the GraphQL schema, so we record which base types were
     referenced while validating the custom type definitions and make sure to
     include them in the generated schema explicitly.

We currently have no plan to extend that functionality to other backends; if we
do, we will probably choose to prefix such types with an explicit tag to avoid
having to disambiguate type names across backends.
-}

-- | Validate the custom types and return any reused Postgres base types (as
-- scalars).
validateCustomTypeDefinitions ::
  forall m.
  (MonadValidate [CustomTypeValidationError] m) =>
  SourceCache ->
  CustomTypes ->
  -- | A map that, to each backend, associates the set of all its scalars.
  BackendMap ScalarParsingMap ->
  m AnnotatedCustomTypes
validateCustomTypeDefinitions :: forall (m :: * -> *).
MonadValidate [CustomTypeValidationError] m =>
SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> m AnnotatedCustomTypes
validateCustomTypeDefinitions SourceCache
sources CustomTypes
customTypes BackendMap ScalarParsingMap
allScalars = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Name -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Name
duplicateTypes) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ HashSet Name -> CustomTypeValidationError
DuplicateTypeNames HashSet Name
duplicateTypes
  (EnumTypeDefinition -> m ()) -> [EnumTypeDefinition] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ EnumTypeDefinition -> m ()
validateEnum [EnumTypeDefinition]
enumDefinitions
  HashMap Name AnnotatedScalarType
reusedScalars <- WriterT (HashMap Name AnnotatedScalarType) m ()
-> m (HashMap Name AnnotatedScalarType)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT (HashMap Name AnnotatedScalarType) m ()
 -> m (HashMap Name AnnotatedScalarType))
-> WriterT (HashMap Name AnnotatedScalarType) m ()
-> m (HashMap Name AnnotatedScalarType)
forall a b. (a -> b) -> a -> b
$ (InputObjectTypeDefinition
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> [InputObjectTypeDefinition]
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ InputObjectTypeDefinition
-> WriterT (HashMap Name AnnotatedScalarType) m ()
validateInputObject [InputObjectTypeDefinition]
inputObjectDefinitions
  HashMap Name AnnotatedObjectType
annotatedObjects <-
    (AnnotatedObjectType -> Name)
-> [AnnotatedObjectType] -> HashMap Name AnnotatedObjectType
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL (ObjectTypeName -> Name
unObjectTypeName (ObjectTypeName -> Name)
-> (AnnotatedObjectType -> ObjectTypeName)
-> AnnotatedObjectType
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedObjectType -> ObjectTypeName
_aotName)
      ([AnnotatedObjectType] -> HashMap Name AnnotatedObjectType)
-> m [AnnotatedObjectType] -> m (HashMap Name AnnotatedObjectType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectTypeDefinition -> m AnnotatedObjectType)
-> [ObjectTypeDefinition] -> m [AnnotatedObjectType]
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 ObjectTypeDefinition -> m AnnotatedObjectType
validateObject [ObjectTypeDefinition]
objectDefinitions
  let scalarTypeMap :: HashMap Name AnnotatedInputType
scalarTypeMap =
        (AnnotatedScalarType -> AnnotatedInputType)
-> HashMap Name AnnotatedScalarType
-> HashMap Name AnnotatedInputType
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map AnnotatedScalarType -> AnnotatedInputType
NOCTScalar
          (HashMap Name AnnotatedScalarType
 -> HashMap Name AnnotatedInputType)
-> HashMap Name AnnotatedScalarType
-> HashMap Name AnnotatedInputType
forall a b. (a -> b) -> a -> b
$ (ScalarTypeDefinition -> AnnotatedScalarType)
-> HashMap Name ScalarTypeDefinition
-> HashMap Name AnnotatedScalarType
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map ScalarTypeDefinition -> AnnotatedScalarType
ASTCustom HashMap Name ScalarTypeDefinition
scalarTypes
          HashMap Name AnnotatedScalarType
-> HashMap Name AnnotatedScalarType
-> HashMap Name AnnotatedScalarType
forall a. Semigroup a => a -> a -> a
<> HashMap Name AnnotatedScalarType
reusedScalars
      enumTypeMap :: HashMap Name AnnotatedInputType
enumTypeMap = (EnumTypeDefinition -> AnnotatedInputType)
-> HashMap Name EnumTypeDefinition
-> HashMap Name AnnotatedInputType
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map EnumTypeDefinition -> AnnotatedInputType
NOCTEnum HashMap Name EnumTypeDefinition
enumTypes
      inputObjectTypeMap :: HashMap Name AnnotatedInputType
inputObjectTypeMap = (InputObjectTypeDefinition -> AnnotatedInputType)
-> HashMap Name InputObjectTypeDefinition
-> HashMap Name AnnotatedInputType
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map InputObjectTypeDefinition -> AnnotatedInputType
NOCTInputObject HashMap Name InputObjectTypeDefinition
inputObjectTypes
      nonObjectTypeMap :: HashMap Name AnnotatedInputType
nonObjectTypeMap = HashMap Name AnnotatedInputType
scalarTypeMap HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
forall a. Semigroup a => a -> a -> a
<> HashMap Name AnnotatedInputType
enumTypeMap HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
forall a. Semigroup a => a -> a -> a
<> HashMap Name AnnotatedInputType
inputObjectTypeMap
  AnnotatedCustomTypes -> m AnnotatedCustomTypes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedCustomTypes -> m AnnotatedCustomTypes)
-> AnnotatedCustomTypes -> m AnnotatedCustomTypes
forall a b. (a -> b) -> a -> b
$ HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedObjectType -> AnnotatedCustomTypes
AnnotatedCustomTypes HashMap Name AnnotatedInputType
nonObjectTypeMap HashMap Name AnnotatedObjectType
annotatedObjects
  where
    inputObjectDefinitions :: [InputObjectTypeDefinition]
inputObjectDefinitions = CustomTypes -> [InputObjectTypeDefinition]
_ctInputObjects CustomTypes
customTypes
    objectDefinitions :: [ObjectTypeDefinition]
objectDefinitions = CustomTypes -> [ObjectTypeDefinition]
_ctObjects CustomTypes
customTypes
    scalarDefinitions :: [ScalarTypeDefinition]
scalarDefinitions = CustomTypes -> [ScalarTypeDefinition]
_ctScalars CustomTypes
customTypes
    enumDefinitions :: [EnumTypeDefinition]
enumDefinitions = CustomTypes -> [EnumTypeDefinition]
_ctEnums CustomTypes
customTypes

    duplicateTypes :: HashSet Name
duplicateTypes = [Name] -> HashSet Name
forall a. Hashable a => [a] -> HashSet a
L.duplicates [Name]
allTypes
    allTypes :: [Name]
allTypes =
      (ScalarTypeDefinition -> Name) -> [ScalarTypeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ScalarTypeDefinition -> Name
_stdName [ScalarTypeDefinition]
scalarDefinitions
        [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> (EnumTypeDefinition -> Name) -> [EnumTypeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (EnumTypeName -> Name
unEnumTypeName (EnumTypeName -> Name)
-> (EnumTypeDefinition -> EnumTypeName)
-> EnumTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumTypeDefinition -> EnumTypeName
_etdName) [EnumTypeDefinition]
enumDefinitions
        [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> (InputObjectTypeDefinition -> Name)
-> [InputObjectTypeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (InputObjectTypeName -> Name
unInputObjectTypeName (InputObjectTypeName -> Name)
-> (InputObjectTypeDefinition -> InputObjectTypeName)
-> InputObjectTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputObjectTypeDefinition -> InputObjectTypeName
_iotdName) [InputObjectTypeDefinition]
inputObjectDefinitions
        [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> (ObjectTypeDefinition -> Name) -> [ObjectTypeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ObjectTypeName -> Name
unObjectTypeName (ObjectTypeName -> Name)
-> (ObjectTypeDefinition -> ObjectTypeName)
-> ObjectTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectTypeDefinition -> ObjectTypeName
_otdName) [ObjectTypeDefinition]
objectDefinitions

    scalarTypes :: HashMap Name ScalarTypeDefinition
scalarTypes =
      (ScalarTypeDefinition -> Name)
-> [ScalarTypeDefinition] -> HashMap Name ScalarTypeDefinition
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL ScalarTypeDefinition -> Name
_stdName [ScalarTypeDefinition]
scalarDefinitions HashMap Name ScalarTypeDefinition
-> HashMap Name ScalarTypeDefinition
-> HashMap Name ScalarTypeDefinition
forall a. Semigroup a => a -> a -> a
<> HashMap Name ScalarTypeDefinition
defaultGraphQLScalars

    enumTypes :: HashMap Name EnumTypeDefinition
enumTypes =
      (EnumTypeDefinition -> Name)
-> [EnumTypeDefinition] -> HashMap Name EnumTypeDefinition
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL (EnumTypeName -> Name
unEnumTypeName (EnumTypeName -> Name)
-> (EnumTypeDefinition -> EnumTypeName)
-> EnumTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumTypeDefinition -> EnumTypeName
_etdName) [EnumTypeDefinition]
enumDefinitions

    objectTypes :: HashMap Name ObjectTypeDefinition
objectTypes =
      (ObjectTypeDefinition -> Name)
-> [ObjectTypeDefinition] -> HashMap Name ObjectTypeDefinition
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL (ObjectTypeName -> Name
unObjectTypeName (ObjectTypeName -> Name)
-> (ObjectTypeDefinition -> ObjectTypeName)
-> ObjectTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectTypeDefinition -> ObjectTypeName
_otdName) [ObjectTypeDefinition]
objectDefinitions

    inputObjectTypes :: HashMap Name InputObjectTypeDefinition
inputObjectTypes =
      (InputObjectTypeDefinition -> Name)
-> [InputObjectTypeDefinition]
-> HashMap Name InputObjectTypeDefinition
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL (InputObjectTypeName -> Name
unInputObjectTypeName (InputObjectTypeName -> Name)
-> (InputObjectTypeDefinition -> InputObjectTypeName)
-> InputObjectTypeDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputObjectTypeDefinition -> InputObjectTypeName
_iotdName) [InputObjectTypeDefinition]
inputObjectDefinitions

    validateEnum ::
      EnumTypeDefinition -> m ()
    validateEnum :: EnumTypeDefinition -> m ()
validateEnum EnumTypeDefinition
enumDefinition = do
      let duplicateEnumValues :: HashSet EnumValue
duplicateEnumValues =
            [EnumValue] -> HashSet EnumValue
forall a. Hashable a => [a] -> HashSet a
L.duplicates
              ([EnumValue] -> HashSet EnumValue)
-> [EnumValue] -> HashSet EnumValue
forall a b. (a -> b) -> a -> b
$ (EnumValueDefinition -> EnumValue)
-> [EnumValueDefinition] -> [EnumValue]
forall a b. (a -> b) -> [a] -> [b]
map EnumValueDefinition -> EnumValue
_evdValue
              ([EnumValueDefinition] -> [EnumValue])
-> [EnumValueDefinition] -> [EnumValue]
forall a b. (a -> b) -> a -> b
$ NonEmpty EnumValueDefinition -> [EnumValueDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
              (NonEmpty EnumValueDefinition -> [EnumValueDefinition])
-> NonEmpty EnumValueDefinition -> [EnumValueDefinition]
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> NonEmpty EnumValueDefinition
_etdValues EnumTypeDefinition
enumDefinition
      -- check for duplicate field names
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet EnumValue -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet EnumValue
duplicateEnumValues)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
        ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ EnumTypeName -> HashSet EnumValue -> CustomTypeValidationError
DuplicateEnumValues
          (EnumTypeDefinition -> EnumTypeName
_etdName EnumTypeDefinition
enumDefinition)
          HashSet EnumValue
duplicateEnumValues

    validateInputObject ::
      InputObjectTypeDefinition -> WriterT (HashMap.HashMap G.Name AnnotatedScalarType) m ()
    validateInputObject :: InputObjectTypeDefinition
-> WriterT (HashMap Name AnnotatedScalarType) m ()
validateInputObject InputObjectTypeDefinition
inputObjectDefinition = do
      let inputObjectTypeName :: InputObjectTypeName
inputObjectTypeName = InputObjectTypeDefinition -> InputObjectTypeName
_iotdName InputObjectTypeDefinition
inputObjectDefinition
          duplicateFieldNames :: HashSet InputObjectFieldName
duplicateFieldNames =
            [InputObjectFieldName] -> HashSet InputObjectFieldName
forall a. Hashable a => [a] -> HashSet a
L.duplicates
              ([InputObjectFieldName] -> HashSet InputObjectFieldName)
-> [InputObjectFieldName] -> HashSet InputObjectFieldName
forall a b. (a -> b) -> a -> b
$ (InputObjectFieldDefinition -> InputObjectFieldName)
-> [InputObjectFieldDefinition] -> [InputObjectFieldName]
forall a b. (a -> b) -> [a] -> [b]
map InputObjectFieldDefinition -> InputObjectFieldName
_iofdName
              ([InputObjectFieldDefinition] -> [InputObjectFieldName])
-> [InputObjectFieldDefinition] -> [InputObjectFieldName]
forall a b. (a -> b) -> a -> b
$ NonEmpty InputObjectFieldDefinition -> [InputObjectFieldDefinition]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
              (NonEmpty InputObjectFieldDefinition
 -> [InputObjectFieldDefinition])
-> NonEmpty InputObjectFieldDefinition
-> [InputObjectFieldDefinition]
forall a b. (a -> b) -> a -> b
$ InputObjectTypeDefinition -> NonEmpty InputObjectFieldDefinition
_iotdFields InputObjectTypeDefinition
inputObjectDefinition

      -- check for duplicate field names
      Bool
-> WriterT (HashMap Name AnnotatedScalarType) m ()
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet InputObjectFieldName -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet InputObjectFieldName
duplicateFieldNames)
        (WriterT (HashMap Name AnnotatedScalarType) m ()
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> WriterT (HashMap Name AnnotatedScalarType) m ()
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError]
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
        ([CustomTypeValidationError]
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> [CustomTypeValidationError]
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ InputObjectTypeName
-> HashSet InputObjectFieldName -> CustomTypeValidationError
InputObjectDuplicateFields
          InputObjectTypeName
inputObjectTypeName
          HashSet InputObjectFieldName
duplicateFieldNames

      let mapToSet :: HashMap Name v -> HashSet Name
mapToSet = [Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Name] -> HashSet Name)
-> (HashMap Name v -> [Name]) -> HashMap Name v -> HashSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name v -> [Name]
forall k v. HashMap k v -> [k]
HashMap.keys
          inputTypes :: HashSet Name
inputTypes =
            HashMap Name ScalarTypeDefinition -> HashSet Name
forall {v}. HashMap Name v -> HashSet Name
mapToSet HashMap Name ScalarTypeDefinition
scalarTypes HashSet Name -> HashSet Name -> HashSet Name
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`Set.union` HashMap Name EnumTypeDefinition -> HashSet Name
forall {v}. HashMap Name v -> HashSet Name
mapToSet HashMap Name EnumTypeDefinition
enumTypes HashSet Name -> HashSet Name -> HashSet Name
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`Set.union` HashMap Name InputObjectTypeDefinition -> HashSet Name
forall {v}. HashMap Name v -> HashSet Name
mapToSet HashMap Name InputObjectTypeDefinition
inputObjectTypes

      -- check that fields reference input types
      NonEmpty InputObjectFieldDefinition
-> (InputObjectFieldDefinition
    -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InputObjectTypeDefinition -> NonEmpty InputObjectFieldDefinition
_iotdFields InputObjectTypeDefinition
inputObjectDefinition) ((InputObjectFieldDefinition
  -> WriterT (HashMap Name AnnotatedScalarType) m ())
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> (InputObjectFieldDefinition
    -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a b. (a -> b) -> a -> b
$ \InputObjectFieldDefinition
inputObjectField -> do
        let fieldBaseType :: Name
fieldBaseType = GType -> Name
G.getBaseType (GType -> Name) -> GType -> Name
forall a b. (a -> b) -> a -> b
$ GraphQLType -> GType
unGraphQLType (GraphQLType -> GType) -> GraphQLType -> GType
forall a b. (a -> b) -> a -> b
$ InputObjectFieldDefinition -> GraphQLType
_iofdType InputObjectFieldDefinition
inputObjectField
        if
          | Name -> HashSet Name -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member Name
fieldBaseType HashSet Name
inputTypes -> () -> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a. a -> WriterT (HashMap Name AnnotatedScalarType) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Just AnnotatedScalarType
scalarInfo <- BackendMap ScalarParsingMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarParsingMap
allScalars Name
fieldBaseType ->
              HashMap Name AnnotatedScalarType
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (HashMap Name AnnotatedScalarType
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> HashMap Name AnnotatedScalarType
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a b. (a -> b) -> a -> b
$ Name -> AnnotatedScalarType -> HashMap Name AnnotatedScalarType
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
fieldBaseType AnnotatedScalarType
scalarInfo
          | Bool
otherwise ->
              [CustomTypeValidationError]
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a.
[CustomTypeValidationError]
-> WriterT (HashMap Name AnnotatedScalarType) m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
                ([CustomTypeValidationError]
 -> WriterT (HashMap Name AnnotatedScalarType) m ())
-> [CustomTypeValidationError]
-> WriterT (HashMap Name AnnotatedScalarType) m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ InputObjectTypeName
-> InputObjectFieldName -> Name -> CustomTypeValidationError
InputObjectFieldTypeDoesNotExist
                  (InputObjectTypeDefinition -> InputObjectTypeName
_iotdName InputObjectTypeDefinition
inputObjectDefinition)
                  (InputObjectFieldDefinition -> InputObjectFieldName
_iofdName InputObjectFieldDefinition
inputObjectField)
                  Name
fieldBaseType

    validateObject ::
      ObjectTypeDefinition -> m AnnotatedObjectType
    validateObject :: ObjectTypeDefinition -> m AnnotatedObjectType
validateObject ObjectTypeDefinition {[TypeRelationshipDefinition]
Maybe Description
NonEmpty (ObjectFieldDefinition GraphQLType)
ObjectTypeName
_otdName :: ObjectTypeDefinition -> ObjectTypeName
_otdName :: ObjectTypeName
_otdDescription :: Maybe Description
_otdFields :: NonEmpty (ObjectFieldDefinition GraphQLType)
_otdRelationships :: [TypeRelationshipDefinition]
_otdDescription :: ObjectTypeDefinition -> Maybe Description
_otdFields :: ObjectTypeDefinition
-> NonEmpty (ObjectFieldDefinition GraphQLType)
_otdRelationships :: ObjectTypeDefinition -> [TypeRelationshipDefinition]
..} = do
      let fieldNames :: [Name]
fieldNames =
            (ObjectFieldDefinition GraphQLType -> Name)
-> [ObjectFieldDefinition GraphQLType] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ObjectFieldName -> Name
unObjectFieldName (ObjectFieldName -> Name)
-> (ObjectFieldDefinition GraphQLType -> ObjectFieldName)
-> ObjectFieldDefinition GraphQLType
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectFieldDefinition GraphQLType -> ObjectFieldName
forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName)
              ([ObjectFieldDefinition GraphQLType] -> [Name])
-> [ObjectFieldDefinition GraphQLType] -> [Name]
forall a b. (a -> b) -> a -> b
$ NonEmpty (ObjectFieldDefinition GraphQLType)
-> [ObjectFieldDefinition GraphQLType]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (ObjectFieldDefinition GraphQLType)
_otdFields
          relNames :: [Name]
relNames = (TypeRelationshipDefinition -> Name)
-> [TypeRelationshipDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (RelationshipName -> Name
unRelationshipName (RelationshipName -> Name)
-> (TypeRelationshipDefinition -> RelationshipName)
-> TypeRelationshipDefinition
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRelationshipDefinition -> RelationshipName
_trdName) [TypeRelationshipDefinition]
_otdRelationships
          duplicateFieldNames :: HashSet Name
duplicateFieldNames = [Name] -> HashSet Name
forall a. Hashable a => [a] -> HashSet a
L.duplicates ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ [Name]
fieldNames [Name] -> [Name] -> [Name]
forall a. Semigroup a => a -> a -> a
<> [Name]
relNames

      -- check for duplicate field names
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Name -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet Name
duplicateFieldNames)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
        ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName -> HashSet Name -> CustomTypeValidationError
ObjectDuplicateFields ObjectTypeName
_otdName HashSet Name
duplicateFieldNames

      NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
fields <- NonEmpty (ObjectFieldDefinition GraphQLType)
-> (ObjectFieldDefinition GraphQLType
    -> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
-> m (NonEmpty
        (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty (ObjectFieldDefinition GraphQLType)
_otdFields ((ObjectFieldDefinition GraphQLType
  -> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
 -> m (NonEmpty
         (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))))
-> (ObjectFieldDefinition GraphQLType
    -> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
-> m (NonEmpty
        (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
forall a b. (a -> b) -> a -> b
$ \ObjectFieldDefinition GraphQLType
objectField -> do
        let fieldName :: ObjectFieldName
fieldName = ObjectFieldDefinition GraphQLType -> ObjectFieldName
forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName ObjectFieldDefinition GraphQLType
objectField
        -- check that arguments are not defined
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ ObjectFieldDefinition GraphQLType -> Maybe Value
forall field. ObjectFieldDefinition field -> Maybe Value
_ofdArguments ObjectFieldDefinition GraphQLType
objectField)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
          ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName -> ObjectFieldName -> CustomTypeValidationError
ObjectFieldArgumentsNotAllowed
            ObjectTypeName
_otdName
            ObjectFieldName
fieldName

        ObjectFieldDefinition GraphQLType
-> (GraphQLType -> m (GType, AnnotatedObjectFieldType))
-> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ObjectFieldDefinition GraphQLType
objectField ((GraphQLType -> m (GType, AnnotatedObjectFieldType))
 -> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)))
-> (GraphQLType -> m (GType, AnnotatedObjectFieldType))
-> m (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
forall a b. (a -> b) -> a -> b
$ \GraphQLType
fieldType -> do
          let fieldBaseType :: Name
fieldBaseType = GType -> Name
G.getBaseType (GType -> Name) -> GType -> Name
forall a b. (a -> b) -> a -> b
$ GraphQLType -> GType
unGraphQLType GraphQLType
fieldType
          AnnotatedObjectFieldType
annotatedObjectFieldType <-
            if
              | Just ScalarTypeDefinition
scalarDef <- Name
-> HashMap Name ScalarTypeDefinition -> Maybe ScalarTypeDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldBaseType HashMap Name ScalarTypeDefinition
scalarTypes ->
                  AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedObjectFieldType -> m AnnotatedObjectFieldType)
-> AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> AnnotatedObjectFieldType
AOFTScalar (AnnotatedScalarType -> AnnotatedObjectFieldType)
-> AnnotatedScalarType -> AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ ScalarTypeDefinition -> AnnotatedScalarType
ASTCustom ScalarTypeDefinition
scalarDef
              | Just EnumTypeDefinition
enumDef <- Name -> HashMap Name EnumTypeDefinition -> Maybe EnumTypeDefinition
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldBaseType HashMap Name EnumTypeDefinition
enumTypes ->
                  AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedObjectFieldType -> m AnnotatedObjectFieldType)
-> AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> AnnotatedObjectFieldType
AOFTEnum EnumTypeDefinition
enumDef
              | Name -> HashMap Name ObjectTypeDefinition -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Name
fieldBaseType HashMap Name ObjectTypeDefinition
objectTypes ->
                  AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedObjectFieldType -> m AnnotatedObjectFieldType)
-> AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ Name -> AnnotatedObjectFieldType
AOFTObject Name
fieldBaseType
              | Just AnnotatedScalarType
scalarInfo <- BackendMap ScalarParsingMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarParsingMap
allScalars Name
fieldBaseType ->
                  AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedObjectFieldType -> m AnnotatedObjectFieldType)
-> AnnotatedObjectFieldType -> m AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> AnnotatedObjectFieldType
AOFTScalar AnnotatedScalarType
scalarInfo
              | Bool
otherwise ->
                  [CustomTypeValidationError] -> m AnnotatedObjectFieldType
forall a. [CustomTypeValidationError] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
                    ([CustomTypeValidationError] -> m AnnotatedObjectFieldType)
-> [CustomTypeValidationError] -> m AnnotatedObjectFieldType
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> ObjectFieldName -> Name -> CustomTypeValidationError
ObjectFieldTypeDoesNotExist
                      ObjectTypeName
_otdName
                      ObjectFieldName
fieldName
                      Name
fieldBaseType
          (GType, AnnotatedObjectFieldType)
-> m (GType, AnnotatedObjectFieldType)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphQLType -> GType
unGraphQLType GraphQLType
fieldType, AnnotatedObjectFieldType
annotatedObjectFieldType)

      let fieldsMap :: HashMap ObjectFieldName GType
fieldsMap =
            [(ObjectFieldName, GType)] -> HashMap ObjectFieldName GType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
              ([(ObjectFieldName, GType)] -> HashMap ObjectFieldName GType)
-> [(ObjectFieldName, GType)] -> HashMap ObjectFieldName GType
forall a b. (a -> b) -> a -> b
$ (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
 -> (ObjectFieldName, GType))
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> [(ObjectFieldName, GType)]
forall a b. (a -> b) -> [a] -> [b]
map (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> ObjectFieldName
forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
 -> ObjectFieldName)
-> (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
    -> GType)
-> ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> (ObjectFieldName, GType)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((GType, AnnotatedObjectFieldType) -> GType
forall a b. (a, b) -> a
fst ((GType, AnnotatedObjectFieldType) -> GType)
-> (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
    -> (GType, AnnotatedObjectFieldType))
-> ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> GType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> (GType, AnnotatedObjectFieldType)
forall field. ObjectFieldDefinition field -> field
_ofdType))
              ([ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
 -> [(ObjectFieldName, GType)])
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> [(ObjectFieldName, GType)]
forall a b. (a -> b) -> a -> b
$ NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
fields

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HashSet SourceName -> Int
forall a. HashSet a -> Int
Set.size ([SourceName] -> HashSet SourceName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([SourceName] -> HashSet SourceName)
-> [SourceName] -> HashSet SourceName
forall a b. (a -> b) -> a -> b
$ TypeRelationshipDefinition -> SourceName
_trdSource (TypeRelationshipDefinition -> SourceName)
-> [TypeRelationshipDefinition] -> [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeRelationshipDefinition]
_otdRelationships) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall a. [CustomTypeValidationError] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
        ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName -> CustomTypeValidationError
ObjectRelationshipMultiSources ObjectTypeName
_otdName
      [AnnotatedTypeRelationship]
annotatedRelationships <- [TypeRelationshipDefinition]
-> (TypeRelationshipDefinition -> m AnnotatedTypeRelationship)
-> m [AnnotatedTypeRelationship]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [TypeRelationshipDefinition]
_otdRelationships ((TypeRelationshipDefinition -> m AnnotatedTypeRelationship)
 -> m [AnnotatedTypeRelationship])
-> (TypeRelationshipDefinition -> m AnnotatedTypeRelationship)
-> m [AnnotatedTypeRelationship]
forall a b. (a -> b) -> a -> b
$ \TypeRelationshipDefinition {HashMap ObjectFieldName PGCol
SourceName
RelType
QualifiedTable
RelationshipName
_trdName :: TypeRelationshipDefinition -> RelationshipName
_trdSource :: TypeRelationshipDefinition -> SourceName
_trdName :: RelationshipName
_trdType :: RelType
_trdSource :: SourceName
_trdRemoteTable :: QualifiedTable
_trdFieldMapping :: HashMap ObjectFieldName PGCol
_trdType :: TypeRelationshipDefinition -> RelType
_trdRemoteTable :: TypeRelationshipDefinition -> QualifiedTable
_trdFieldMapping :: TypeRelationshipDefinition -> HashMap ObjectFieldName PGCol
..} -> do
        -- get the source info
        SourceInfo {Maybe QueryTagsConfig
TableCache ('Postgres 'Vanilla)
FunctionCache ('Postgres 'Vanilla)
StoredProcedureCache ('Postgres 'Vanilla)
LogicalModelCache ('Postgres 'Vanilla)
NativeQueryCache ('Postgres 'Vanilla)
BackendSourceKind ('Postgres 'Vanilla)
SourceName
SourceConfig ('Postgres 'Vanilla)
ResolvedSourceCustomization
DBObjectsIntrospection ('Postgres 'Vanilla)
_siName :: SourceName
_siSourceKind :: BackendSourceKind ('Postgres 'Vanilla)
_siTables :: TableCache ('Postgres 'Vanilla)
_siFunctions :: FunctionCache ('Postgres 'Vanilla)
_siNativeQueries :: NativeQueryCache ('Postgres 'Vanilla)
_siStoredProcedures :: StoredProcedureCache ('Postgres 'Vanilla)
_siLogicalModels :: LogicalModelCache ('Postgres 'Vanilla)
_siConfiguration :: SourceConfig ('Postgres 'Vanilla)
_siQueryTagsConfig :: Maybe QueryTagsConfig
_siCustomization :: ResolvedSourceCustomization
_siDbObjectsIntrospection :: DBObjectsIntrospection ('Postgres 'Vanilla)
_siName :: forall (b :: BackendType). SourceInfo b -> SourceName
_siSourceKind :: forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siFunctions :: forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siNativeQueries :: forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siStoredProcedures :: forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> DBObjectsIntrospection b
..} <-
          Maybe (SourceInfo ('Postgres 'Vanilla))
-> m (SourceInfo ('Postgres 'Vanilla))
-> m (SourceInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (BackendSourceInfo -> Maybe (SourceInfo ('Postgres 'Vanilla))
forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo (BackendSourceInfo -> Maybe (SourceInfo ('Postgres 'Vanilla)))
-> Maybe BackendSourceInfo
-> Maybe (SourceInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
_trdSource SourceCache
sources)
            (m (SourceInfo ('Postgres 'Vanilla))
 -> m (SourceInfo ('Postgres 'Vanilla)))
-> m (SourceInfo ('Postgres 'Vanilla))
-> m (SourceInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m (SourceInfo ('Postgres 'Vanilla))
forall a. [CustomTypeValidationError] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
            ([CustomTypeValidationError]
 -> m (SourceInfo ('Postgres 'Vanilla)))
-> [CustomTypeValidationError]
-> m (SourceInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> RelationshipName -> QualifiedTable -> CustomTypeValidationError
ObjectRelationshipTableDoesNotExist
              ObjectTypeName
_otdName
              RelationshipName
_trdName
              QualifiedTable
_trdRemoteTable

        -- check that the table exists
        TableInfo ('Postgres 'Vanilla)
remoteTableInfo <-
          Maybe (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (QualifiedTable
-> HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
-> Maybe (TableInfo ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup QualifiedTable
_trdRemoteTable TableCache ('Postgres 'Vanilla)
HashMap QualifiedTable (TableInfo ('Postgres 'Vanilla))
_siTables)
            (m (TableInfo ('Postgres 'Vanilla))
 -> m (TableInfo ('Postgres 'Vanilla)))
-> m (TableInfo ('Postgres 'Vanilla))
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m (TableInfo ('Postgres 'Vanilla))
forall a. [CustomTypeValidationError] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
            ([CustomTypeValidationError] -> m (TableInfo ('Postgres 'Vanilla)))
-> [CustomTypeValidationError]
-> m (TableInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> RelationshipName -> QualifiedTable -> CustomTypeValidationError
ObjectRelationshipTableDoesNotExist
              ObjectTypeName
_otdName
              RelationshipName
_trdName
              QualifiedTable
_trdRemoteTable

        -- check that the column mapping is sane
        HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
annotatedFieldMapping <- ((ObjectFieldName -> PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
 -> HashMap ObjectFieldName PGCol
 -> m (HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))))
-> HashMap ObjectFieldName PGCol
-> (ObjectFieldName
    -> PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
-> m (HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ObjectFieldName -> PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
-> HashMap ObjectFieldName PGCol
-> m (HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla)))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey HashMap ObjectFieldName PGCol
_trdFieldMapping
          ((ObjectFieldName -> PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
 -> m (HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))))
-> (ObjectFieldName
    -> PGCol -> m (ColumnInfo ('Postgres 'Vanilla)))
-> m (HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla)))
forall a b. (a -> b) -> a -> b
$ \ObjectFieldName
fieldName PGCol
columnName -> do
            case ObjectFieldName -> HashMap ObjectFieldName GType -> Maybe GType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ObjectFieldName
fieldName HashMap ObjectFieldName GType
fieldsMap of
              Maybe GType
Nothing ->
                [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
                  ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> RelationshipName -> ObjectFieldName -> CustomTypeValidationError
ObjectRelationshipFieldDoesNotExist
                    ObjectTypeName
_otdName
                    RelationshipName
_trdName
                    ObjectFieldName
fieldName
              Just GType
fieldType ->
                -- the field should be a non-list type scalar
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GType -> Bool
G.isListType GType
fieldType)
                  (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
                  ([CustomTypeValidationError] -> m ())
-> [CustomTypeValidationError] -> m ()
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> RelationshipName -> ObjectFieldName -> CustomTypeValidationError
ObjectRelationshipFieldListType
                    ObjectTypeName
_otdName
                    RelationshipName
_trdName
                    ObjectFieldName
fieldName

            -- the column should be a column of the table
            Maybe (ColumnInfo ('Postgres 'Vanilla))
-> m (ColumnInfo ('Postgres 'Vanilla))
-> m (ColumnInfo ('Postgres 'Vanilla))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (TableInfo ('Postgres 'Vanilla)
-> FieldName -> Maybe (ColumnInfo ('Postgres 'Vanilla))
forall (b :: BackendType).
TableInfo b -> FieldName -> Maybe (ColumnInfo b)
getColumnInfoM TableInfo ('Postgres 'Vanilla)
remoteTableInfo (forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @('Postgres 'Vanilla) Column ('Postgres 'Vanilla)
PGCol
columnName))
              (m (ColumnInfo ('Postgres 'Vanilla))
 -> m (ColumnInfo ('Postgres 'Vanilla)))
-> m (ColumnInfo ('Postgres 'Vanilla))
-> m (ColumnInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ [CustomTypeValidationError] -> m (ColumnInfo ('Postgres 'Vanilla))
forall a. [CustomTypeValidationError] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
              ([CustomTypeValidationError]
 -> m (ColumnInfo ('Postgres 'Vanilla)))
-> [CustomTypeValidationError]
-> m (ColumnInfo ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ CustomTypeValidationError -> [CustomTypeValidationError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (CustomTypeValidationError -> [CustomTypeValidationError])
-> CustomTypeValidationError -> [CustomTypeValidationError]
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> RelationshipName
-> QualifiedTable
-> PGCol
-> CustomTypeValidationError
ObjectRelationshipColumnDoesNotExist ObjectTypeName
_otdName RelationshipName
_trdName QualifiedTable
_trdRemoteTable PGCol
columnName

        AnnotatedTypeRelationship -> m AnnotatedTypeRelationship
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (AnnotatedTypeRelationship -> m AnnotatedTypeRelationship)
-> AnnotatedTypeRelationship -> m AnnotatedTypeRelationship
forall a b. (a -> b) -> a -> b
$ RelationshipName
-> RelType
-> SourceName
-> SourceConfig ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
-> AnnotatedTypeRelationship
AnnotatedTypeRelationship
            RelationshipName
_trdName
            RelType
_trdType
            SourceName
_siName
            SourceConfig ('Postgres 'Vanilla)
_siConfiguration
            (TableInfo ('Postgres 'Vanilla) -> TableName ('Postgres 'Vanilla)
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo ('Postgres 'Vanilla)
remoteTableInfo)
            HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
annotatedFieldMapping

      AnnotatedObjectType -> m AnnotatedObjectType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (AnnotatedObjectType -> m AnnotatedObjectType)
-> AnnotatedObjectType -> m AnnotatedObjectType
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> Maybe Description
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> [AnnotatedTypeRelationship]
-> AnnotatedObjectType
AnnotatedObjectType
          ObjectTypeName
_otdName
          Maybe Description
_otdDescription
          NonEmpty (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
fields
          [AnnotatedTypeRelationship]
annotatedRelationships

-- see Note [Postgres scalars in custom types]
lookupBackendScalar ::
  BackendMap ScalarParsingMap ->
  G.Name ->
  Maybe AnnotatedScalarType
lookupBackendScalar :: BackendMap ScalarParsingMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarParsingMap
allScalars Name
baseType =
  -- FIXME: this ignores name collisions across backends!
  First AnnotatedScalarType -> Maybe AnnotatedScalarType
forall a. First a -> Maybe a
getFirst (First AnnotatedScalarType -> Maybe AnnotatedScalarType)
-> First AnnotatedScalarType -> Maybe AnnotatedScalarType
forall a b. (a -> b) -> a -> b
$ (AnyBackend ScalarParsingMap -> First AnnotatedScalarType)
-> [AnyBackend ScalarParsingMap] -> First AnnotatedScalarType
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe AnnotatedScalarType -> First AnnotatedScalarType
forall a. Maybe a -> First a
First (Maybe AnnotatedScalarType -> First AnnotatedScalarType)
-> (AnyBackend ScalarParsingMap -> Maybe AnnotatedScalarType)
-> AnyBackend ScalarParsingMap
-> First AnnotatedScalarType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyBackend ScalarParsingMap -> Maybe AnnotatedScalarType
go) ([AnyBackend ScalarParsingMap] -> First AnnotatedScalarType)
-> [AnyBackend ScalarParsingMap] -> First AnnotatedScalarType
forall a b. (a -> b) -> a -> b
$ BackendMap ScalarParsingMap -> [AnyBackend ScalarParsingMap]
forall (i :: BackendType -> *). BackendMap i -> [AnyBackend i]
BackendMap.elems BackendMap ScalarParsingMap
allScalars
  where
    go :: AnyBackend ScalarParsingMap -> Maybe AnnotatedScalarType
go AnyBackend ScalarParsingMap
backendScalars =
      Name -> AnyBackend ScalarWrapper -> AnnotatedScalarType
ASTReusedScalar Name
baseType
        (AnyBackend ScalarWrapper -> AnnotatedScalarType)
-> Maybe (AnyBackend ScalarWrapper) -> Maybe AnnotatedScalarType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: BackendType -> Constraint) (i :: BackendType -> *)
       (j :: BackendType -> *) (f :: * -> *).
(AllBackendsSatisfy c, Functor f) =>
AnyBackend i
-> (forall (b :: BackendType). c b => i b -> f (j b))
-> f (AnyBackend j)
AB.traverseBackend @Backend AnyBackend ScalarParsingMap
backendScalars \(ScalarParsingMap HashMap Name (ScalarWrapper b)
scalarMap :: ScalarParsingMap b) ->
          Name -> HashMap Name (ScalarWrapper b) -> Maybe (ScalarWrapper b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
baseType HashMap Name (ScalarWrapper b)
scalarMap

data CustomTypeValidationError
  = -- | type names have to be unique across all types
    DuplicateTypeNames (Set.HashSet G.Name)
  | -- | field name and the field's base type
    InputObjectFieldTypeDoesNotExist
      InputObjectTypeName
      InputObjectFieldName
      G.Name
  | -- | duplicate field declaration in input objects
    InputObjectDuplicateFields
      InputObjectTypeName
      (Set.HashSet InputObjectFieldName)
  | -- | field name and the field's base type
    ObjectFieldTypeDoesNotExist
      ObjectTypeName
      ObjectFieldName
      G.Name
  | -- | duplicate field declaration in objects
    ObjectDuplicateFields ObjectTypeName (Set.HashSet G.Name)
  | -- | object fields can't have arguments
    ObjectFieldArgumentsNotAllowed ObjectTypeName ObjectFieldName
  | -- | object fields can't have object types as base types
    ObjectFieldObjectBaseType ObjectTypeName ObjectFieldName G.Name
  | -- | The table specified in the relationship does not exist
    ObjectRelationshipTableDoesNotExist
      ObjectTypeName
      RelationshipName
      QualifiedTable
  | -- | The field specified in the relationship mapping does not exist
    ObjectRelationshipFieldDoesNotExist
      ObjectTypeName
      RelationshipName
      ObjectFieldName
  | -- | The field specified in the relationship mapping is a list type
    ObjectRelationshipFieldListType
      ObjectTypeName
      RelationshipName
      ObjectFieldName
  | -- | The column specified in the relationship mapping does not exist
    ObjectRelationshipColumnDoesNotExist
      ObjectTypeName
      RelationshipName
      QualifiedTable
      PGCol
  | -- | Object relationship refers to table in multiple sources
    ObjectRelationshipMultiSources ObjectTypeName
  | -- | duplicate enum values
    DuplicateEnumValues EnumTypeName (Set.HashSet G.EnumValue)
  deriving (Int -> CustomTypeValidationError -> ShowS
[CustomTypeValidationError] -> ShowS
CustomTypeValidationError -> String
(Int -> CustomTypeValidationError -> ShowS)
-> (CustomTypeValidationError -> String)
-> ([CustomTypeValidationError] -> ShowS)
-> Show CustomTypeValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomTypeValidationError -> ShowS
showsPrec :: Int -> CustomTypeValidationError -> ShowS
$cshow :: CustomTypeValidationError -> String
show :: CustomTypeValidationError -> String
$cshowList :: [CustomTypeValidationError] -> ShowS
showList :: [CustomTypeValidationError] -> ShowS
Show, CustomTypeValidationError -> CustomTypeValidationError -> Bool
(CustomTypeValidationError -> CustomTypeValidationError -> Bool)
-> (CustomTypeValidationError -> CustomTypeValidationError -> Bool)
-> Eq CustomTypeValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomTypeValidationError -> CustomTypeValidationError -> Bool
== :: CustomTypeValidationError -> CustomTypeValidationError -> Bool
$c/= :: CustomTypeValidationError -> CustomTypeValidationError -> Bool
/= :: CustomTypeValidationError -> CustomTypeValidationError -> Bool
Eq)

showCustomTypeValidationError ::
  CustomTypeValidationError -> Text
showCustomTypeValidationError :: CustomTypeValidationError -> Text
showCustomTypeValidationError = \case
  DuplicateTypeNames HashSet Name
types ->
    Text
"duplicate type names: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet Name -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet Name
types
  InputObjectFieldTypeDoesNotExist InputObjectTypeName
objType InputObjectFieldName
fieldName Name
fieldTy ->
    Text
"the type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
fieldTy Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for field "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InputObjectFieldName
fieldName InputObjectFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" input object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InputObjectTypeName
objType InputObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  InputObjectDuplicateFields InputObjectTypeName
objType HashSet InputObjectFieldName
fields ->
    Text
"the input object " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InputObjectTypeName
objType InputObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has duplicate fields: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet InputObjectFieldName -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet InputObjectFieldName
fields
  ObjectFieldTypeDoesNotExist ObjectTypeName
objType ObjectFieldName
fieldName Name
fieldTy ->
    Text
"the type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
fieldTy Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for field "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectFieldName
fieldName ObjectFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  ObjectDuplicateFields ObjectTypeName
objType HashSet Name
fields ->
    Text
"the object " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has duplicate fields: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet Name -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet Name
fields
  ObjectFieldArgumentsNotAllowed ObjectTypeName
objType ObjectFieldName
_ ->
    Text
"the object " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" can't have arguments"
  ObjectFieldObjectBaseType ObjectTypeName
objType ObjectFieldName
fieldName Name
fieldType ->
    Text
"the type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
fieldType Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" of the field "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectFieldName
fieldName
        ObjectFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType
        ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is object type which isn't allowed"
  ObjectRelationshipTableDoesNotExist ObjectTypeName
objType RelationshipName
relName QualifiedTable
table ->
    Text
"the remote table "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
table QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for relationship "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelationshipName
relName
        RelationshipName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" of object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType
        ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  ObjectRelationshipFieldDoesNotExist ObjectTypeName
objType RelationshipName
relName ObjectFieldName
fieldName ->
    Text
"the field "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectFieldName
fieldName ObjectFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for relationship "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelationshipName
relName
        RelationshipName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType
        ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  ObjectRelationshipFieldListType ObjectTypeName
objType RelationshipName
relName ObjectFieldName
fieldName ->
    Text
"the type of the field "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectFieldName
fieldName ObjectFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for relationship "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelationshipName
relName
        RelationshipName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType
        ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a list type"
  ObjectRelationshipColumnDoesNotExist ObjectTypeName
objType RelationshipName
relName QualifiedTable
remoteTable PGCol
column ->
    Text
"the column "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGCol
column PGCol -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" of remote table "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
remoteTable
        QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for relationship "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelationshipName
relName
        RelationshipName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" of object type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType
        ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  ObjectRelationshipMultiSources ObjectTypeName
objType ->
    Text
"the object " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ObjectTypeName
objType ObjectTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has relationships refers to tables in multiple sources"
  DuplicateEnumValues EnumTypeName
tyName HashSet EnumValue
values ->
    Text
"the enum type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EnumTypeName
tyName EnumTypeName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has duplicate values: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet EnumValue -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet EnumValue
values