{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides a representation of a @GraphQL@ Schema in addition to
-- functions for defining and manipulating schemas.
module Language.GraphQL.Type.Schema
    ( schema
    , schemaWithTypes
    , module Language.GraphQL.Type.Internal
    ) where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.Type.Internal
    ( Directive(..)
    , Directives
    , Schema
    , Type(..)
    , description
    , directives
    , implementations
    , mutation
    , subscription
    , query
    , types
    )
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Internal as Internal
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out

-- | Schema constructor.
--
-- __Note:__ When the schema is constructed, by default only the types that
-- are reachable by traversing the root types are included, other types must
-- be explicitly referenced using 'schemaWithTypes' instead.
schema :: forall m
    . Out.ObjectType m -- ^ Query type.
    -> Maybe (Out.ObjectType m) -- ^ Mutation type.
    -> Maybe (Out.ObjectType m) -- ^ Subscription type.
    -> Directives -- ^ Directive definitions.
    -> Schema m -- ^ Schema.
schema :: ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> Schema m
schema ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot =
    Maybe Text
-> ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> [Type m]
-> Directives
-> Schema m
forall (m :: * -> *).
Maybe Text
-> ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> [Type m]
-> Directives
-> Schema m
schemaWithTypes Maybe Text
forall a. Maybe a
Nothing ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot [Type m]
forall a. Monoid a => a
mempty

-- | Constructs a complete schema, including user-defined types not referenced
-- in the schema directly (for example interface implementations).
schemaWithTypes :: forall m
    . Maybe Text -- ^ Schema description
    -> Out.ObjectType m -- ^ Query type.
    -> Maybe (Out.ObjectType m) -- ^ Mutation type.
    -> Maybe (Out.ObjectType m) -- ^ Subscription type.
    -> [Type m] -- ^ Additional types.
    -> Directives -- ^ Directive definitions.
    -> Schema m -- ^ Schema.
schemaWithTypes :: Maybe Text
-> ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> [Type m]
-> Directives
-> Schema m
schemaWithTypes Maybe Text
description' ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot [Type m]
types' Directives
directiveDefinitions =
    Maybe Text
-> ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> HashMap Text (Type m)
-> HashMap Text [Type m]
-> Schema m
forall (m :: * -> *).
Maybe Text
-> ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> HashMap Text (Type m)
-> HashMap Text [Type m]
-> Schema m
Internal.Schema Maybe Text
description' ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot
        Directives
allDirectives HashMap Text (Type m)
collectedTypes HashMap Text [Type m]
collectedImplementations
  where
    allTypes :: HashMap Text (Type m)
allTypes = (Type m -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m) -> [Type m] -> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
addTypeDefinition HashMap Text (Type m)
forall k v. HashMap k v
HashMap.empty [Type m]
types'
    addTypeDefinition :: Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
addTypeDefinition type' :: Type m
type'@(ScalarType (Definition.ScalarType Text
typeName Maybe Text
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    addTypeDefinition type' :: Type m
type'@(EnumType (Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    addTypeDefinition type' :: Type m
type'@(ObjectType (Out.ObjectType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    addTypeDefinition type' :: Type m
type'@(InputObjectType (In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    addTypeDefinition type' :: Type m
type'@(InterfaceType (Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    addTypeDefinition type' :: Type m
type'@(UnionType (Out.UnionType Text
typeName Maybe Text
_ [ObjectType m]
_)) HashMap Text (Type m)
accumulator =
        Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
typeName Type m
type' HashMap Text (Type m)
accumulator
    collectedTypes :: HashMap Text (Type m)
collectedTypes = ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
forall (m :: * -> *).
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
collectReferencedTypes ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot HashMap Text (Type m)
allTypes
    collectedImplementations :: HashMap Text [Type m]
