diff options
Diffstat (limited to 'src/Language/GraphQL/Type')
| -rw-r--r-- | src/Language/GraphQL/Type/In.hs | 26 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Internal.hs | 63 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Schema.hs | 27 |
3 files changed, 73 insertions, 43 deletions
diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs index 8b08041..59a6d59 100644 --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -11,6 +11,7 @@ -- with 'Language.GraphQL.Type.Out'. module Language.GraphQL.Type.In ( Argument(..) + , Arguments , InputField(..) , InputObjectType(..) , Type(..) @@ -24,10 +25,10 @@ module Language.GraphQL.Type.In import Data.HashMap.Strict (HashMap) import Data.Text (Text) import Language.GraphQL.AST.Document (Name) -import Language.GraphQL.Type.Definition +import qualified Language.GraphQL.Type.Definition as Definition -- | Single field of an 'InputObjectType'. -data InputField = InputField (Maybe Text) Type (Maybe Value) +data InputField = InputField (Maybe Text) Type (Maybe Definition.Value) -- | Input object type definition. -- @@ -45,25 +46,28 @@ instance Eq InputObjectType where -- type can wrap other wrapping or named types. Wrapping types are lists and -- Non-Null types (named types are nullable by default). data Type - = NamedScalarType ScalarType - | NamedEnumType EnumType + = NamedScalarType Definition.ScalarType + | NamedEnumType Definition.EnumType | NamedInputObjectType InputObjectType | ListType Type - | NonNullScalarType ScalarType - | NonNullEnumType EnumType + | NonNullScalarType Definition.ScalarType + | NonNullEnumType Definition.EnumType | NonNullInputObjectType InputObjectType | NonNullListType Type deriving Eq -- | Field argument definition. -data Argument = Argument (Maybe Text) Type (Maybe Value) +data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) + +-- | Field argument definitions. +type Arguments = HashMap Name Argument -- | Matches either 'NamedScalarType' or 'NonNullScalarType'. -pattern ScalarBaseType :: ScalarType -> Type +pattern ScalarBaseType :: Definition.ScalarType -> Type pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType) -- | Matches either 'NamedEnumType' or 'NonNullEnumType'. -pattern EnumBaseType :: EnumType -> Type +pattern EnumBaseType :: Definition.EnumType -> Type pattern EnumBaseType enumType <- (isEnumType -> Just enumType) -- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'. @@ -76,7 +80,7 @@ pattern ListBaseType listType <- (isListType -> Just listType) {-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-} -isScalarType :: Type -> Maybe ScalarType +isScalarType :: Type -> Maybe Definition.ScalarType isScalarType (NamedScalarType inputType) = Just inputType isScalarType (NonNullScalarType inputType) = Just inputType isScalarType _ = Nothing @@ -86,7 +90,7 @@ isInputObjectType (NamedInputObjectType inputType) = Just inputType isInputObjectType (NonNullInputObjectType inputType) = Just inputType isInputObjectType _ = Nothing -isEnumType :: Type -> Maybe EnumType +isEnumType :: Type -> Maybe Definition.EnumType isEnumType (NamedEnumType inputType) = Just inputType isEnumType (NonNullEnumType inputType) = Just inputType isEnumType _ = Nothing diff --git a/src/Language/GraphQL/Type/Internal.hs b/src/Language/GraphQL/Type/Internal.hs index 444a52d..2aea996 100644 --- a/src/Language/GraphQL/Type/Internal.hs +++ b/src/Language/GraphQL/Type/Internal.hs @@ -18,12 +18,12 @@ module Language.GraphQL.Type.Internal import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text) import qualified Language.GraphQL.AST as Full import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out -import Language.GraphQL.Type.Schema +import Language.GraphQL.Type.Schema (Schema) +import qualified Language.GraphQL.Type.Schema as Schema -- | These types may describe the parent context of a selection set. data CompositeType m @@ -39,13 +39,15 @@ data AbstractType m deriving Eq -- | Traverses the schema and finds all referenced types. -collectReferencedTypes :: forall m. Schema m -> HashMap Full.Name (Type m) +collectReferencedTypes :: forall m + . Schema m + -> HashMap Full.Name (Schema.Type m) collectReferencedTypes schema = - let queryTypes = traverseObjectType (query schema) HashMap.empty + let queryTypes = traverseObjectType (Schema.query schema) HashMap.empty mutationTypes = maybe queryTypes (`traverseObjectType` queryTypes) - $ mutation schema + $ Schema.mutation schema in maybe mutationTypes (`traverseObjectType` queryTypes) - $ subscription schema + $ Schema.subscription schema where collect traverser typeName element foundTypes | HashMap.member typeName foundTypes = foundTypes @@ -59,17 +61,17 @@ collectReferencedTypes schema = getField (Out.EventStreamResolver field _ _) = field traverseInputType (In.InputObjectBaseType objectType) = let In.InputObjectType typeName _ inputFields = objectType - element = InputObjectType objectType + element = Schema.InputObjectType objectType traverser = flip (foldr visitInputFields) inputFields in collect traverser typeName element traverseInputType (In.ListBaseType listType) = traverseInputType listType traverseInputType (In.ScalarBaseType scalarType) = let Definition.ScalarType typeName _ = scalarType - in collect Prelude.id typeName (ScalarType scalarType) + in collect Prelude.id typeName (Schema.ScalarType scalarType) traverseInputType (In.EnumBaseType enumType) = let Definition.EnumType typeName _ _ = enumType - in collect Prelude.id typeName (EnumType enumType) + in collect Prelude.id typeName (Schema.EnumType enumType) traverseOutputType (Out.ObjectBaseType objectType) = traverseObjectType objectType traverseOutputType (Out.InterfaceBaseType interfaceType) = @@ -77,23 +79,23 @@ collectReferencedTypes schema = traverseOutputType (Out.UnionBaseType unionType) = let Out.UnionType typeName _ types = unionType traverser = flip (foldr traverseObjectType) types - in collect traverser typeName (UnionType unionType) + in collect traverser typeName (Schema.UnionType unionType) traverseOutputType (Out.ListBaseType listType) = traverseOutputType listType traverseOutputType (Out.ScalarBaseType scalarType) = let Definition.ScalarType typeName _ = scalarType - in collect Prelude.id typeName (ScalarType scalarType) + in collect Prelude.id typeName (Schema.ScalarType scalarType) traverseOutputType (Out.EnumBaseType enumType) = let Definition.EnumType typeName _ _ = enumType - in collect Prelude.id typeName (EnumType enumType) + in collect Prelude.id typeName (Schema.EnumType enumType) traverseObjectType objectType foundTypes = let Out.ObjectType typeName _ interfaces fields = objectType - element = ObjectType objectType + element = Schema.ObjectType objectType traverser = polymorphicTraverser interfaces (getField <$> fields) in collect traverser typeName element foundTypes traverseInterfaceType interfaceType foundTypes = let Out.InterfaceType typeName _ interfaces fields = interfaceType - element = InterfaceType interfaceType + element = Schema.InterfaceType interfaceType traverser = polymorphicTraverser interfaces fields in collect traverser typeName element foundTypes polymorphicTraverser interfaces fields @@ -126,27 +128,28 @@ instanceOf objectType (AbstractUnionType unionType) = lookupTypeCondition :: forall m . Full.Name - -> HashMap Full.Name (Type m) + -> HashMap Full.Name (Schema.Type m) -> Maybe (CompositeType m) lookupTypeCondition type' types' = case HashMap.lookup type' types' of - Just (ObjectType objectType) -> Just $ CompositeObjectType objectType - Just (UnionType unionType) -> Just $ CompositeUnionType unionType - Just (InterfaceType interfaceType) -> + Just (Schema.ObjectType objectType) -> + Just $ CompositeObjectType objectType + Just (Schema.UnionType unionType) -> Just $ CompositeUnionType unionType + Just (Schema.InterfaceType interfaceType) -> Just $ CompositeInterfaceType interfaceType _ -> Nothing lookupInputType :: Full.Type - -> HashMap.HashMap Full.Name (Type m) + -> HashMap.HashMap Full.Name (Schema.Type m) -> Maybe In.Type lookupInputType (Full.TypeNamed name) types = case HashMap.lookup name types of - Just (ScalarType scalarType) -> + Just (Schema.ScalarType scalarType) -> Just $ In.NamedScalarType scalarType - Just (EnumType enumType) -> + Just (Schema.EnumType enumType) -> Just $ In.NamedEnumType enumType - Just (InputObjectType objectType) -> + Just (Schema.InputObjectType objectType) -> Just $ In.NamedInputObjectType objectType _ -> Nothing lookupInputType (Full.TypeList list) types @@ -154,18 +157,18 @@ lookupInputType (Full.TypeList list) types <$> lookupInputType list types lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types = case HashMap.lookup nonNull types of - Just (ScalarType scalarType) -> + Just (Schema.ScalarType scalarType) -> Just $ In.NonNullScalarType scalarType - Just (EnumType enumType) -> + Just (Schema.EnumType enumType) -> Just $ In.NonNullEnumType enumType - Just (InputObjectType objectType) -> + Just (Schema.InputObjectType objectType) -> Just $ In.NonNullInputObjectType objectType _ -> Nothing lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types = In.NonNullListType <$> lookupInputType nonNull types -lookupTypeField :: forall a. Text -> Out.Type a -> Maybe (Out.Type a) +lookupTypeField :: forall a. Full.Name -> Out.Type a -> Maybe (Out.Field a) lookupTypeField fieldName = \case Out.ObjectBaseType objectType -> objectChild objectType @@ -177,8 +180,6 @@ lookupTypeField fieldName = \case objectChild (Out.ObjectType _ _ _ resolvers) = resolverType <$> HashMap.lookup fieldName resolvers interfaceChild (Out.InterfaceType _ _ _ fields) = - fieldType <$> HashMap.lookup fieldName fields - resolverType (Out.ValueResolver objectField _) = fieldType objectField - resolverType (Out.EventStreamResolver objectField _ _) = - fieldType objectField - fieldType (Out.Field _ type' _) = type' + HashMap.lookup fieldName fields + resolverType (Out.ValueResolver objectField _) = objectField + resolverType (Out.EventStreamResolver objectField _ _) = objectField diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs index 581d9b2..6562fb5 100644 --- a/src/Language/GraphQL/Type/Schema.hs +++ b/src/Language/GraphQL/Type/Schema.hs @@ -2,13 +2,22 @@ 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 #-} + -- | This module provides a representation of a @GraphQL@ Schema in addition to -- functions for defining and manipulating schemas. module Language.GraphQL.Type.Schema - ( Schema(..) + ( Directive(..) + , Directives + , Schema(..) , Type(..) + , schema ) where +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) +import qualified Language.GraphQL.AST.Document as Full +import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation) import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out @@ -23,6 +32,12 @@ data Type m | UnionType (Out.UnionType m) deriving Eq +-- | Directive definition. +data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments + +-- | Directive definitions. +type Directives = HashMap Full.Name Directive + -- | A Schema is created by supplying the root types of each type of operation, -- query and mutation (optional). A schema definition is then supplied to the -- validator and executor. @@ -34,4 +49,14 @@ data Schema m = Schema { query :: Out.ObjectType m , mutation :: Maybe (Out.ObjectType m) , subscription :: Maybe (Out.ObjectType m) + , directives :: Directives + } + +-- | Shortcut for creating a schema. +schema :: forall m. Out.ObjectType m -> Schema m +schema query' = Schema + { query = query' + , mutation = Nothing + , subscription = Nothing + , directives = mempty } |