Implement multiple operation support

3 files changed, 46 insertions, 17 deletions

diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs
index 00072e0..87dced9 100644
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@@ -21,8 +21,8 @@ type Name = Text
 
 type Document = NonEmpty Operation
 
-data Operation = Query    (NonEmpty Field)
-               | Mutation (NonEmpty Field)
+data Operation = Query (Maybe Text) (NonEmpty Field)
+               | Mutation (Maybe Text) (NonEmpty Field)
                  deriving (Eq,Show)
 
 data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show)
diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs
index 64670db..63a2c72 100644
--- a/src/Language/GraphQL/AST/Transform.hs
+++ b/src/Language/GraphQL/AST/Transform.hs
@@ -41,7 +41,6 @@ operations
   -> Maybe Core.Document
 operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr)
 
--- TODO: Replace Maybe by MonadThrow CustomError
 operation
   :: Schema.Subs
   -> Fragmenter
@@ -50,10 +49,10 @@ operation
 operation subs fr (Full.OperationSelectionSet sels) =
   operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels
 -- TODO: Validate Variable definitions with substituter
-operation subs fr (Full.OperationDefinition ot _n _vars _dirs sels) =
-  case ot of
-    Full.Query    -> Core.Query    <$> node
-    Full.Mutation -> Core.Mutation <$> node
+operation subs fr (Full.OperationDefinition operationType name _vars _dirs sels)
+    = case operationType of
+        Full.Query -> Core.Query name <$> node
+        Full.Mutation -> Core.Mutation name <$> node
   where
     node = traverse (hush . selection subs fr) sels
 
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 9dbfb36..5a815b8 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -4,12 +4,15 @@
 --   according to a 'Schema'.
 module Language.GraphQL.Execute
     ( execute
+    , executeWithName
     ) where
 
 import Control.Monad.IO.Class (MonadIO)
+import qualified Data.Aeson as Aeson
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty((:|)))
-import qualified Data.Aeson as Aeson
+import Data.Text (Text)
+import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as AST
 import qualified Language.GraphQL.AST.Core as AST.Core
 import qualified Language.GraphQL.AST.Transform as Transform
@@ -23,20 +26,47 @@ import qualified Language.GraphQL.Schema as Schema
 --
 --   Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
 --   errors wrapped in an /errors/ field.
-execute
-    :: MonadIO m
-    => Schema m -> Schema.Subs -> AST.Document -> m Aeson.Value
+execute :: MonadIO m
+    => Schema m
+    -> Schema.Subs
+    -> AST.Document
+    -> m Aeson.Value
 execute schema subs doc =
-    maybe transformError (document schema) $ Transform.document subs doc
+    maybe transformError (document schema Nothing) $ Transform.document subs doc
+  where
+    transformError = return $ singleError "Schema transformation error."
+
+-- | Takes a 'Schema', operation name, 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.
+executeWithName :: MonadIO m
+    => Schema m
+    -> Text
+    -> Schema.Subs
+    -> AST.Document
+    -> m Aeson.Value
+executeWithName schema name subs doc =
+    maybe transformError (document schema $ Just name) $ Transform.document subs doc
   where
     transformError = return $ singleError "Schema transformation error."
 
-document :: MonadIO m => Schema m -> AST.Core.Document -> m Aeson.Value
-document schema (op :| []) = operation schema op
-document _ _ = return $ singleError "Multiple operations not supported yet."
+document :: MonadIO m => Schema m -> Maybe Text -> AST.Core.Document -> m Aeson.Value
+document schema Nothing (op :| []) = operation schema op
+document schema (Just name) operations = case NE.dropWhile matchingName operations of
+    [] -> return $ singleError
+        $ Text.unwords ["Operation", name, "couldn't be found in the document."]
+    (op:_)  -> operation schema op
+  where
+    matchingName (AST.Core.Query (Just name') _) = name == name'
+    matchingName (AST.Core.Mutation (Just name') _) = name == name'
+    matchingName _ = False
+document _ _ _ = return $ singleError "Missing operation name."
 
 operation :: MonadIO m => Schema m -> AST.Core.Operation -> m Aeson.Value
-operation schema (AST.Core.Query flds)
+operation schema (AST.Core.Query _ flds)
     = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
-operation schema (AST.Core.Mutation flds)
+operation schema (AST.Core.Mutation _ flds)
     = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))