collectedImplementations = HashMap Text (Type m) -> HashMap Text [Type m]
forall (m :: * -> *).
HashMap Text (Type m) -> HashMap Text [Type m]
collectImplementations HashMap Text (Type m)
collectedTypes
    allDirectives :: Directives
allDirectives = Directives -> Directives -> Directives
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union Directives
directiveDefinitions Directives
defaultDirectives
    defaultDirectives :: Directives
defaultDirectives = [(Text, Directive)] -> Directives
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        [ (Text
"skip", Directive
skipDirective)
        , (Text
"include", Directive
includeDirective)
        , (Text
"deprecated", Directive
deprecatedDirective)
        ]
    includeDirective :: Directive
includeDirective =
        Maybe Text -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Text
includeDescription [DirectiveLocation]
skipIncludeLocations Arguments
includeArguments
    includeArguments :: Arguments
includeArguments = Text -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"if"
        (Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Type -> Maybe Value -> Argument
In.Argument (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Included when true.") Type
ifType Maybe Value
forall a. Maybe a
Nothing
    includeDescription :: Maybe Text
includeDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just
        Text
"Directs the executor to include this field or fragment only when the \
        \`if` argument is true."
    skipDirective :: Directive
skipDirective = Maybe Text -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Text
skipDescription [DirectiveLocation]
skipIncludeLocations Arguments
skipArguments
    skipArguments :: Arguments
skipArguments = Text -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"if"
        (Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Type -> Maybe Value -> Argument
In.Argument (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"skipped when true.") Type
ifType Maybe Value
forall a. Maybe a
Nothing
    ifType :: Type
ifType = ScalarType -> Type
In.NonNullScalarType ScalarType
Definition.boolean
    skipDescription :: Maybe Text
skipDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just
        Text
"Directs the executor to skip this field or fragment when the `if` \
        \argument is true."
    skipIncludeLocations :: [DirectiveLocation]
skipIncludeLocations =
        [ ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.Field
        , ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.FragmentSpread
        , ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.InlineFragment
        ]
    deprecatedDirective :: Directive
deprecatedDirective =
        Maybe Text -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Text
deprecatedDescription [DirectiveLocation]
deprecatedLocations Arguments
deprecatedArguments
    reasonDescription :: Maybe Text
reasonDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just
        Text
"Explains why this element was deprecated, usually also including a \
        \suggestion for how to access supported similar data. Formatted using \
        \the Markdown syntax, as specified by \
        \[CommonMark](https://commonmark.org/).'"
    deprecatedArguments :: Arguments
deprecatedArguments = Text -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"reason"
        (Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Type -> Maybe Value -> Argument
In.Argument Maybe Text
reasonDescription Type
reasonType
        (Maybe Value -> Argument) -> Maybe Value -> Argument
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
"No longer supported"
    reasonType :: Type
reasonType = ScalarType -> Type
In.NamedScalarType ScalarType
Definition.string
    deprecatedDescription :: Maybe Text
deprecatedDescription = Text -> Maybe Text
forall a. a -> Maybe a
Just
        Text
"Marks an element of a GraphQL schema as no longer supported."
    deprecatedLocations :: [DirectiveLocation]
deprecatedLocations =
        [ TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.FieldDefinition
        , TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.ArgumentDefinition
        , TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.InputFieldDefinition
        , TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.EnumValue
        ]

-- | Traverses the schema and finds all referenced types.
collectReferencedTypes :: forall m
    . Out.ObjectType m
    -> Maybe (Out.ObjectType m)
    -> Maybe (Out.ObjectType m)
    -> HashMap Full.Name (Type m)
    -> HashMap Full.Name (Type m)
collectReferencedTypes :: ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
collectReferencedTypes ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot HashMap Text (Type m)
extraTypes =
    let queryTypes :: HashMap Text (Type m)
queryTypes = ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseObjectType ObjectType m
queryRoot HashMap Text (Type m)
extraTypes
        mutationTypes :: HashMap Text (Type m)
mutationTypes = HashMap Text (Type m)
-> (ObjectType m -> HashMap Text (Type m))
-> Maybe (ObjectType m)
-> HashMap Text (Type m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Text (Type m)
queryTypes (ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
`traverseObjectType` HashMap Text (Type m)
queryTypes)
            Maybe (ObjectType m)
mutationRoot
     in HashMap Text (Type m)
-> (ObjectType m -> HashMap Text (Type m))
-> Maybe (ObjectType m)
-> HashMap Text (Type m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Text (Type m)
mutationTypes (ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
`traverseObjectType` HashMap Text (Type m)
mutationTypes) Maybe (ObjectType m)
subscriptionRoot
  where
    collect :: (HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap k v -> HashMap k v
traverser k
typeName v
element HashMap k v
foundTypes
        | k -> HashMap k v -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member k
typeName HashMap k v
foundTypes = HashMap k v
foundTypes
        | Bool
otherwise = HashMap k v -> HashMap k v
traverser (HashMap k v -> HashMap k v) -> HashMap k v -> HashMap k v
forall a b. (a -> b) -> a -> b
$ k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
typeName v
element HashMap k v
foundTypes
    visitFields :: Field m -> HashMap Text (Type m) -> HashMap Text (Type m)
visitFields (Out.Field Maybe Text
_ Type m
outputType Arguments
arguments) HashMap Text (Type m)
foundTypes
        = Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseOutputType Type m
outputType
        (HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m) -> HashMap Text (Type m)
forall a b. (a -> b) -> a -> b
$ (Argument -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m) -> Arguments -> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Argument -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
Argument -> HashMap Text (Type m) -> HashMap Text (Type m)
visitArguments HashMap Text (Type m)
foundTypes Arguments
arguments
    visitArguments :: Argument -> HashMap Text (Type m) -> HashMap Text (Type m)
visitArguments (In.Argument Maybe Text
_ Type
inputType Maybe Value
_) = Type -> HashMap Text (Type m) -> HashMap Text (Type m)
forall (m :: * -> *).
Type -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInputType Type
inputType
    visitInputFields :: InputField -> HashMap Text (Type m) -> HashMap Text (Type m)
visitInputFields (In.InputField Maybe Text
_ Type
inputType Maybe Value
_) = Type -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInputType Type
inputType
    getField :: Resolver m -> Field m
getField (Out.ValueResolver Field m
field Resolve m
_) = Field m
field
    getField (Out.EventStreamResolver Field m
field Resolve m
_ Subscribe m
_) = Field m
field
    traverseInputType :: Type -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInputType (In.InputObjectBaseType InputObjectType
objectType) =
        let In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
inputFields = InputObjectType
objectType
            element :: Type m
element = InputObjectType -> Type m
forall (m :: * -> *). InputObjectType -> Type m
InputObjectType InputObjectType
objectType
            traverser :: HashMap Text (Type m) -> HashMap Text (Type m)
traverser = (HashMap Text (Type m)
 -> HashMap Text InputField -> HashMap Text (Type m))
-> HashMap Text InputField
-> HashMap Text (Type m)
-> HashMap Text (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InputField -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m)
-> HashMap Text InputField
-> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InputField -> HashMap Text (Type m) -> HashMap Text (Type m)
visitInputFields) HashMap Text InputField
inputFields
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
traverser Text
typeName Type m
forall (m :: * -> *). Type m
element
    traverseInputType (In.ListBaseType Type
listType) =
        Type -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInputType Type
listType
    traverseInputType (In.ScalarBaseType ScalarType
scalarType) =
        let Definition.ScalarType Text
typeName Maybe Text
_ = ScalarType
scalarType
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
forall a. a -> a
Prelude.id Text
typeName (ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
ScalarType ScalarType
scalarType)
    traverseInputType (In.EnumBaseType EnumType
enumType) =
        let Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_ = EnumType
enumType
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
forall a. a -> a
Prelude.id Text
typeName (EnumType -> Type m
forall (m :: * -> *). EnumType -> Type m
EnumType EnumType
enumType)
    traverseOutputType :: Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseOutputType (Out.ObjectBaseType ObjectType m
objectType) =
        ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseObjectType ObjectType m
objectType
    traverseOutputType (Out.InterfaceBaseType InterfaceType m
interfaceType) =
        InterfaceType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInterfaceType InterfaceType m
interfaceType
    traverseOutputType (Out.UnionBaseType UnionType m
unionType) =
        let Out.UnionType Text
typeName Maybe Text
_ [ObjectType m]
types' = UnionType m
unionType
            traverser :: HashMap Text (Type m) -> HashMap Text (Type m)
traverser = (HashMap Text (Type m) -> [ObjectType m] -> HashMap Text (Type m))
-> [ObjectType m] -> HashMap Text (Type m) -> HashMap Text (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m) -> [ObjectType m] -> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseObjectType) [ObjectType m]
types'
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
traverser Text
typeName (UnionType m -> Type m
forall (m :: * -> *). UnionType m -> Type m
UnionType UnionType m
unionType)
    traverseOutputType (Out.ListBaseType Type m
listType) =
        Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseOutputType Type m
listType
    traverseOutputType (Out.ScalarBaseType ScalarType
scalarType) =
        let Definition.ScalarType Text
typeName Maybe Text
_ = ScalarType
scalarType
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
forall a. a -> a
Prelude.id Text
typeName (ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
ScalarType ScalarType
scalarType)
    traverseOutputType (Out.EnumBaseType EnumType
enumType) =
        let Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_ = EnumType
enumType
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
forall a. a -> a
Prelude.id Text
typeName (EnumType -> Type m
forall (m :: * -> *). EnumType -> Type m
EnumType EnumType
enumType)
    traverseObjectType :: ObjectType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseObjectType ObjectType m
objectType HashMap Text (Type m)
foundTypes =
        let Out.ObjectType Text
typeName Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Resolver m)
fields = ObjectType m
objectType
            element :: Type m
element = ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
ObjectType ObjectType m
objectType
            traverser :: HashMap Text (Type m) -> HashMap Text (Type m)
traverser = [InterfaceType m]
-> HashMap Text (Field m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
polymorphicTraverser [InterfaceType m]
interfaces (Resolver m -> Field m
forall (m :: * -> *). Resolver m -> Field m
getField (Resolver m -> Field m)
-> HashMap Text (Resolver m) -> HashMap Text (Field m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Resolver m)
fields)
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
traverser Text
typeName Type m
element HashMap Text (Type m)
foundTypes
    traverseInterfaceType :: InterfaceType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInterfaceType InterfaceType m
interfaceType HashMap Text (Type m)
foundTypes =
        let Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Field m)
fields = InterfaceType m
interfaceType
            element :: Type m
element = InterfaceType m -> Type m
forall (m :: * -> *). InterfaceType m -> Type m
InterfaceType InterfaceType m
interfaceType
            traverser :: HashMap Text (Type m) -> HashMap Text (Type m)
traverser = [InterfaceType m]
-> HashMap Text (Field m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
polymorphicTraverser [InterfaceType m]
interfaces HashMap Text (Field m)
fields
         in (HashMap Text (Type m) -> HashMap Text (Type m))
-> Text -> Type m -> HashMap Text (Type m) -> HashMap Text (Type m)
forall k v.
(Eq k, Hashable k) =>
(HashMap k v -> HashMap k v)
-> k -> v -> HashMap k v -> HashMap k v
collect HashMap Text (Type m) -> HashMap Text (Type m)
traverser Text
typeName Type m
element HashMap Text (Type m)
foundTypes
    polymorphicTraverser :: [InterfaceType m]
-> HashMap Text (Field m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
polymorphicTraverser [InterfaceType m]
interfaces HashMap Text (Field m)
fields
        = (HashMap Text (Type m)
 -> HashMap Text (Field m) -> HashMap Text (Type m))
-> HashMap Text (Field m)
-> HashMap Text (Type m)
-> HashMap Text (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Field m -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m)
-> HashMap Text (Field m)
-> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field m -> HashMap Text (Type m) -> HashMap Text (Type m)
visitFields) HashMap Text (Field m)
fields
        (HashMap Text (Type m) -> HashMap Text (Type m))
-> (HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m)
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text (Type m)
 -> [InterfaceType m] -> HashMap Text (Type m))
-> [InterfaceType m]
-> HashMap Text (Type m)
-> HashMap Text (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InterfaceType m -> HashMap Text (Type m) -> HashMap Text (Type m))
-> HashMap Text (Type m)
-> [InterfaceType m]
-> HashMap Text (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InterfaceType m -> HashMap Text (Type m) -> HashMap Text (Type m)
traverseInterfaceType) [InterfaceType m]
interfaces

-- | Looks for objects and interfaces under the schema types and collects the
-- interfaces they implement.
collectImplementations :: forall m
    . HashMap Full.Name (Type m)
    -> HashMap Full.Name [Type m]
collectImplementations :: HashMap Text (Type m) -> HashMap Text [Type m]
collectImplementations = (Type m -> HashMap Text [Type m] -> HashMap Text [Type m])
-> HashMap Text [Type m]
-> HashMap Text (Type m)
-> HashMap Text [Type m]
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr Type m -> HashMap Text [Type m] -> HashMap Text [Type m]
forall (m :: * -> *).
Type m -> HashMap Text [Type m] -> HashMap Text [Type m]
go HashMap Text [Type m]
forall k v. HashMap k v
HashMap.empty
  where
    go :: Type m -> HashMap Text [Type m] -> HashMap Text [Type m]
go implementation :: Type m
implementation@(InterfaceType InterfaceType m
interfaceType) HashMap Text [Type m]
accumulator =
        let Out.InterfaceType Text
_ Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Field m)
_ = InterfaceType m
interfaceType
         in (InterfaceType m -> HashMap Text [Type m] -> HashMap Text [Type m])
-> HashMap Text [Type m]
-> [InterfaceType m]
-> HashMap Text [Type m]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type m
-> InterfaceType m
-> HashMap Text [Type m]
-> HashMap Text [Type m]
forall a (m :: * -> *).
a -> InterfaceType m -> HashMap Text [a] -> HashMap Text [a]
add Type m
implementation) HashMap Text [Type m]
accumulator [InterfaceType m]
interfaces
    go implementation :: Type m
implementation@(ObjectType ObjectType m
objectType) HashMap Text [Type m]
accumulator =
        let Out.ObjectType Text
_ Maybe Text
_ [InterfaceType m]
interfaces HashMap Text (Resolver m)
_ = ObjectType m
objectType
         in (InterfaceType m -> HashMap Text [Type m] -> HashMap Text [Type m])
-> HashMap Text [Type m]
-> [InterfaceType m]
-> HashMap Text [Type m]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type m
-> InterfaceType m
-> HashMap Text [Type m]
-> HashMap Text [Type m]
forall a (m :: * -> *).
a -> InterfaceType m -> HashMap Text [a] -> HashMap Text [a]
add Type m
implementation) HashMap Text [Type m]
accumulator [InterfaceType m]
interfaces
    go Type m
_ HashMap Text [Type m]
accumulator = HashMap Text [Type m]
accumulator
    add :: a -> InterfaceType m -> HashMap Text [a] -> HashMap Text [a]
add a
implementation (Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_) =
        ([a] -> [a] -> [a])
-> Text -> [a] -> HashMap Text [a] -> HashMap Text [a]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Text
typeName [a
implementation]