{-# LANGUAGE ExplicitForAll #-}

-- | This module provides functions to execute a @GraphQL@ request.
module Language.GraphQL.Execute
    ( execute
    , module Language.GraphQL.Execute.Coerce
    ) where

import Control.Monad.Catch (MonadCatch)
import Data.HashMap.Strict (HashMap)
import Data.Sequence (Seq(..))
import Data.Text (Text)
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.Execution
import Language.GraphQL.Execute.Internal
import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Execute.Subscribe as Subscribe
import Language.GraphQL.Error
    ( Error
    , ResponseEventStream
    , Response(..)
    , runCollectErrs
    )
import qualified Language.GraphQL.Type.Definition as Definition
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
import Prelude hiding (null)

-- | 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
-- defines multiple root operations.
--
-- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field.
execute :: (MonadCatch m, VariableValue a, Serialize b)
    => Schema m -- ^ Resolvers.
    -> Maybe Text -- ^ Operation name.
    -> HashMap Full.Name a -- ^ Variable substitution function.
    -> Full.Document -- @GraphQL@ document.
    -> m (Either (ResponseEventStream m b) (Response b))
execute :: 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
subs Document
document
    = (QueryError -> m (Either (ResponseEventStream m b) (Response b)))
-> (Document m
    -> m (Either (ResponseEventStream m b) (Response b)))
-> Either QueryError (Document m)
-> m (Either (ResponseEventStream m b) (Response b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either (ResponseEventStream m b) (Response b)
-> m (Either (ResponseEventStream m b) (Response b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ResponseEventStream m b) (Response b)
 -> m (Either (ResponseEventStream m b) (Response b)))
-> (QueryError -> Either (ResponseEventStream m b) (Response b))
-> QueryError
-> m (Either (ResponseEventStream m b) (Response b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either (ResponseEventStream m b) (Response b)
forall b a. Serialize b => Error -> Either a (Response b)
rightErrorResponse (Error -> Either (ResponseEventStream m b) (Response b))
-> (QueryError -> Error)
-> QueryError
-> Either (ResponseEventStream m b) (Response b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Location] -> String -> Error
singleError [] (String -> Error) -> (QueryError -> String) -> QueryError -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryError -> String
forall a. Show a => a -> String
show) Document m -> m (Either (ResponseEventStream m b) (Response b))
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Document m -> m (Either (ResponseEventStream m a) (Response a))
executeRequest
    (Either QueryError (Document m)
 -> m (Either (ResponseEventStream m b) (Response b)))
-> Either QueryError (Document m)
-> m (Either (ResponseEventStream m b) (Response b))
forall a b. (a -> b) -> a -> b
$ Schema m
-> Maybe Text
-> HashMap Text a
-> Document
-> Either QueryError (Document m)
forall a (m :: * -> *).
VariableValue a =>
Schema m
-> Maybe Text
-> HashMap Text a
-> Document
-> Either QueryError (Document m)
Transform.document Schema m
schema' Maybe Text
operationName HashMap Text a
subs Document
document

executeRequest :: (MonadCatch m, Serialize a)
    => Transform.Document m
    -> m (Either (ResponseEventStream m a) (Response a))
executeRequest :: Document m -> m (Either (ResponseEventStream m a) (Response a))
executeRequest (Transform.Document HashMap Text (Type m)
types' ObjectType m
rootObjectType Operation m
operation)
    | (Transform.Query Maybe Text
_ Seq (Selection m)
fields Location
objectLocation) <- Operation m
operation =
        Response a -> Either (ResponseEventStream m a) (Response a)
forall a b. b -> Either a b
Right (Response a -> Either (ResponseEventStream m a) (Response a))
-> m (Response a)
-> m (Either (ResponseEventStream m a) (Response a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Type m)
-> ObjectType m -> Location -> Seq (Selection m) -> m (Response a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Text (Type m)
-> ObjectType m -> Location -> Seq (Selection m) -> m (Response a)
executeOperation HashMap Text (Type m)
types' ObjectType m
rootObjectType Location
objectLocation Seq (Selection m)
fields
    | (Transform.Mutation Maybe Text
_ Seq (Selection m)
fields Location
objectLocation) <- Operation m
operation =
        Response a -> Either (ResponseEventStream m a) (Response a)
forall a b. b -> Either a b
Right (Response a -> Either (ResponseEventStream m a) (Response a))
-> m (Response a)
-> m (Either (ResponseEventStream m a) (Response a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Type m)
-> ObjectType m -> Location -> Seq (Selection m) -> m (Response a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Text (Type m)
-> ObjectType m -> Location -> Seq (Selection m) -> m (Response a)
executeOperation HashMap Text (Type m)
types' ObjectType m
rootObjectType Location
objectLocation Seq (Selection m)
fields
    | (Transform.Subscription Maybe Text
_ Seq (Selection m)
fields Location
objectLocation) <- Operation m
operation
        = (Error -> Either (ResponseEventStream m a) (Response a))
-> (ResponseEventStream m a
    -> Either (ResponseEventStream m a) (Response a))
-> Either Error (ResponseEventStream m a)
-> Either (ResponseEventStream m a) (Response a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error -> Either (ResponseEventStream m a) (Response a)
forall b a. Serialize b => Error -> Either a (Response b)
rightErrorResponse ResponseEventStream m a
-> Either (ResponseEventStream m a) (Response a)
forall a b. a -> Either a b
Left
        (Either Error (ResponseEventStream m a)
 -> Either (ResponseEventStream m a) (Response a))
-> m (Either Error (ResponseEventStream m a))
-> m (Either (ResponseEventStream m a) (Response a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (ResponseEventStream m a))
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Text (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (ResponseEventStream m a))
Subscribe.subscribe HashMap Text (Type m)
types' ObjectType m
rootObjectType Location
objectLocation Seq (Selection m)
fields

-- This is actually executeMutation, but we don't distinguish between queries
-- and mutations yet.
executeOperation :: (MonadCatch m, Serialize a)
    => HashMap Full.Name (Type m)
    -> Out.ObjectType m
    -> Full.Location
    -> Seq (Transform.Selection m)
    -> m (Response a)
executeOperation :: HashMap Text (Type m)
-> ObjectType m -> Location -> Seq (Selection m) -> m (Response a)
executeOperation HashMap Text (Type m)
types' ObjectType m
objectType Location
objectLocation Seq (Selection m)
fields
    = HashMap Text (Type m) -> CollectErrsT m a -> m (Response a)
forall (m :: * -> *) a.
(Monad m, Serialize a) =>
HashMap Text (Type m) -> CollectErrsT m a -> m (Response a)
runCollectErrs HashMap Text (Type m)
types'
    (CollectErrsT m a -> m (Response a))
-> CollectErrsT m a -> m (Response a)
forall a b. (a -> b) -> a -> b
$ Value
-> ObjectType m
-> Location
-> Seq (Selection m)
-> CollectErrsT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value
-> ObjectType m
-> Location
-> Seq (Selection m)
-> CollectErrsT m a
executeSelectionSet Value
Definition.Null ObjectType m
objectType Location
objectLocation Seq (Selection m)
fields

rightErrorResponse :: Serialize b => forall a. Error -> Either a (Response b)
rightErrorResponse :: forall a. Error -> Either a (Response b)
rightErrorResponse = Response b -> Either a (Response b)
forall a b. b -> Either a b
Right (Response b -> Either a (Response b))
-> (Error -> Response b) -> Error -> Either a (Response b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Seq Error -> Response b
forall a. a -> Seq Error -> Response a
Response b
forall a. Serialize a => a
null (Seq Error -> Response b)
-> (Error -> Seq Error) -> Error -> Response b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Seq Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure