diff options
Diffstat (limited to 'src/Language/GraphQL/Execute.hs')
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 126 |
1 files changed, 96 insertions, 30 deletions
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index e1bacbc..e21d5de 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -9,42 +9,42 @@ module Language.GraphQL.Execute import qualified Data.Aeson as Aeson import Data.Foldable (find) +import qualified Data.HashMap.Strict as HashMap import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (Text) import qualified Data.Text as Text import Language.GraphQL.AST.Document import qualified Language.GraphQL.AST.Core as AST.Core +import Language.GraphQL.Execute.Coerce 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 qualified Language.GraphQL.Type.Definition as Definition import Language.GraphQL.Type.Schema -- | Query error types. data QueryError = OperationNotFound Text | OperationNameRequired + | CoercionError queryError :: QueryError -> Text queryError (OperationNotFound operationName) = Text.unwords ["Operation", operationName, "couldn't be found in the document."] queryError OperationNameRequired = "Missing operation name." +queryError CoercionError = "Coercion error." -- | The substitution is applied to the document, and the 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. -execute :: Monad m +execute :: (Monad m, VariableValue a) => Schema m -- ^ Resolvers. - -> Schema.Subs -- ^ Variable substitution function. + -> HashMap.HashMap Name a -- ^ Variable substitution function. -> Document -- @GraphQL@ document. -> m Aeson.Value -execute schema subs doc = - maybe transformError (document schema Nothing) - $ Transform.document subs doc - where - transformError = return $ singleError "Schema transformation error." +execute schema = document schema Nothing -- | The substitution is applied to the document, and the resolvers are applied -- to the resulting fields. The operation name can be used if the document @@ -52,41 +52,105 @@ 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 +executeWithName :: (Monad m, VariableValue a) => Schema m -- ^ Resolvers -> Text -- ^ Operation name. - -> Schema.Subs -- ^ Variable substitution function. + -> HashMap.HashMap Name a -- ^ Variable substitution function. -> Document -- ^ @GraphQL@ Document. -> m Aeson.Value -executeWithName schema operationName subs doc = - maybe transformError (document schema $ Just operationName) - $ Transform.document subs doc - where - transformError = return $ singleError "Schema transformation error." +executeWithName schema operationName = document schema (Just operationName) getOperation :: Maybe Text - -> AST.Core.Document - -> Either QueryError AST.Core.Operation -getOperation Nothing (operation' :| []) = pure operation' + -> Transform.Document + -> Either QueryError Transform.OperationDefinition +getOperation Nothing (Transform.Document (operation' :| []) _) = pure operation' getOperation Nothing _ = Left OperationNameRequired -getOperation (Just operationName) document' - | Just operation' <- find matchingName document' = pure operation' +getOperation (Just operationName) (Transform.Document operations _) + | Just operation' <- find matchingName operations = 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 + matchingName (Transform.OperationDefinition _ name _ _ _) = + name == Just operationName + +lookupInputType + :: Type + -> HashMap.HashMap Name (Definition.TypeDefinition m) + -> Maybe Definition.InputType +lookupInputType (TypeNamed name) types = + case HashMap.lookup name types of + Just (Definition.ScalarTypeDefinition scalarType) -> + Just $ Definition.ScalarInputType scalarType + Just (Definition.EnumTypeDefinition enumType) -> + Just $ Definition.EnumInputType enumType + Just (Definition.InputObjectTypeDefinition objectType) -> + Just $ Definition.ObjectInputType objectType + _ -> Nothing +lookupInputType (TypeList list) types + = Definition.ListInputType + <$> lookupInputType list types +lookupInputType (TypeNonNull (NonNullTypeNamed nonNull)) types = + case HashMap.lookup nonNull types of + Just (Definition.ScalarTypeDefinition scalarType) -> + Just $ Definition.NonNullScalarInputType scalarType + Just (Definition.EnumTypeDefinition enumType) -> + Just $ Definition.NonNullEnumInputType enumType + Just (Definition.InputObjectTypeDefinition objectType) -> + Just $ Definition.NonNullObjectInputType objectType + _ -> Nothing +lookupInputType (TypeNonNull (NonNullTypeList nonNull)) types + = Definition.NonNullListInputType + <$> lookupInputType nonNull types + +coerceVariableValues :: (Monad m, VariableValue a) + => Schema m + -> Transform.OperationDefinition + -> HashMap.HashMap Name a + -> Either QueryError Schema.Subs +coerceVariableValues schema (Transform.OperationDefinition _ _ variables _ _) values = + let referencedTypes = collectReferencedTypes schema + in maybe (Left CoercionError) Right + $ foldr (coerceValue referencedTypes) (Just HashMap.empty) variables + where + coerceValue referencedTypes variableDefinition coercedValues = do + let VariableDefinition variableName variableTypeName _defaultValue = + variableDefinition + variableType <- lookupInputType variableTypeName referencedTypes + value <- HashMap.lookup variableName values + coercedValue <- coerceVariableValue variableType value + HashMap.insert variableName coercedValue <$> coercedValues -document :: Monad m +executeRequest :: (Monad m, VariableValue a) => Schema m -> Maybe Text - -> AST.Core.Document + -> HashMap.HashMap Name a + -> Transform.Document + -> Either QueryError (Transform.OperationDefinition, Schema.Subs) +executeRequest schema operationName subs document' = do + operation' <- getOperation operationName document' + coercedValues <- coerceVariableValues schema operation' subs + pure (operation', coercedValues) + +document :: (Monad m, VariableValue a) + => Schema m + -> Maybe Text + -> HashMap.HashMap Name a + -> Document -> m Aeson.Value -document schema operationName document' = - case getOperation operationName document' of - Left error' -> pure $ singleError $ queryError error' - Right operation' -> operation schema operation' +document schema operationName subs document' = + case Transform.document document' of + Just transformed -> executeRequest' transformed + Nothing -> pure $ singleError + "The document doesn't contain any executable operations." + where + transformOperation fragmentTable operation' subs' = + case Transform.operation fragmentTable subs' operation' of + Just operationResult -> operation schema operationResult + Nothing -> pure $ singleError "Schema transformation error." + executeRequest' transformed@(Transform.Document _ fragmentTable) = + case executeRequest schema operationName subs transformed of + Right (operation', subs') -> transformOperation fragmentTable operation' subs' + Left error' -> pure $ singleError $ queryError error' operation :: Monad m => Schema m @@ -96,7 +160,8 @@ operation = schemaOperation where resolve queryFields = runCollectErrs . flip Schema.resolve queryFields - . fields + . fmap getResolver + . Definition.fields lookupError = pure $ singleError "Root operation type couldn't be found in the schema." schemaOperation Schema {query} (AST.Core.Query _ fields') = @@ -105,3 +170,4 @@ operation = schemaOperation resolve fields' mutation schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) = lookupError + getResolver (Definition.Field _ _ _ resolver) = resolver |