summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/Execute.hs75
-rw-r--r--src/Language/GraphQL/Schema.hs3
-rw-r--r--src/Language/GraphQL/Type/Definition.hs18
-rw-r--r--src/Language/GraphQL/Type/Schema.hs11
4 files changed, 79 insertions, 28 deletions
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 204d08c..e1bacbc 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/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
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs
index 90a766c..e76b42e 100644
--- a/src/Language/GraphQL/Schema.hs
+++ b/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
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
new file mode 100644
index 0000000..016eeb8
--- /dev/null
+++ b/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
+ }
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
new file mode 100644
index 0000000..f830c26
--- /dev/null
+++ b/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)
+ }