{-# LANGUAGE RecordWildCards #-}

-- | This module provides the functions to parse and execute @GraphQL@ queries.
module Language.GraphQL
    ( graphql
    ) where

import Control.Monad.Catch (MonadCatch)
import Data.HashMap.Strict (HashMap)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.Error
import Language.GraphQL.Execute
import qualified Language.GraphQL.Validate as Validate
import Language.GraphQL.Type.Schema (Schema)
import Prelude hiding (null)
import Text.Megaparsec (parse)

-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
--
-- An operation name can be given if the document contains multiple operations.
graphql :: (MonadCatch m, VariableValue a, Serialize b)
    => Schema m -- ^ Resolvers.
    -> Maybe Text -- ^ Operation name.
    -> HashMap Full.Name a -- ^ Variable substitution function.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m b) (Response b)) -- ^ Response.
graphql :: forall (m :: * -> *) a b.
(MonadCatch m, VariableValue a, Serialize b) =>
Schema m
-> Maybe Text
-> HashMap Text a
-> Text
-> m (Either (ResponseEventStream m b) (Response b))
graphql Schema m
schema Maybe Text
operationName HashMap Text a
variableValues Text
document' =
    case Parsec Void Text Document
-> String -> Text -> Either (ParseErrorBundle Text Void) Document
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Document
Full.document String
"" Text
document' of
        Left ParseErrorBundle Text Void
errorBundle -> Response b -> Either (ResponseEventStream m b) (Response b)
forall a. a -> Either (ResponseEventStream m b) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (Response b -> Either (ResponseEventStream m b) (Response b))
-> m (Response b)
-> m (Either (ResponseEventStream m b) (Response b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseErrorBundle Text Void -> m (Response b)
forall (f :: * -> *) a.
(Applicative f, Serialize a) =>
ParseErrorBundle Text Void -> f (Response a)
parseError ParseErrorBundle Text Void
errorBundle
        Right Document
parsed ->
            case Document -> Seq Error
validate Document
parsed of
                Seq Error
Seq.Empty -> Schema m
-> Maybe Text
-> HashMap Text a
-> Document
-> m (Either (ResponseEventStream m b) (Response b))
forall (m :: * -> *) a b.
(MonadCatch m, VariableValue a, Serialize b) =>
Schema m
-> Maybe Text
-> HashMap Text a
-> Document
-> m (Either (ResponseEventStream m b) (Response b))
execute Schema m
schema Maybe Text
operationName HashMap Text a
variableValues Document
parsed
                Seq Error
errors -> Either (ResponseEventStream m b) (Response b)
-> m (Either (ResponseEventStream m b) (Response b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ResponseEventStream m b) (Response b)
 -> m (Either (ResponseEventStream m b) (Response b)))
-> Either (ResponseEventStream m b) (Response b)
-> m (Either (ResponseEventStream m b) (Response b))
forall a b. (a -> b) -> a -> b
$ Response b -> Either (ResponseEventStream m b) (Response b)
forall a. a -> Either (ResponseEventStream m b) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    (Response b -> Either (ResponseEventStream m b) (Response b))
-> Response b -> Either (ResponseEventStream m b) (Response b)
forall a b. (a -> b) -> a -> b
$ b -> Seq Error -> Response b
forall a. a -> Seq Error -> Response a
Response b
forall a. Serialize a => a
null
                    (Seq Error -> Response b) -> Seq Error -> Response b
forall a b. (a -> b) -> a -> b
$ Error -> Error
fromValidationError (Error -> Error) -> Seq Error -> Seq Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Error
errors
  where
    validate :: Document -> Seq Error
validate = Schema m -> [Rule m] -> Document -> Seq Error
forall (m :: * -> *). Schema m -> [Rule m] -> Document -> Seq Error
Validate.document Schema m
schema [Rule m]
forall (m :: * -> *). [Rule m]
Validate.specifiedRules
    fromValidationError :: Error -> Error
fromValidationError Validate.Error{String
[Location]
message :: String
locations :: [Location]
message :: Error -> String
locations :: Error -> [Location]
..} = Error
        { $sel:message:Error :: Text
message = String -> Text
Text.pack String
message
        , $sel:locations:Error :: [Location]
locations = [Location]
locations
        , $sel:path:Error :: [Path]
path = []
        }