1 files changed, 28 insertions, 51 deletions
diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs
index 1abda00..ba1eded 100644
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@@ -2,64 +2,41 @@
 module Data.GraphQL.Execute (execute) where
 
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>), pure)
-import Data.Traversable (traverse)
+import Control.Applicative ((<$>))
 #endif
-import Control.Applicative (Alternative, empty)
-import Data.Foldable (fold)
+import Control.Applicative (Alternative)
 import Data.Maybe (catMaybes)
 
 import qualified Data.Aeson as Aeson
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Text as T
 
 import Data.GraphQL.AST
-import Data.GraphQL.Schema (Resolver, Schema(..))
+import Data.GraphQL.Schema (Schema(..))
 import qualified Data.GraphQL.Schema as Schema
 
 execute
-  :: (Alternative m, Monad m)
+  :: Alternative 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 _varDefs _ _ sels))]) = pure sels
-query  _ = empty
-
-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
-  => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object
-selection f resolv (SelectionField field@(Field alias name _ _ _)) =
-    fmap (HashMap.singleton aliasOrName)
-      $  Aeson.toJSON
-     <$> resolv (fieldToInput f field)
-  where
-    aliasOrName = if T.null alias then name else alias
-selection _ _ _ = empty
-
--- * AST/Schema conversions
-
-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) =
-    -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
-    Schema.InputField n (catMaybes $ argument f <$> as)
-                        (fieldToInput f . selectionToField <$> sels)
-
-selectionToField :: Selection -> Field
-selectionToField (SelectionField x) = x
-selectionToField _ = error "selectionField: not implemented yet"
+execute (Schema resolvm) subs =
+   fmap Aeson.toJSON . Schema.withFields resolvm . rootFields subs
+
+rootFields :: Schema.Subs -> Document -> [Field]
+rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+    Schema.fields $ substitute subs <$> sels
+rootFields _ _ = []
+
+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
+subsArg :: Schema.Subs -> Argument -> Maybe Argument
+subsArg subs (Argument n (ValueVariable (Variable v))) =
+    Argument n . ValueString . StringValue <$> subs v
+subsArg _ arg = Just arg