{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.Type.Schema
( schema
, module Language.GraphQL.Type.Internal
) where
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
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(..)
, 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 :: forall m
. Out.ObjectType m
-> Maybe (Out.ObjectType m)
-> Maybe (Out.ObjectType m)
-> Directives
-> Schema m
schema :: ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> Schema m
schema ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot Directives
directiveDefinitions =
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> HashMap Name (Type m)
-> HashMap Name [Type m]
-> Schema m
forall (m :: * -> *).
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> HashMap Name (Type m)
-> HashMap Name [Type m]
-> Schema m
Internal.Schema ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot
Directives
allDirectives HashMap Name (Type m)
collectedTypes HashMap Name [Type m]
collectedImplementations
where
collectedTypes :: HashMap Name (Type m)
collectedTypes = ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Name (Type m)
forall (m :: * -> *).
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Name (Type m)
collectReferencedTypes ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot
collectedImplementations :: HashMap Name [Type m]
collectedImplementations = HashMap Name (Type m) -> HashMap Name [Type m]
forall (m :: * -> *).
HashMap Name (Type m) -> HashMap Name [Type m]
collectImplementations HashMap Name (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 = [(Name, Directive)] -> Directives
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[ (Name
"skip", Directive
skipDirective)
, (Name
"include", Directive
includeDirective)
, (Name
"deprecated", Directive
deprecatedDirective)
]
includeDirective :: Directive
includeDirective =
Maybe Name -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Name
includeDescription [DirectiveLocation]
skipIncludeLocations Arguments
includeArguments
includeArguments :: Arguments
includeArguments = Name -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
"if"
(Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Type -> Maybe Value -> Argument
In.Argument (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"Included when true.") Type
ifType Maybe Value
forall a. Maybe a
Nothing
includeDescription :: Maybe Name
includeDescription = Name -> Maybe Name
forall a. a -> Maybe a
Just
Name
"Directs the executor to include this field or fragment only when the \
\`if` argument is true."
skipDirective :: Directive
skipDirective = Maybe Name -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Name
skipDescription [DirectiveLocation]
skipIncludeLocations Arguments
skipArguments
skipArguments :: Arguments
skipArguments = Name -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
"if"
(Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Type -> Maybe Value -> Argument
In.Argument (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"skipped when true.") Type
ifType Maybe Value
forall a. Maybe a
Nothing
ifType :: Type
ifType = ScalarType -> Type
In.NonNullScalarType ScalarType
Definition.boolean
skipDescription :: Maybe Name
skipDescription = Name -> Maybe Name
forall a. a -> Maybe a
Just
Name
"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 Name -> [DirectiveLocation] -> Arguments -> Directive
Directive Maybe Name
deprecatedDescription [DirectiveLocation]
deprecatedLocations Arguments
deprecatedArguments
reasonDescription :: Maybe Name
reasonDescription = Name -> Maybe Name
forall a. a -> Maybe a
Just
Name
"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 = Name -> Argument -> Arguments
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
"reason"
(Argument -> Arguments) -> Argument -> Arguments
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Type -> Maybe Value -> Argument
In.Argument Maybe Name
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 Name
deprecatedDescription = Name -> Maybe Name
forall a. a -> Maybe a
Just
Name
"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
]
collectReferencedTypes :: forall m
. Out.ObjectType m
-> Maybe (Out.ObjectType m)
-> Maybe (Out.ObjectType m)
-> HashMap Full.Name (Type m)
collectReferencedTypes :: ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> HashMap Name (Type m)
collectReferencedTypes ObjectType m
queryRoot Maybe (ObjectType m)
mutationRoot Maybe (ObjectType m)
subscriptionRoot =
let queryTypes :: HashMap Name (Type m)
queryTypes = ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseObjectType ObjectType m
queryRoot HashMap Name (Type m)
forall k v. HashMap k v
HashMap.empty
mutationTypes :: HashMap Name (Type m)
mutationTypes = HashMap Name (Type m)
-> (ObjectType m -> HashMap Name (Type m))
-> Maybe (ObjectType m)
-> HashMap Name (Type m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Name (Type m)
queryTypes (ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
`traverseObjectType` HashMap Name (Type m)
queryTypes)
Maybe (ObjectType m)
mutationRoot
in HashMap Name (Type m)
-> (ObjectType m -> HashMap Name (Type m))
-> Maybe (ObjectType m)
-> HashMap Name (Type m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashMap Name (Type m)
mutationTypes (ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
forall (m :: * -> *).
ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
`traverseObjectType` HashMap Name (Type m)
queryTypes) 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 Name (Type m) -> HashMap Name (Type m)
visitFields (Out.Field Maybe Name
_ Type m
outputType Arguments
arguments) HashMap Name (Type m)
foundTypes
= Type m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseOutputType Type m
outputType
(HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m) -> HashMap Name (Type m)
forall a b. (a -> b) -> a -> b
$ (Argument -> HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m) -> Arguments -> HashMap Name (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Argument -> HashMap Name (Type m) -> HashMap Name (Type m)
forall (m :: * -> *).
Argument -> HashMap Name (Type m) -> HashMap Name (Type m)
visitArguments HashMap Name (Type m)
foundTypes Arguments
arguments
visitArguments :: Argument -> HashMap Name (Type m) -> HashMap Name (Type m)
visitArguments (In.Argument Maybe Name
_ Type
inputType Maybe Value
_) = Type -> HashMap Name (Type m) -> HashMap Name (Type m)
forall (m :: * -> *).
Type -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInputType Type
inputType
visitInputFields :: InputField -> HashMap Name (Type m) -> HashMap Name (Type m)
visitInputFields (In.InputField Maybe Name
_ Type
inputType Maybe Value
_) = Type -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverseInputType (In.InputObjectBaseType InputObjectType
objectType) =
let In.InputObjectType Name
typeName Maybe Name
_ HashMap Name InputField
inputFields = InputObjectType
objectType
element :: Type m
element = InputObjectType -> Type m
forall (m :: * -> *). InputObjectType -> Type m
InputObjectType InputObjectType
objectType
traverser :: HashMap Name (Type m) -> HashMap Name (Type m)
traverser = (HashMap Name (Type m)
-> HashMap Name InputField -> HashMap Name (Type m))
-> HashMap Name InputField
-> HashMap Name (Type m)
-> HashMap Name (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InputField -> HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m)
-> HashMap Name InputField
-> HashMap Name (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InputField -> HashMap Name (Type m) -> HashMap Name (Type m)
visitInputFields) HashMap Name InputField
inputFields
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser Name
typeName Type m
forall (m :: * -> *). Type m
element
traverseInputType (In.ListBaseType Type
listType) =
Type -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInputType Type
listType
traverseInputType (In.ScalarBaseType ScalarType
scalarType) =
let Definition.ScalarType Name
typeName Maybe Name
_ = ScalarType
scalarType
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
forall a. a -> a
Prelude.id Name
typeName (ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
ScalarType ScalarType
scalarType)
traverseInputType (In.EnumBaseType EnumType
enumType) =
let Definition.EnumType Name
typeName Maybe Name
_ HashMap Name EnumValue
_ = EnumType
enumType
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
forall a. a -> a
Prelude.id Name
typeName (EnumType -> Type m
forall (m :: * -> *). EnumType -> Type m
EnumType EnumType
enumType)
traverseOutputType :: Type m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseOutputType (Out.ObjectBaseType ObjectType m
objectType) =
ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseObjectType ObjectType m
objectType
traverseOutputType (Out.InterfaceBaseType InterfaceType m
interfaceType) =
InterfaceType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInterfaceType InterfaceType m
interfaceType
traverseOutputType (Out.UnionBaseType UnionType m
unionType) =
let Out.UnionType Name
typeName Maybe Name
_ [ObjectType m]
types' = UnionType m
unionType
traverser :: HashMap Name (Type m) -> HashMap Name (Type m)
traverser = (HashMap Name (Type m) -> [ObjectType m] -> HashMap Name (Type m))
-> [ObjectType m] -> HashMap Name (Type m) -> HashMap Name (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m) -> [ObjectType m] -> HashMap Name (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseObjectType) [ObjectType m]
types'
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser Name
typeName (UnionType m -> Type m
forall (m :: * -> *). UnionType m -> Type m
UnionType UnionType m
unionType)
traverseOutputType (Out.ListBaseType Type m
listType) =
Type m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseOutputType Type m
listType
traverseOutputType (Out.ScalarBaseType ScalarType
scalarType) =
let Definition.ScalarType Name
typeName Maybe Name
_ = ScalarType
scalarType
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
forall a. a -> a
Prelude.id Name
typeName (ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
ScalarType ScalarType
scalarType)
traverseOutputType (Out.EnumBaseType EnumType
enumType) =
let Definition.EnumType Name
typeName Maybe Name
_ HashMap Name EnumValue
_ = EnumType
enumType
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
forall a. a -> a
Prelude.id Name
typeName (EnumType -> Type m
forall (m :: * -> *). EnumType -> Type m
EnumType EnumType
enumType)
traverseObjectType :: ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseObjectType ObjectType m
objectType HashMap Name (Type m)
foundTypes =
let Out.ObjectType Name
typeName Maybe Name
_ [InterfaceType m]
interfaces HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser = [InterfaceType m]
-> HashMap Name (Field m)
-> HashMap Name (Type m)
-> HashMap Name (Type m)
polymorphicTraverser [InterfaceType m]
interfaces (Resolver m -> Field m
forall (m :: * -> *). Resolver m -> Field m
getField (Resolver m -> Field m)
-> HashMap Name (Resolver m) -> HashMap Name (Field m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (Resolver m)
fields)
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser Name
typeName Type m
element HashMap Name (Type m)
foundTypes
traverseInterfaceType :: InterfaceType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInterfaceType InterfaceType m
interfaceType HashMap Name (Type m)
foundTypes =
let Out.InterfaceType Name
typeName Maybe Name
_ [InterfaceType m]
interfaces HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser = [InterfaceType m]
-> HashMap Name (Field m)
-> HashMap Name (Type m)
-> HashMap Name (Type m)
polymorphicTraverser [InterfaceType m]
interfaces HashMap Name (Field m)
fields
in (HashMap Name (Type m) -> HashMap Name (Type m))
-> Name -> Type m -> HashMap Name (Type m) -> HashMap Name (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 Name (Type m) -> HashMap Name (Type m)
traverser Name
typeName Type m
element HashMap Name (Type m)
foundTypes
polymorphicTraverser :: [InterfaceType m]
-> HashMap Name (Field m)
-> HashMap Name (Type m)
-> HashMap Name (Type m)
polymorphicTraverser [InterfaceType m]
interfaces HashMap Name (Field m)
fields
= (HashMap Name (Type m)
-> HashMap Name (Field m) -> HashMap Name (Type m))
-> HashMap Name (Field m)
-> HashMap Name (Type m)
-> HashMap Name (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Field m -> HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m)
-> HashMap Name (Field m)
-> HashMap Name (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field m -> HashMap Name (Type m) -> HashMap Name (Type m)
visitFields) HashMap Name (Field m)
fields
(HashMap Name (Type m) -> HashMap Name (Type m))
-> (HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m)
-> HashMap Name (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Name (Type m)
-> [InterfaceType m] -> HashMap Name (Type m))
-> [InterfaceType m]
-> HashMap Name (Type m)
-> HashMap Name (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InterfaceType m -> HashMap Name (Type m) -> HashMap Name (Type m))
-> HashMap Name (Type m)
-> [InterfaceType m]
-> HashMap Name (Type m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr InterfaceType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInterfaceType) [InterfaceType m]
interfaces
collectImplementations :: forall m
. HashMap Full.Name (Type m)
-> HashMap Full.Name [Type m]
collectImplementations :: HashMap Name (Type m) -> HashMap Name [Type m]
collectImplementations = (Type m -> HashMap Name [Type m] -> HashMap Name [Type m])
-> HashMap Name [Type m]
-> HashMap Name (Type m)
-> HashMap Name [Type m]
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr Type m -> HashMap Name [Type m] -> HashMap Name [Type m]
forall (m :: * -> *).
Type m -> HashMap Name [Type m] -> HashMap Name [Type m]
go HashMap Name [Type m]
forall k v. HashMap k v
HashMap.empty
where
go :: Type m -> HashMap Name [Type m] -> HashMap Name [Type m]
go implementation :: Type m
implementation@(InterfaceType InterfaceType m
interfaceType) HashMap Name [Type m]
accumulator =
let Out.InterfaceType Name
_ Maybe Name
_ [InterfaceType m]
interfaces HashMap Name (Field m)
_ = InterfaceType m
interfaceType
in (InterfaceType m -> HashMap Name [Type m] -> HashMap Name [Type m])
-> HashMap Name [Type m]
-> [InterfaceType m]
-> HashMap Name [Type m]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type m
-> InterfaceType m
-> HashMap Name [Type m]
-> HashMap Name [Type m]
forall a (m :: * -> *).
a -> InterfaceType m -> HashMap Name [a] -> HashMap Name [a]
add Type m
implementation) HashMap Name [Type m]
accumulator [InterfaceType m]
interfaces
go implementation :: Type m
implementation@(ObjectType ObjectType m
objectType) HashMap Name [Type m]
accumulator =
let Out.ObjectType Name
_ Maybe Name
_ [InterfaceType m]
interfaces HashMap Name (Resolver m)
_ = ObjectType m
objectType
in (InterfaceType m -> HashMap Name [Type m] -> HashMap Name [Type m])
-> HashMap Name [Type m]
-> [InterfaceType m]
-> HashMap Name [Type m]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type m
-> InterfaceType m
-> HashMap Name [Type m]
-> HashMap Name [Type m]
forall a (m :: * -> *).
a -> InterfaceType m -> HashMap Name [a] -> HashMap Name [a]
add Type m
implementation) HashMap Name [Type m]
accumulator [InterfaceType m]
interfaces
go Type m
_ HashMap Name [Type m]
accumulator = HashMap Name [Type m]
accumulator
add :: a -> InterfaceType m -> HashMap Name [a] -> HashMap Name [a]
add a
implementation (Out.InterfaceType Name
typeName Maybe Name
_ [InterfaceType m]
_ HashMap Name (Field m)
_) HashMap Name [a]
accumulator =
([a] -> [a] -> [a])
-> Name -> [a] -> HashMap Name [a] -> HashMap Name [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]
(++) Name
typeName [a
implementation] HashMap Name [a]
accumulator