Merge branch 'core'

This introduces a distinction between a Full and a Core AST. Fragments and
variables are replaced when transforming from Full to Core.

1 files changed, 41 insertions, 28 deletions

diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs
index a7e3c91..7609561 100644
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@@ -1,58 +1,71 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- | This module provides the function to execute a @GraphQL@ request --
 --   according to a 'Schema'.
 module Data.GraphQL.Execute (execute) where
 
-import Control.Applicative (Alternative)
-import Data.Maybe (catMaybes)
+import Control.Applicative (Alternative, empty)
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty((:|)))
 
 import qualified Data.Aeson as Aeson
+import qualified Data.HashMap.Strict as HashMap
 
-import Data.GraphQL.AST
-import Data.GraphQL.Schema (Schema(..))
+import qualified Data.GraphQL.AST as AST
+import qualified Data.GraphQL.AST.Core as AST.Core
+import qualified Data.GraphQL.AST.Transform as Transform
+import Data.GraphQL.Schema (Schema)
 import qualified Data.GraphQL.Schema as Schema
 
-import Data.GraphQL.Error
-
 -- | Takes a 'Schema', a variable substitution function ('Schema.Subs'), and a
 --   @GraphQL@ 'document'. The substitution is applied to the document using
 --  'rootFields', and the 'Schema''s resolvers are applied to the resulting fields.
 --
 --   Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
 --   errors wrapped in an /errors/ field.
-execute :: Alternative f
-  => Schema.Schema f -> Schema.Subs -> Document -> f Aeson.Value
-execute (Schema resolvs) subs doc = runCollectErrs res
-  where res = Schema.resolvers resolvs $ rootFields subs doc
+execute
+  :: (Alternative f, Monad f)
+  => Schema f -> Schema.Subs -> AST.Document -> f Aeson.Value
+execute schema subs doc = document schema =<< maybe empty pure (Transform.document subs doc)
+
+document :: Alternative f => Schema f -> AST.Core.Document -> f Aeson.Value
+document schema (op :| []) = operation schema op
+document _ _ = error "Multiple operations not supported yet"
+
+operation :: Alternative f => Schema f -> AST.Core.Operation -> f Aeson.Value
+operation schema (AST.Core.Query flds) =
+  Aeson.Object . HashMap.singleton "data"
+             <$> Schema.resolve (NE.toList schema) (NE.toList flds)
+operation _ _ = error "Mutations not supported yet"
 
 -- | Takes a variable substitution function and a @GraphQL@ document.
 --   If the document contains one query (and no other definitions)
 --   it applies the substitution to the query's set of selections
 --   and then returns their fields.
-rootFields :: Schema.Subs -> Document -> [Field]
-rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
-    Schema.fields $ substitute subs <$> sels
-rootFields _ _ = []
+-- rootFields :: Schema.Subs -> Document -> [Field]
+-- rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+--     Schema.fields $ substitute subs <$> sels
+-- rootFields _ _ = []
 
 -- | Takes a variable substitution function and a selection. If the
 --   selection is a field it applies the substitution to the field's
 --   arguments using 'subsArg', and recursively applies the substitution to
 --   the arguments of fields nested in the primary field.
-substitute :: Schema.Subs -> Selection -> Selection
-substitute subs (SelectionField (Field alias name args directives sels)) =
-    SelectionField $ Field
-      alias
-      name
-      -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
-      (catMaybes $ subsArg subs <$> args)
-      directives
-      (substitute subs <$> sels)
-substitute _ sel = sel
+-- substitute :: Schema.Subs -> Selection -> Selection
+-- substitute subs (SelectionField (Field alias name args directives sels)) =
+--     SelectionField $ Field
+--       alias
+--       name
+--       -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
+--       (catMaybes $ subsArg subs <$> args)
+--       directives
+--       (substitute subs <$> sels)
+-- substitute _ sel = sel
 
 -- TODO: Support different value types
 -- | Takes a variable substitution function and an argument. If the
 --   argument's value is a variable the substitution is applied to the
 --   variable's name.
-subsArg :: Schema.Subs -> Argument -> Maybe Argument
-subsArg subs (Argument n (ValueVariable (Variable v))) =
-    Argument n . ValueString <$> subs v
-subsArg _ arg = Just arg
+-- subsArg :: Schema.Subs -> Argument -> Maybe Argument
+-- subsArg subs (Argument n (ValueVariable (Variable v))) =
+--     Argument n . ValueString <$> subs v
+-- subsArg _ arg = Just arg