Validate arguments are defined

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
     }