Initial support for variable substitution

The correspondent end-to-end test has been ported. The variable
definition still needs to be checked.

1 files changed, 25 insertions, 19 deletions

diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs
index 01fc118..9d20e5c 100644
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
 module Data.GraphQL.Execute where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -8,6 +7,7 @@ import Data.Traversable (traverse)
 #endif
 import Control.Applicative (Alternative, empty)
 import Data.Foldable (fold)
+import Data.Maybe (catMaybes)
 
 import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
@@ -16,31 +16,37 @@ import Data.GraphQL.AST
 import Data.GraphQL.Schema (Resolver, Schema(..))
 import qualified Data.GraphQL.Schema as Schema
 
-execute :: (Alternative m, Monad m) => Schema m -> Document -> m Aeson.Value
-execute (Schema resolv) doc = selectionSet resolv =<< query doc
+execute :: (Alternative m, Monad m) => Schema m -> Schema.Subs -> Document -> m Aeson.Value
+execute (Schema resolv) f doc = selectionSet f resolv =<< query doc
 
 query :: Alternative f => Document -> f SelectionSet
-query (Document [DefinitionOperation (Query (Node _ _ _ sels))]) = pure sels
-query _ = empty
+query (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+  pure sels
+query  _ = empty
 
-selectionSet :: Alternative f => Resolver f -> SelectionSet -> f Aeson.Value
-selectionSet resolv = fmap (Aeson.Object . fold) . traverse (selection resolv)
+selectionSet :: Alternative f => Schema.Subs -> Resolver f -> SelectionSet -> f Aeson.Value
+selectionSet f resolv = fmap (Aeson.Object . fold) . traverse (selection f resolv)
 
-selection :: Alternative f => Resolver f -> Selection -> f Aeson.Object
-selection resolv (SelectionField field@(Field _ name _ _ _)) =
-    fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput field)
-selection _ _ = empty
+selection :: Alternative f => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object
+selection f resolv (SelectionField field@(Field _ name _ _ _)) =
+    fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput f field)
+selection _ _ _ = empty
 
 -- * AST/Schema conversions
 
-argument :: Argument -> Schema.Argument
-argument (Argument n (ValueInt v)) = (n, Schema.ScalarInt $ fromIntegral v)
-argument (Argument n (ValueString (StringValue v))) = (n, Schema.ScalarString v)
-argument _ = error "argument: not implemented yet"
-
-fieldToInput :: Field -> Schema.Input
-fieldToInput (Field _ n as _ sels) =
-  Schema.InputField n (argument <$> as) (fieldToInput . selectionToField <$> sels)
+argument :: Schema.Subs -> Argument -> Maybe Schema.Argument
+argument f (Argument n (ValueVariable (Variable v))) =
+    maybe Nothing (\v' -> Just (n, v')) $ f v
+argument _ (Argument n (ValueInt v)) =
+    Just (n, Schema.ScalarInt $ fromIntegral v)
+argument _ (Argument n (ValueString (StringValue v))) =
+    Just (n, Schema.ScalarString v)
+argument _ _ = error "argument: not implemented yet"
+
+fieldToInput :: Schema.Subs -> Field -> Schema.Input
+fieldToInput f (Field _ n as _ sels) =
+    Schema.InputField n (catMaybes $ argument f <$> as)
+                        (fieldToInput f . selectionToField <$> sels)
 
 selectionToField :: Selection -> Field
 selectionToField (SelectionField x) = x