{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module GraphQL
(
interpretQuery
, interpretAnonymousQuery
, Response(..)
, makeSchema
, compileQuery
, executeQuery
, QueryError
, Schema
, VariableValues
, Value
) where
import Protolude
import Data.Attoparsec.Text (parseOnly, endOfInput)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import GraphQL.API (HasObjectDefinition(..), Object, SchemaError(..))
import GraphQL.Internal.Execution
( VariableValues
, ExecutionError
, substituteVariables
)
import qualified GraphQL.Internal.Execution as Execution
import qualified GraphQL.Internal.Syntax.AST as AST
import qualified GraphQL.Internal.Syntax.Parser as Parser
import GraphQL.Internal.Validation
( QueryDocument
, SelectionSetByType
, ValidationErrors
, validate
, getSelectionSet
, VariableValue
)
import GraphQL.Internal.Output
( GraphQLError(..)
, Response(..)
, singleError
)
import GraphQL.Internal.Schema (Schema)
import qualified GraphQL.Internal.Schema as Schema
import GraphQL.Resolver
( HasResolver(..)
, OperationResolverConstraint
, Result(..)
, resolveOperation
)
import GraphQL.Value (Name, Value)
data QueryError
= ParseError Text
| ValidationError ValidationErrors
| ExecutionError ExecutionError
| SchemaError SchemaError
| NonObjectResult Value
deriving (Eq, Show)
instance GraphQLError QueryError where
formatError (ParseError e) =
"Couldn't parse query document: " <> e
formatError (ValidationError es) =
"Validation errors:\n" <> mconcat [" " <> formatError e <> "\n" | e <- NonEmpty.toList es]
formatError (ExecutionError e) =
"Execution error: " <> show e
formatError (SchemaError e) =
"Schema error: " <> formatError e
formatError (NonObjectResult v) =
"Query returned a value that is not an object: " <> show v
executeQuery
:: forall api m fields typeName interfaces.
( Object typeName interfaces fields ~ api
, OperationResolverConstraint m fields typeName interfaces
)
=> Handler m api
-> QueryDocument VariableValue
-> Maybe Name
-> VariableValues
-> m Response
executeQuery handler document name variables =
case getOperation document name variables of
Left e -> pure (ExecutionFailure (singleError e))
Right operation ->
toResult
<$> resolveOperation @m @fields @typeName @interfaces handler operation
where
toResult (Result errors object) =
case NonEmpty.nonEmpty errors of
Nothing -> Success object
Just errs -> PartialSuccess object (map toError errs)
makeSchema :: forall api. HasObjectDefinition api => Either QueryError Schema
makeSchema = first SchemaError (Schema.makeSchema <$> getDefinition @api)
interpretQuery
:: forall api m fields typeName interfaces.
( Object typeName interfaces fields ~ api
, OperationResolverConstraint m fields typeName interfaces
)
=> Handler m api
-> Text
-> Maybe Name
-> VariableValues
-> m Response
interpretQuery handler query name variables =
case makeSchema @api >>= flip compileQuery query of
Left err -> pure (PreExecutionFailure (toError err :| []))
Right document -> executeQuery @api @m handler document name variables
interpretAnonymousQuery
:: forall api m fields typeName interfaces.
( Object typeName interfaces fields ~ api
, OperationResolverConstraint m fields typeName interfaces
)
=> Handler m api
-> Text
-> m Response
interpretAnonymousQuery handler query = interpretQuery @api @m handler query Nothing mempty
compileQuery :: Schema -> Text -> Either QueryError (QueryDocument VariableValue)
compileQuery schema query = do
parsed <- first ParseError (parseQuery query)
first ValidationError (validate schema parsed)
parseQuery :: Text -> Either Text AST.QueryDocument
parseQuery query = first toS (parseOnly (Parser.queryDocument <* endOfInput) query)
getOperation :: QueryDocument VariableValue -> Maybe Name -> VariableValues -> Either QueryError (SelectionSetByType Value)
getOperation document name vars = first ExecutionError $ do
op <- Execution.getOperation document name
resolved <- substituteVariables op vars
pure (getSelectionSet resolved)