Initial support for variable substitution

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

Data/GraphQL.hs

@@ -12,5 +12,9 @@ import Data.GraphQL.Parser
 import Data.GraphQL.Schema
 
 graphql :: (Alternative m, Monad m) => Schema m -> Text -> m Aeson.Value
-graphql schema = either (const empty) (execute schema)
+graphql = flip graphqlSubs $ const Nothing
+
+graphqlSubs :: (Alternative m, Monad m) => Schema m -> Subs -> Text -> m Aeson.Value
+graphqlSubs schema f =
+    either (const empty) (execute schema f)
   . Attoparsec.parseOnly document

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 :: (Alternative m, Monad m) => Schema m -> Schema.Subs -> Document -> m Aeson.Value
-execute (Schema resolv) doc = selectionSet resolv =<< query doc
+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 (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+  pure sels
 query  _ = empty
 
-selectionSet :: Alternative f => Resolver f -> SelectionSet -> f Aeson.Value
+selectionSet :: Alternative f => Schema.Subs -> Resolver f -> SelectionSet -> f Aeson.Value
-selectionSet resolv = fmap (Aeson.Object . fold) . traverse (selection resolv)
+selectionSet f resolv = fmap (Aeson.Object . fold) . traverse (selection f resolv)
 
-selection :: Alternative f => Resolver f -> Selection -> f Aeson.Object
+selection :: Alternative f => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object
-selection resolv (SelectionField field@(Field _ name _ _ _)) =
+selection f resolv (SelectionField field@(Field _ name _ _ _)) =
-    fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput field)
+    fmap (HashMap.singleton name) $ Aeson.toJSON <$> resolv (fieldToInput f field)
-selection _ _ = empty
+selection _ _ _ = empty
 
 -- * AST/Schema conversions
 
-argument :: Argument -> Schema.Argument
+argument :: Schema.Subs -> Argument -> Maybe Schema.Argument
-argument (Argument n (ValueInt v)) = (n, Schema.ScalarInt $ fromIntegral v)
+argument f (Argument n (ValueVariable (Variable v))) =
-argument (Argument n (ValueString (StringValue v))) = (n, Schema.ScalarString v)
+    maybe Nothing (\v' -> Just (n, v')) $ f v
-argument _ = error "argument: not implemented yet"
+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 :: Field -> Schema.Input
+fieldToInput :: Schema.Subs -> Field -> Schema.Input
-fieldToInput (Field _ n as _ sels) =
+fieldToInput f (Field _ n as _ sels) =
-  Schema.InputField n (argument <$> as) (fieldToInput . selectionToField <$> sels)
+    Schema.InputField n (catMaybes $ argument f <$> as)
+                        (fieldToInput f . selectionToField <$> sels)
 
 selectionToField :: Selection -> Field
 selectionToField (SelectionField x) = x

Data/GraphQL/Schema.hs

@@ -4,10 +4,11 @@ module Data.GraphQL.Schema where
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>))
 #endif
+import Data.String (IsString(fromString))
 
 import Data.Aeson (ToJSON(toJSON))
 import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
+import Data.Text (Text, pack)
 
 data Schema f = Schema (QueryRoot f) -- (Maybe  MutationRoot)
 
@@ -25,6 +26,8 @@ data Output = OutputObject (HashMap Text Output)
 
 type Argument = (Text, Scalar)
 
+type Subs = Text -> Maybe Scalar
+
 data Input = InputField Text [Argument] [Input]
              deriving (Show)
 
@@ -36,6 +39,9 @@ data Scalar = ScalarInt     Int
             | ScalarID      Text
               deriving (Show)
 
+instance IsString Scalar where
+  fromString = ScalarString . pack
+
 instance ToJSON Scalar where
     toJSON (ScalarInt     x) = toJSON x
     toJSON (ScalarFloat   x) = toJSON x

tests/Test/StarWars/QueryTests.hs

@@ -11,6 +11,7 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, testCase, (@?=))
 
 import Data.GraphQL
+import Data.GraphQL.Schema (Subs)
 
 import Test.StarWars.Schema
 
@@ -20,6 +21,9 @@ import Test.StarWars.Schema
 testQuery :: Text -> Aeson.Value -> Assertion
 testQuery q expected = graphql schema q @?= Just expected
 
+testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion
+testQueryParams f q expected = graphqlSubs schema f q @?= Just expected
+
 test :: TestTree
 test = testGroup "Star Wars Query Tests"
   [ testGroup "Basic Queries"
@@ -118,4 +122,17 @@ test = testGroup "Star Wars Query Tests"
           ]
         ]
     ]
+    , testCase "Luke ID with variable" . testQueryParams
+         (\v -> if v == "someId"
+                   then Just "1000"
+                   else Nothing)
+         [r| query FetchSomeIDQuery($someId: String!) {
+               human(id: $someId) {
+                 name
+               }
+             }
+         |]
+      $ object [
+          "human" .= object ["name" .= ("Luke Skywalker" :: Text)]
+        ]
   ]