diff --git a/CHANGELOG.md b/CHANGELOG.md index 03743f3..5f8249f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,14 @@ # Change Log All notable changes to this project will be documented in this file. +## [Unreleased] +### Added +- `executeWithName` executes an operation with the given name. + +### Changed +- `Operation` includes now possible operation name which allows to support + documents with multiple operations. + ## [0.4.0.0] - 2019-07-23 ### Added - Support for mutations. 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." -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." +-- | 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 -> 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))