{-# 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
, 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 queryRoot :: ObjectType m
queryRoot mutationRoot :: Maybe (ObjectType m)
mutationRoot subscriptionRoot :: Maybe (ObjectType m)
subscriptionRoot directiveDefinitions :: Directives
directiveDefinitions =
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> HashMap Name (Type m)
-> Schema m
forall (m :: * -> *).
ObjectType m
-> Maybe (ObjectType m)
-> Maybe (ObjectType m)
-> Directives
-> 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
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
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
[ ("skip", Directive
skipDirective)
, ("include", Directive
includeDirective)
, ("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 "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 "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
"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 "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 "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
"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
"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 "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 "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
"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 queryRoot :: ObjectType m
queryRoot mutationRoot :: Maybe (ObjectType m)
mutationRoot subscriptionRoot :: 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 traverser :: HashMap k v -> HashMap k v
traverser typeName :: k
typeName element :: v
element foundTypes :: 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 _ outputType :: Type m
outputType arguments :: Arguments
arguments) foundTypes :: 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 _ inputType :: Type
inputType _) = 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 _ inputType :: Type
inputType _) = Type -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInputType Type
inputType
getField :: Resolver m -> Field m
getField (Out.ValueResolver field :: Field m
field _) = Field m
field
getField (Out.EventStreamResolver field :: Field m
field _ _) = Field m
field
traverseInputType :: Type -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInputType (In.InputObjectBaseType objectType :: InputObjectType
objectType) =
let In.InputObjectType typeName :: Name
typeName _ inputFields :: 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 listType :: Type
listType) =
Type -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInputType Type
listType
traverseInputType (In.ScalarBaseType scalarType :: ScalarType
scalarType) =
let Definition.ScalarType typeName :: Name
typeName _ = 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
enumType) =
let Definition.EnumType typeName :: Name
typeName _ _ = 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 :: ObjectType m
objectType) =
ObjectType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseObjectType ObjectType m
objectType
traverseOutputType (Out.InterfaceBaseType interfaceType :: InterfaceType m
interfaceType) =
InterfaceType m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseInterfaceType InterfaceType m
interfaceType
traverseOutputType (Out.UnionBaseType unionType :: UnionType m
unionType) =
let Out.UnionType typeName :: Name
typeName _ types' :: [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 listType :: Type m
listType) =
Type m -> HashMap Name (Type m) -> HashMap Name (Type m)
traverseOutputType Type m
listType
traverseOutputType (Out.ScalarBaseType scalarType :: ScalarType
scalarType) =
let Definition.ScalarType typeName :: Name
typeName _ = 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
enumType) =
let Definition.EnumType typeName :: Name
typeName _ _ = 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 :: ObjectType m
objectType foundTypes :: HashMap Name (Type m)
foundTypes =
let Out.ObjectType typeName :: Name
typeName _ interfaces :: [InterfaceType m]
interfaces fields :: 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 :: InterfaceType m
interfaceType foundTypes :: HashMap Name (Type m)
foundTypes =
let Out.InterfaceType typeName :: Name
typeName _ interfaces :: [InterfaceType m]
interfaces fields :: 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 interfaces :: [InterfaceType m]
interfaces fields :: 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