{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
#ifdef WITH_JSON
module Language.GraphQL
( graphql
, graphqlSubs
) where
import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (catMaybes)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Language.GraphQL.AST
import Language.GraphQL.Error
import Language.GraphQL.Execute
import qualified Language.GraphQL.Validate as Validate
import Language.GraphQL.Type.Schema (Schema)
import Text.Megaparsec (parse)
{-# DEPRECATED graphql "Use graphql-spice package instead" #-}
graphql :: MonadCatch m
=> Schema m
-> Text
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object)
graphql schema = graphqlSubs schema mempty mempty
{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-}
graphqlSubs :: MonadCatch m
=> Schema m
-> Maybe Text
-> Aeson.Object
-> Text
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object)
graphqlSubs schema operationName variableValues document' =
case parse document "" document' of
Left errorBundle -> pure . formatResponse <$> parseError errorBundle
Right parsed ->
case validate parsed of
Seq.Empty -> fmap formatResponse
<$> execute schema operationName variableValues parsed
errors -> pure $ pure
$ HashMap.singleton "errors"
$ Aeson.toJSON
$ fromValidationError <$> errors
where
validate = Validate.document schema Validate.specifiedRules
formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
formatResponse (Response data'' errors') = HashMap.fromList
[ ("data", data'')
, ("errors", Aeson.toJSON $ fromError <$> errors')
]
fromError Error{..} = Aeson.object $ catMaybes
[ Just ("message", Aeson.toJSON message)
, toMaybe fromLocation "locations" locations
, toMaybe fromPath "path" path
]
fromValidationError Validate.Error{..} = Aeson.object
[ ("message", Aeson.toJSON message)
, ("locations", Aeson.listValue fromLocation locations)
]
toMaybe _ _ [] = Nothing
toMaybe f key xs = Just (key, Aeson.listValue f xs)
fromPath (Segment segment) = Aeson.String segment
fromPath (Index index) = Aeson.toJSON index
fromLocation Location{..} = Aeson.object
[ ("line", Aeson.toJSON line)
, ("column", Aeson.toJSON column)
]
#else
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)
graphql :: (MonadCatch m, VariableValue a, Serialize b)
=> Schema m
-> Maybe Text
-> HashMap Full.Name a
-> Text
-> m (Either (ResponseEventStream m b) (Response b))
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 forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser Document
Full.document String
"" Text
document' of
Left ParseErrorBundle Text Void
errorBundle -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null
forall a b. (a -> b) -> a -> b
$ Error -> Error
fromValidationError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Error
errors
where
validate :: Document -> Seq Error
validate = forall (m :: * -> *). Schema m -> [Rule m] -> Document -> Seq Error
Validate.document Schema m
schema forall (m :: * -> *). [Rule m]
Validate.specifiedRules
fromValidationError :: Error -> Error
fromValidationError Validate.Error{String
[Location]
locations :: Error -> [Location]
message :: Error -> String
locations :: [Location]
message :: String
..} = Error
{ $sel:message:Error :: Text
message = String -> Text
Text.pack String
message
, $sel:locations:Error :: [Location]
locations = [Location]
locations
, $sel:path:Error :: [Path]
path = []
}
#endif