{- 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
    , 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 constructor.
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 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
        ]

-- | 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)
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

-- | 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 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