{-# LANGUAGE CPP #-}

#ifdef WITH_JSON
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | This module provides the functions to parse and execute @GraphQL@ queries.
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)

-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
graphql :: MonadCatch m
    => Schema m -- ^ Resolvers.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphql :: Schema m -> Text -> m (Either (ResponseEventStream m Value) Object)
graphql Schema m
schema = Schema m
-> Maybe Text
-> Object
-> Text
-> m (Either (ResponseEventStream m Value) Object)
forall (m :: * -> *).
MonadCatch m =>
Schema m
-> Maybe Text
-> Object
-> Text
-> m (Either (ResponseEventStream m Value) Object)
graphqlSubs Schema m
schema Maybe Text
forall a. Monoid a => a
mempty Object
forall a. Monoid a => a
mempty

-- | If the text parses correctly as a @GraphQL@ query the substitution is
-- applied to the query and the query is then executed using to the given
-- 'Schema'.
graphqlSubs :: MonadCatch m
    => Schema m -- ^ Resolvers.
    -> Maybe Text -- ^ Operation name.
    -> Aeson.Object -- ^ Variable substitution function.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphqlSubs :: Schema m
-> Maybe Text
-> Object
-> Text
-> m (Either (ResponseEventStream m Value) Object)
graphqlSubs Schema m
schema Maybe Text
operationName Object
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
document String
"" Text
document' of
        Left ParseErrorBundle Text Void
errorBundle -> Object -> Either (ResponseEventStream m Value) Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either (ResponseEventStream m Value) Object)
-> (Response Value -> Object)
-> Response Value
-> Either (ResponseEventStream m Value) Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response Value -> Object
forall k.
(Hashable k, IsString k, Eq k) =>
Response Value -> HashMap k Value
formatResponse (Response Value -> Either (ResponseEventStream m Value) Object)
-> m (Response Value)
-> m (Either (ResponseEventStream m Value) Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseErrorBundle Text Void -> m (Response Value)
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 -> (Response Value -> Object)
-> Either (ResponseEventStream m Value) (Response Value)
-> Either (ResponseEventStream m Value) Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response Value -> Object
forall k.
(Hashable k, IsString k, Eq k) =>
Response Value -> HashMap k Value
formatResponse
                    (Either (ResponseEventStream m Value) (Response Value)
 -> Either (ResponseEventStream m Value) Object)
-> m (Either (ResponseEventStream m Value) (Response Value))
-> m (Either (ResponseEventStream m Value) Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema m
-> Maybe Text
-> Object
-> Document
-> m (Either (ResponseEventStream m Value) (Response Value))
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 Object
variableValues Document
parsed
                Seq Error
errors -> Either (ResponseEventStream m Value) Object
-> m (Either (ResponseEventStream m Value) Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ResponseEventStream m Value) Object
 -> m (Either (ResponseEventStream m Value) Object))
-> Either (ResponseEventStream m Value) Object
-> m (Either (ResponseEventStream m Value) Object)
forall a b. (a -> b) -> a -> b
$ Object -> Either (ResponseEventStream m Value) Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    (Object -> Either (ResponseEventStream m Value) Object)
-> Object -> Either (ResponseEventStream m Value) Object
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
"errors"
                    (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Seq Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON
                    (Seq Value -> Value) -> Seq Value -> Value
forall a b. (a -> b) -> a -> b
$ Error -> Value
fromValidationError (Error -> Value) -> Seq Error -> Seq Value
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
    formatResponse :: Response Value -> HashMap k Value
formatResponse (Response Value
data'' Seq Error
Seq.Empty) = k -> Value -> HashMap k Value
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton k
"data" Value
data''
    formatResponse (Response Value
data'' Seq Error
errors') = [(k, Value)] -> HashMap k Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        [ (k
"data", Value
data'')
        , (k
"errors", Seq Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Seq Value -> Value) -> Seq Value -> Value
forall a b. (a -> b) -> a -> b
$ Error -> Value
fromError (Error -> Value) -> Seq Error -> Seq Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Error
errors')
        ]
    fromError :: Error -> Value
fromError Error{[Location]
[Path]
Text
$sel:path:Error :: Error -> [Path]
$sel:locations:Error :: Error -> [Location]
$sel:message:Error :: Error -> Text
path :: [Path]
locations :: [Location]
message :: Text
..} = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Text
"message", Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
message)
        , (Location -> Value) -> Text -> [Location] -> Maybe Pair
forall a a. (a -> Value) -> a -> [a] -> Maybe (a, Value)
toMaybe Location -> Value
fromLocation Text
"locations" [Location]
locations
        , (Path -> Value) -> Text -> [Path] -> Maybe Pair
forall a a. (a -> Value) -> a -> [a] -> Maybe (a, Value)
toMaybe Path -> Value
fromPath Text
"path" [Path]
path
        ]
    fromValidationError :: Error -> Value
fromValidationError Validate.Error{String
[Location]
locations :: Error -> [Location]
message :: Error -> String
locations :: [Location]
message :: String
..} = [Pair] -> Value
Aeson.object
        [ (Text
"message", String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON String
message)
        , (Text
"locations", (Location -> Value) -> [Location] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue Location -> Value
fromLocation [Location]
locations)
        ]
    toMaybe :: (a -> Value) -> a -> [a] -> Maybe (a, Value)
toMaybe a -> Value
_ a
_ [] = Maybe (a, Value)
forall a. Maybe a
Nothing
    toMaybe a -> Value
f a
key [a]
xs = (a, Value) -> Maybe (a, Value)
forall a. a -> Maybe a
Just (a
key, (a -> Value) -> [a] -> Value
forall a. (a -> Value) -> [a] -> Value
Aeson.listValue a -> Value
f [a]
xs)
    fromPath :: Path -> Value
fromPath (Segment Text
segment) = Text -> Value
Aeson.String Text
segment
    fromPath (Index Int
index) = Int -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Int
index
    fromLocation :: Location -> Value
fromLocation Location{Word
$sel:column:Location :: Location -> Word
$sel:line:Location :: Location -> Word
column :: Word
line :: Word
..} = [Pair] -> Value
Aeson.object
        [ (Text
"line", Word -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Word
line)
        , (Text
"column", Word -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Word
column)
        ]
#else
-- | This module provides the functions to parse and execute @GraphQL@ queries.
module Language.GraphQL
    (
    ) where
#endif