Add basic output object type support

src/Language/GraphQL/Execute.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
@@ -7,10 +8,8 @@ module Language.GraphQL.Execute
     ) where
 
 import qualified Data.Aeson as Aeson
+import Data.Foldable (find)
 import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
@@ -18,6 +17,18 @@ import qualified Language.GraphQL.AST.Core as AST.Core
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
+
+-- | Query error types.
+data QueryError
+    = OperationNotFound Text
+    | OperationNameRequired
+
+queryError :: QueryError -> Text
+queryError (OperationNotFound operationName) = Text.unwords
+    ["Operation", operationName, "couldn't be found in the document."]
+queryError OperationNameRequired = "Missing operation name."
 
 -- | The substitution is applied to the document, and the resolvers are applied
 -- to the resulting fields.
@@ -25,7 +36,7 @@ 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 :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
+    => Schema m -- ^ Resolvers.
     -> Schema.Subs -- ^ Variable substitution function.
     -> Document -- @GraphQL@ document.
     -> m Aeson.Value
@@ -42,45 +53,55 @@ execute schema subs doc =
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
 executeWithName :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers
+    => Schema m -- ^ Resolvers
     -> Text -- ^ Operation name.
     -> Schema.Subs -- ^ Variable substitution function.
     -> Document -- ^ @GraphQL@ Document.
     -> m Aeson.Value
-executeWithName schema name subs doc =
-    maybe transformError (document schema $ Just name)
+executeWithName schema operationName subs doc =
+    maybe transformError (document schema $ Just operationName)
         $ Transform.document subs doc
   where
     transformError = return $ singleError "Schema transformation error."
 
+getOperation
+    :: Maybe Text
+    -> AST.Core.Document
+    -> Either QueryError AST.Core.Operation
+getOperation Nothing (operation' :| []) = pure operation'
+getOperation Nothing _ = Left OperationNameRequired
+getOperation (Just operationName) document'
+    | Just operation' <- find matchingName document' = pure operation'
+    | otherwise = Left $ OperationNotFound operationName
+  where
+    matchingName (AST.Core.Query (Just name') _) = operationName == name'
+    matchingName (AST.Core.Mutation (Just name') _) = operationName == name'
+    matchingName _ = False
+
 document :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m))
+    => Schema m
     -> Maybe Text
     -> AST.Core.Document
     -> m Aeson.Value
-document schema Nothing (op :| []) = operation schema op
-document schema (Just name) operations = case NonEmpty.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."
+document schema operationName document' =
+    case getOperation operationName document' of
+        Left error' -> pure $ singleError $ queryError error'
+        Right operation' -> operation schema operation'
 
 operation :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m))
+    => Schema m
     -> AST.Core.Operation
     -> m Aeson.Value
-operation schema = schemaOperation
+operation = schemaOperation
   where
-    runResolver fields = runCollectErrs
-        . flip Schema.resolve fields
-        . Schema.resolversToMap
-    resolve fields queryType = maybe lookupError (runResolver fields)
-        $ HashMap.lookup queryType schema
+    resolve queryFields = runCollectErrs
+        . flip Schema.resolve queryFields
+        . fields
     lookupError = pure
         $ singleError "Root operation type couldn't be found in the schema."
-    schemaOperation (AST.Core.Query _ fields) = resolve fields "Query"
-    schemaOperation (AST.Core.Mutation _ fields) = resolve fields "Mutation"
+    schemaOperation Schema {query} (AST.Core.Query _ fields') =
+        resolve fields' query
+    schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
+        resolve fields' mutation
+    schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
+        lookupError

src/Language/GraphQL/Schema.hs

@@ -3,7 +3,8 @@
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Schema
-    ( Resolver(..)
+    ( FieldResolver(..)
+    , Resolver(..)
     , Subs
     , object
     , resolve

src/Language/GraphQL/Type/Definition.hs

@@ -0,0 +1,18 @@
+module Language.GraphQL.Type.Definition
+    ( ObjectType(..)
+    ) where
+
+import Data.HashMap.Strict (HashMap)
+import Data.Text (Text)
+import Language.GraphQL.Schema
+
+type Fields m = HashMap Text (FieldResolver m)
+
+-- | Object Type Definition.
+--
+--   Almost all of the GraphQL types you define will be object types. Object
+--   types have a name, but most importantly describe their fields.
+data ObjectType m = ObjectType
+    { name :: Text
+    , fields :: Fields m
+    }

src/Language/GraphQL/Type/Schema.hs

@@ -0,0 +1,11 @@
+module Language.GraphQL.Type.Schema
+    ( Schema(..)
+    ) where
+
+import Language.GraphQL.Type.Definition
+
+-- | Schema Definition
+data Schema m = Schema
+    { query :: ObjectType m
+    , mutation :: Maybe (ObjectType m)
+    }