{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}

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

import Conduit (mapMC, (.|))
import Control.Arrow (left)
import Control.Monad.Catch
     ( Exception(..)
     , Handler(..)
     , MonadCatch(..)
     , MonadThrow(..)
     , SomeException(..)
     , catches
     )
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT)
import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
import qualified Control.Monad.Trans.Writer as Writer
import Control.Monad (foldM)
import qualified Language.GraphQL.AST.Document as Full
import Data.Foldable (find)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable (cast)
import GHC.Records (HasField(..))
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
import qualified Language.GraphQL.Execute.Transform as Transform
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Internal as Type.Internal
import Language.GraphQL.Type.Schema (Schema, Type)
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Error
    ( Error(..)
    , Response(..)
    , Path(..)
    , ResolverException(..)
    , ResponseEventStream
    )
import Prelude hiding (null)

newtype ExecutorT m a = ExecutorT
    { ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT :: ReaderT (HashMap Full.Name (Type m)) (WriterT (Seq Error) m) a
    }

instance Functor m => Functor (ExecutorT m) where
    fmap :: (a -> b) -> ExecutorT m a -> ExecutorT m b
fmap a -> b
f = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
-> ExecutorT m b
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
 -> ExecutorT m b)
-> (ExecutorT m a
    -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b)
-> ExecutorT m a
-> ExecutorT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b)
-> (ExecutorT m a
    -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT

instance Applicative m => Applicative (ExecutorT m) where
    pure :: a -> ExecutorT m a
pure = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> ExecutorT m a)
-> (a -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> a
-> ExecutorT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) (a -> b)
f <*> :: ExecutorT m (a -> b) -> ExecutorT m a -> ExecutorT m b
<*> ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
-> ExecutorT m b
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
 -> ExecutorT m b)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
-> ExecutorT m b
forall a b. (a -> b) -> a -> b
$ ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) (a -> b)
f ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) (a -> b)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x

instance Monad m => Monad (ExecutorT m) where
    ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x >>= :: ExecutorT m a -> (a -> ExecutorT m b) -> ExecutorT m b
>>= a -> ExecutorT m b
f = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
-> ExecutorT m b
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
 -> ExecutorT m b)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
-> ExecutorT m b
forall a b. (a -> b) -> a -> b
$ ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
x ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> (a -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorT m b
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT (ExecutorT m b
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b)
-> (a -> ExecutorT m b)
-> a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExecutorT m b
f

instance MonadTrans ExecutorT where
    lift :: m a -> ExecutorT m a
lift = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> ExecutorT m a)
-> (m a
    -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> m a
-> ExecutorT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT (Seq Error) m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (Seq Error) m a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> (m a -> WriterT (Seq Error) m a)
-> m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> WriterT (Seq Error) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadThrow m => MonadThrow (ExecutorT m) where
    throwM :: e -> ExecutorT m a
throwM = m a -> ExecutorT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExecutorT m a) -> (e -> m a) -> e -> ExecutorT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (ExecutorT m) where
  catch :: ExecutorT m a -> (e -> ExecutorT m a) -> ExecutorT m a
catch (ExecutorT ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
stack) e -> ExecutorT m a
handler =
      ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> ExecutorT m a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> (e -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
stack ((e -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> (e -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT (ExecutorT m a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> (e -> ExecutorT m a)
-> e
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExecutorT m a
handler

data GraphQLException = forall e. Exception e => GraphQLException e

instance Show GraphQLException where
    show :: GraphQLException -> String
show (GraphQLException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception GraphQLException

graphQLExceptionToException :: Exception e => e -> SomeException
graphQLExceptionToException :: e -> SomeException
graphQLExceptionToException = GraphQLException -> SomeException
forall e. Exception e => e -> SomeException
toException (GraphQLException -> SomeException)
-> (e -> GraphQLException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GraphQLException
forall e. Exception e => e -> GraphQLException
GraphQLException

graphQLExceptionFromException :: Exception e => SomeException -> Maybe e
graphQLExceptionFromException :: SomeException -> Maybe e
graphQLExceptionFromException SomeException
e = do
    GraphQLException e
graphqlException <- SomeException -> Maybe GraphQLException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
graphqlException

data ResultException = forall e. Exception e => ResultException e

instance Show ResultException where
    show :: ResultException -> String
show (ResultException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception ResultException where
    toException :: ResultException -> SomeException
toException = ResultException -> SomeException
forall e. Exception e => e -> SomeException
graphQLExceptionToException
    fromException :: SomeException -> Maybe ResultException
fromException = SomeException -> Maybe ResultException
forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException

resultExceptionToException :: Exception e => e -> SomeException
resultExceptionToException :: e -> SomeException
resultExceptionToException = ResultException -> SomeException
forall e. Exception e => e -> SomeException
toException (ResultException -> SomeException)
-> (e -> ResultException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ResultException
forall e. Exception e => e -> ResultException
ResultException

resultExceptionFromException :: Exception e => SomeException -> Maybe e
resultExceptionFromException :: SomeException -> Maybe e
resultExceptionFromException SomeException
e = do
    ResultException e
resultException <- SomeException -> Maybe ResultException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
resultException

data FieldException = forall e. Exception e => FieldException Full.Location [Path] e

instance Show FieldException where
    show :: FieldException -> String
show (FieldException Location
_ [Path]
_ e
e) = e -> String
forall e. Exception e => e -> String
displayException e
e

instance Exception FieldException where
    toException :: FieldException -> SomeException
toException = FieldException -> SomeException
forall e. Exception e => e -> SomeException
graphQLExceptionToException
    fromException :: SomeException -> Maybe FieldException
fromException = SomeException -> Maybe FieldException
forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException

data ValueCompletionException = ValueCompletionException String Type.Value

instance Show ValueCompletionException where
    show :: ValueCompletionException -> String
show (ValueCompletionException String
typeRepresentation Value
found) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Value completion error. Expected type "
        , String
typeRepresentation
        , String
", found: "
        , Value -> String
forall a. Show a => a -> String
show Value
found
        , String
"."
        ]

instance Exception ValueCompletionException where
    toException :: ValueCompletionException -> SomeException
toException = ValueCompletionException -> SomeException
forall e. Exception e => e -> SomeException
resultExceptionToException
    fromException :: SomeException -> Maybe ValueCompletionException
fromException = SomeException -> Maybe ValueCompletionException
forall e. Exception e => SomeException -> Maybe e
resultExceptionFromException

data InputCoercionException =
    InputCoercionException String In.Type (Maybe (Full.Node Transform.Input))

instance Show InputCoercionException where
    show :: InputCoercionException -> String
show (InputCoercionException String
argumentName Type
argumentType Maybe (Node Input)
Nothing) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Required argument \""
        , String
argumentName
        , String
"\" of type "
        , Type -> String
forall a. Show a => a -> String
show Type
argumentType
        , String
" not specified."
        ]
    show (InputCoercionException String
argumentName Type
argumentType (Just Node Input
givenValue)) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Argument \""
        , String
argumentName
        , String
"\" has invalid type. Expected type "
        , Type -> String
forall a. Show a => a -> String
show Type
argumentType
        , String
", found: "
        , Node Input -> String
forall a. Show a => a -> String
show Node Input
givenValue
        , String
"."
        ]

instance Exception InputCoercionException where
    toException :: InputCoercionException -> SomeException
toException = InputCoercionException -> SomeException
forall e. Exception e => e -> SomeException
graphQLExceptionToException
    fromException :: SomeException -> Maybe InputCoercionException
fromException = SomeException -> Maybe InputCoercionException
forall e. Exception e => SomeException -> Maybe e
graphQLExceptionFromException

newtype ResultCoercionException = ResultCoercionException String

instance Show ResultCoercionException where
    show :: ResultCoercionException -> String
show (ResultCoercionException String
typeRepresentation) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Unable to coerce result to "
        , String
typeRepresentation
        , String
"."
        ]

instance Exception ResultCoercionException where
    toException :: ResultCoercionException -> SomeException
toException = ResultCoercionException -> SomeException
forall e. Exception e => e -> SomeException
resultExceptionToException
    fromException :: SomeException -> Maybe ResultCoercionException
fromException = SomeException -> Maybe ResultCoercionException
forall e. Exception e => SomeException -> Maybe e
resultExceptionFromException

-- | Query error types.
data QueryError
    = OperationNameRequired
    | OperationNotFound String
    | CoercionError Full.VariableDefinition
    | UnknownInputType Full.VariableDefinition

tell :: Monad m => Seq Error -> ExecutorT m ()
tell :: Seq Error -> ExecutorT m ()
tell = ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ()
-> ExecutorT m ()
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ()
 -> ExecutorT m ())
-> (Seq Error
    -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ())
-> Seq Error
-> ExecutorT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT (Seq Error) m ()
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (Seq Error) m ()
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ())
-> (Seq Error -> WriterT (Seq Error) m ())
-> Seq Error
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Error -> WriterT (Seq Error) m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell

queryError :: QueryError -> Error
queryError :: QueryError -> Error
queryError QueryError
OperationNameRequired =
    Error :: Name -> [Location] -> [Path] -> Error
Error{ $sel:message:Error :: Name
message = Name
"Operation name is required.", $sel:locations:Error :: [Location]
locations = [], $sel:path:Error :: [Path]
path = [] }
queryError (OperationNotFound String
operationName) =
    let queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.concat
            [ Name
"Operation \""
            , String -> Name
Text.pack String
operationName
            , Name
"\" not found."
            ]
     in Error :: Name -> [Location] -> [Path] -> Error
Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [], $sel:path:Error :: [Path]
path = [] }
queryError (CoercionError VariableDefinition
variableDefinition) =
    let Full.VariableDefinition Name
variableName Type
_ Maybe (Node ConstValue)
_ Location
location = VariableDefinition
variableDefinition
        queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.concat
            [ Name
"Failed to coerce the variable \""
            , Name
variableName
            , Name
"\"."
            ]
     in Error :: Name -> [Location] -> [Path] -> Error
Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [Location
location], $sel:path:Error :: [Path]
path = [] }
queryError (UnknownInputType VariableDefinition
variableDefinition) =
    let Full.VariableDefinition Name
variableName Type
variableTypeName Maybe (Node ConstValue)
_ Location
location = VariableDefinition
variableDefinition
        queryErrorMessage :: Name
queryErrorMessage = [Name] -> Name
Text.concat
            [ Name
"Variable \""
            , Name
variableName
            , Name
"\" has unknown type \""
            , String -> Name
Text.pack (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show Type
variableTypeName
            , Name
"\"."
            ]
     in Error :: Name -> [Location] -> [Path] -> Error
Error{ $sel:message:Error :: Name
message = Name
queryErrorMessage, $sel:locations:Error :: [Location]
locations = [Location
location], $sel:path:Error :: [Path]
path = [] }

-- | 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 Name
-> HashMap Name a
-> Document
-> m (Either (ResponseEventStream m b) (Response b))
execute Schema m
schema' Maybe Name
operationName HashMap Name a
subs Document
document' =
    Schema m
-> Document
-> Maybe String
-> HashMap Name a
-> m (Either (ResponseEventStream m b) (Response b))
forall (m :: * -> *) a b.
(MonadCatch m, Serialize a, VariableValue b) =>
Schema m
-> Document
-> Maybe String
-> HashMap Name b
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest Schema m
schema' Document
document' (Name -> String
Text.unpack (Name -> String) -> Maybe Name -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
operationName) HashMap Name a
subs

executeRequest :: (MonadCatch m, Serialize a, VariableValue b)
    => Schema m
    -> Full.Document
    -> Maybe String
    -> HashMap Full.Name b
    -> m (Either (ResponseEventStream m a) (Response a))
executeRequest :: Schema m
-> Document
-> Maybe String
-> HashMap Name b
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest Schema m
schema Document
sourceDocument Maybe String
operationName HashMap Name b
variableValues = do
    Either QueryError (Operation m)
operationAndVariables <- Either QueryError (m (Operation m))
-> m (Either QueryError (Operation m))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Either QueryError (m (Operation m))
buildOperation
    case Either QueryError (Operation m)
operationAndVariables of
        Left QueryError
queryError' -> Either (ResponseEventStream m a) (Response a)
-> m (Either (ResponseEventStream m a) (Response a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either (ResponseEventStream m a) (Response a)
 -> m (Either (ResponseEventStream m a) (Response a)))
-> Either (ResponseEventStream m a) (Response a)
-> m (Either (ResponseEventStream m a) (Response a))
forall a b. (a -> b) -> a -> b
$ Response a -> Either (ResponseEventStream m a) (Response a)
forall a b. b -> Either a b
Right
            (Response a -> Either (ResponseEventStream m a) (Response a))
-> Response a -> Either (ResponseEventStream m a) (Response a)
forall a b. (a -> b) -> a -> b
$ a -> Seq Error -> Response a
forall a. a -> Seq Error -> Response a
Response a
forall a. Serialize a => a
null (Seq Error -> Response a) -> Seq Error -> Response a
forall a b. (a -> b) -> a -> b
$ Error -> Seq Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ QueryError -> Error
queryError QueryError
queryError'
        Right Operation m
operation
            | Transform.Operation OperationType
Full.Query Seq (Selection m)
topSelections Location
_operationLocation <- 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
<$> Seq (Selection m) -> Schema m -> m (Response a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> m (Response a)
executeQuery Seq (Selection m)
topSelections Schema m
schema
            | Transform.Operation OperationType
Full.Mutation Seq (Selection m)
topSelections Location
operationLocation <- 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
<$> Seq (Selection m) -> Schema m -> Location -> m (Response a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m) -> Schema m -> Location -> m (Response a)
executeMutation Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
            | Transform.Operation OperationType
Full.Subscription Seq (Selection m)
topSelections Location
operationLocation <- 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
<$> Seq (Selection m)
-> Schema m
-> Location
-> m (Either Error (ResponseEventStream m a))
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> Schema m
-> Location
-> m (Either Error (ResponseEventStream m a))
subscribe Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
  where
    schemaTypes :: HashMap Name (Type m)
schemaTypes = Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema
    ([OperationDefinition]
operationDefinitions, HashMap Name FragmentDefinition
fragmentDefinitions') =
        Document
-> ([OperationDefinition], HashMap Name FragmentDefinition)
Transform.document Document
sourceDocument
    buildOperation :: Either QueryError (m (Operation m))
buildOperation = do
        OperationDefinition
operationDefinition <- [OperationDefinition]
-> Maybe String -> Either QueryError OperationDefinition
getOperation [OperationDefinition]
operationDefinitions Maybe String
operationName
        Subs
coercedVariableValues <- HashMap Name (Type m)
-> OperationDefinition -> HashMap Name b -> Either QueryError Subs
forall (m :: * -> *) b.
(Monad m, VariableValue b) =>
HashMap Name (Type m)
-> OperationDefinition -> HashMap Name b -> Either QueryError Subs
coerceVariableValues
            HashMap Name (Type m)
schemaTypes
            OperationDefinition
operationDefinition
            HashMap Name b
variableValues
        let replacement :: Replacement m
replacement = Replacement :: forall (m :: * -> *).
Subs
-> HashMap Name FragmentDefinition
-> HashSet Name
-> HashMap Name (Type m)
-> Replacement m
Transform.Replacement
                { variableValues :: Subs
variableValues = Subs
coercedVariableValues
                , fragmentDefinitions :: HashMap Name FragmentDefinition
fragmentDefinitions = HashMap Name FragmentDefinition
fragmentDefinitions'
                , visitedFragments :: HashSet Name
visitedFragments = HashSet Name
forall a. Monoid a => a
mempty
                , types :: HashMap Name (Type m)
types = HashMap Name (Type m)
schemaTypes
                }
        m (Operation m) -> Either QueryError (m (Operation m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (Operation m) -> Either QueryError (m (Operation m)))
-> m (Operation m) -> Either QueryError (m (Operation m))
forall a b. (a -> b) -> a -> b
$ (ReaderT (Replacement m) m (Operation m)
 -> Replacement m -> m (Operation m))
-> Replacement m
-> ReaderT (Replacement m) m (Operation m)
-> m (Operation m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Replacement m) m (Operation m)
-> Replacement m -> m (Operation m)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Replacement m
replacement
            (ReaderT (Replacement m) m (Operation m) -> m (Operation m))
-> ReaderT (Replacement m) m (Operation m) -> m (Operation m)
forall a b. (a -> b) -> a -> b
$ TransformT m (Operation m)
-> ReaderT (Replacement m) m (Operation m)
forall (m :: * -> *) a.
TransformT m a -> ReaderT (Replacement m) m a
Transform.runTransformT
            (TransformT m (Operation m)
 -> ReaderT (Replacement m) m (Operation m))
-> TransformT m (Operation m)
-> ReaderT (Replacement m) m (Operation m)
forall a b. (a -> b) -> a -> b
$ OperationDefinition -> TransformT m (Operation m)
forall (m :: * -> *).
Monad m =>
OperationDefinition -> TransformT m (Operation m)
Transform.transform OperationDefinition
operationDefinition

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

getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
getOperation :: [OperationDefinition]
-> Maybe String -> Either QueryError OperationDefinition
getOperation [OperationDefinition
operation] Maybe String
Nothing = OperationDefinition -> Either QueryError OperationDefinition
forall a b. b -> Either a b
Right OperationDefinition
operation
getOperation [OperationDefinition]
operations (Just String
givenOperationName)
    = Either QueryError OperationDefinition
-> (OperationDefinition -> Either QueryError OperationDefinition)
-> Maybe OperationDefinition
-> Either QueryError OperationDefinition
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (QueryError -> Either QueryError OperationDefinition
forall a b. a -> Either a b
Left (QueryError -> Either QueryError OperationDefinition)
-> QueryError -> Either QueryError OperationDefinition
forall a b. (a -> b) -> a -> b
$ String -> QueryError
OperationNotFound String
givenOperationName) OperationDefinition -> Either QueryError OperationDefinition
forall a b. b -> Either a b
Right
    (Maybe OperationDefinition
 -> Either QueryError OperationDefinition)
-> Maybe OperationDefinition
-> Either QueryError OperationDefinition
forall a b. (a -> b) -> a -> b
$ (OperationDefinition -> Bool)
-> [OperationDefinition] -> Maybe OperationDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find OperationDefinition -> Bool
findOperationByName [OperationDefinition]
operations
  where
    findOperationByName :: OperationDefinition -> Bool
findOperationByName (Full.OperationDefinition OperationType
_ (Just Name
operationName) [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
_) =
        String
givenOperationName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> String
Text.unpack Name
operationName
    findOperationByName OperationDefinition
_ = Bool
False
getOperation [OperationDefinition]
_ Maybe String
_ = QueryError -> Either QueryError OperationDefinition
forall a b. a -> Either a b
Left QueryError
OperationNameRequired

executeQuery :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> m (Response a)
executeQuery :: Seq (Selection m) -> Schema m -> m (Response a)
executeQuery Seq (Selection m)
topSelections Schema m
schema = do
    let queryType :: ObjectType m
queryType = Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema
    (a
data', Seq Error
errors) <- WriterT (Seq Error) m a -> m (a, Seq Error)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
        (WriterT (Seq Error) m a -> m (a, Seq Error))
-> WriterT (Seq Error) m a -> m (a, Seq Error)
forall a b. (a -> b) -> a -> b
$ (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> HashMap Name (Type m) -> WriterT (Seq Error) m a)
-> HashMap Name (Type m)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> HashMap Name (Type m) -> WriterT (Seq Error) m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema)
        (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> WriterT (Seq Error) m a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
        (ExecutorT m a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a -> (FieldException -> ExecutorT m a) -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
topSelections ObjectType m
queryType Value
Type.Null [])
        FieldException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
    Response a -> m (Response a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response a -> m (Response a)) -> Response a -> m (Response a)
forall a b. (a -> b) -> a -> b
$ a -> Seq Error -> Response a
forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors

handleException :: (MonadCatch m, Serialize a)
    => FieldException
    -> ExecutorT m a
handleException :: FieldException -> ExecutorT m a
handleException (FieldException Location
fieldLocation [Path]
errorPath e
next) =
    let newError :: Error
newError = e -> Location -> [Path] -> Error
forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
next Location
fieldLocation [Path]
errorPath
     in Seq Error -> ExecutorT m ()
forall (m :: * -> *). Monad m => Seq Error -> ExecutorT m ()
tell (Error -> Seq Error
forall a. a -> Seq a
Seq.singleton Error
newError) ExecutorT m () -> ExecutorT m a -> ExecutorT m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ExecutorT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Serialize a => a
null

constructError :: Exception e => e -> Full.Location -> [Path] -> Error
constructError :: e -> Location -> [Path] -> Error
constructError e
e Location
fieldLocation [Path]
errorPath = Error :: Name -> [Location] -> [Path] -> Error
Error
    { $sel:message:Error :: Name
message = String -> Name
Text.pack (e -> String
forall e. Exception e => e -> String
displayException e
e)
    , $sel:path:Error :: [Path]
path = [Path] -> [Path]
forall a. [a] -> [a]
reverse [Path]
errorPath
    , $sel:locations:Error :: [Location]
locations = [Location
fieldLocation]
    }

executeMutation :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> Full.Location
    -> m (Response a)
executeMutation :: Seq (Selection m) -> Schema m -> Location -> m (Response a)
executeMutation Seq (Selection m)
topSelections Schema m
schema Location
operationLocation
    | Just ObjectType m
mutationType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema = do
        (a
data', Seq Error
errors) <- WriterT (Seq Error) m a -> m (a, Seq Error)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
            (WriterT (Seq Error) m a -> m (a, Seq Error))
-> WriterT (Seq Error) m a -> m (a, Seq Error)
forall a b. (a -> b) -> a -> b
$ (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> HashMap Name (Type m) -> WriterT (Seq Error) m a)
-> HashMap Name (Type m)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> HashMap Name (Type m) -> WriterT (Seq Error) m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema)
            (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> WriterT (Seq Error) m a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
            (ExecutorT m a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a -> (FieldException -> ExecutorT m a) -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
topSelections ObjectType m
mutationType Value
Type.Null [])
            FieldException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
        Response a -> m (Response a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response a -> m (Response a)) -> Response a -> m (Response a)
forall a b. (a -> b) -> a -> b
$ a -> Seq Error -> Response a
forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors
    | Bool
otherwise = Response a -> m (Response a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Response a -> m (Response a)) -> Response a -> m (Response a)
forall a b. (a -> b) -> a -> b
$ a -> Seq Error -> Response a
forall a. a -> Seq Error -> Response a
Response a
forall a. Serialize a => a
null
        (Seq Error -> Response a) -> Seq Error -> Response a
forall a b. (a -> b) -> a -> b
$ Error -> Seq Error
forall a. a -> Seq a
Seq.singleton
        (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Schema doesn't support mutations." [Location
operationLocation] []

executeSelectionSet :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Out.ObjectType m
    -> Type.Value
    -> [Path]
    -> ExecutorT m a
executeSelectionSet :: Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
selections ObjectType m
objectType Value
objectValue [Path]
errorPath = do
    let groupedFieldSet :: OrderedMap (NonEmpty (Field m))
groupedFieldSet = ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
selections
    OrderedMap a
resolvedValues <- (NonEmpty (Field m) -> ExecutorT m (Maybe a))
-> OrderedMap (NonEmpty (Field m)) -> ExecutorT m (OrderedMap a)
forall (f :: * -> *) b a.
Applicative f =>
(a -> f (Maybe b)) -> OrderedMap a -> f (OrderedMap b)
OrderedMap.traverseMaybe NonEmpty (Field m) -> ExecutorT m (Maybe a)
forall b.
Serialize b =>
NonEmpty (Field m) -> ExecutorT m (Maybe b)
go OrderedMap (NonEmpty (Field m))
groupedFieldSet
    Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult (ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NonNullObjectType ObjectType m
objectType) (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ OrderedMap a -> Output a
forall a. OrderedMap a -> Output a
Object OrderedMap a
resolvedValues
  where
    executeField' :: NonEmpty (Field m) -> Resolver m -> ExecutorT m a
executeField' NonEmpty (Field m)
fields Resolver m
resolver =
        Value
-> NonEmpty (Field m) -> Resolver m -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Value
-> NonEmpty (Field m) -> Resolver m -> [Path] -> ExecutorT m a
executeField Value
objectValue NonEmpty (Field m)
fields Resolver m
resolver [Path]
errorPath
    Out.ObjectType Name
_ Maybe Name
_ [InterfaceType m]
_ HashMap Name (Resolver m)
resolvers = ObjectType m
objectType
    go :: NonEmpty (Field m) -> ExecutorT m (Maybe b)
go fields :: NonEmpty (Field m)
fields@(Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ :| [Field m]
_) =
        (Resolver m -> ExecutorT m b)
-> Maybe (Resolver m) -> ExecutorT m (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NonEmpty (Field m) -> Resolver m -> ExecutorT m b
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
NonEmpty (Field m) -> Resolver m -> ExecutorT m a
executeField' NonEmpty (Field m)
fields) (Maybe (Resolver m) -> ExecutorT m (Maybe b))
-> Maybe (Resolver m) -> ExecutorT m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Name -> HashMap Name (Resolver m) -> Maybe (Resolver m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name (Resolver m)
resolvers

fieldsSegment :: forall m. NonEmpty (Transform.Field m) -> Path
fieldsSegment :: NonEmpty (Field m) -> Path
fieldsSegment (Transform.Field Maybe Name
alias Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ :| [Field m]
_) =
    Name -> Path
Segment (Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
fieldName Maybe Name
alias)

viewResolver :: Out.Resolver m -> (Out.Field m, Out.Resolve m)
viewResolver :: Resolver m -> (Field m, Resolve m)
viewResolver (Out.ValueResolver Field m
resolverField' Resolve m
resolveFunction) =
    (Field m
resolverField', Resolve m
resolveFunction)
viewResolver (Out.EventStreamResolver Field m
resolverField' Resolve m
resolveFunction Subscribe m
_) =
    (Field m
resolverField', Resolve m
resolveFunction)

executeField :: forall m a
    . (MonadCatch m, Serialize a)
    => Type.Value
    -> NonEmpty (Transform.Field m)
    -> Out.Resolver m
    -> [Path]
    -> ExecutorT m a
executeField :: Value
-> NonEmpty (Field m) -> Resolver m -> [Path] -> ExecutorT m a
executeField Value
objectValue NonEmpty (Field m)
fields (Resolver m -> (Field m, Resolve m)
forall (m :: * -> *). Resolver m -> (Field m, Resolve m)
viewResolver -> (Field m, Resolve m)
resolverPair) [Path]
errorPath =
    let Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
inputArguments Seq (Selection m)
_ Location
fieldLocation :| [Field m]
_ = NonEmpty (Field m)
fields
     in ExecutorT m a -> [Handler (ExecutorT m) a] -> ExecutorT m a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
catches (Name -> HashMap Name (Node Input) -> ExecutorT m a
forall b.
Serialize b =>
Name -> HashMap Name (Node Input) -> ExecutorT m b
go Name
fieldName HashMap Name (Node Input)
inputArguments)
        [ (FieldException -> ExecutorT m a) -> Handler (ExecutorT m) a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler FieldException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
nullResultHandler
        , (InputCoercionException -> ExecutorT m a)
-> Handler (ExecutorT m) a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (Location -> InputCoercionException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> InputCoercionException -> ExecutorT m a
inputCoercionHandler Location
fieldLocation)
        , (ResultException -> ExecutorT m a) -> Handler (ExecutorT m) a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (Location -> ResultException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResultException -> ExecutorT m a
resultHandler Location
fieldLocation)
        , (ResolverException -> ExecutorT m a) -> Handler (ExecutorT m) a
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (Location -> ResolverException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Location -> ResolverException -> ExecutorT m a
resolverHandler Location
fieldLocation)
        ]
  where
    inputCoercionHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> InputCoercionException
        -> ExecutorT m a
    inputCoercionHandler :: Location -> InputCoercionException -> ExecutorT m a
inputCoercionHandler Location
_ e :: InputCoercionException
e@(InputCoercionException String
_ Type
_ (Just Node Input
valueNode)) =
        let argumentLocation :: Location
argumentLocation = Node Input -> Location
forall k (x :: k) r a. HasField x r a => r -> a
getField @"location" Node Input
valueNode
         in Location -> InputCoercionException -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler Location
argumentLocation InputCoercionException
e
    inputCoercionHandler Location
fieldLocation InputCoercionException
e = Location -> InputCoercionException -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler Location
fieldLocation InputCoercionException
e
    resultHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> ResultException
        -> ExecutorT m a
    resultHandler :: Location -> ResultException -> ExecutorT m a
resultHandler = Location -> ResultException -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler
    resolverHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> ResolverException
        -> ExecutorT m a
    resolverHandler :: Location -> ResolverException -> ExecutorT m a
resolverHandler = Location -> ResolverException -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadThrow m, Serialize a, Exception e) =>
Location -> e -> ExecutorT m a
exceptionHandler
    nullResultHandler :: (MonadCatch m, Serialize a)
        => FieldException
        -> ExecutorT m a
    nullResultHandler :: FieldException -> ExecutorT m a
nullResultHandler e :: FieldException
e@(FieldException Location
fieldLocation [Path]
errorPath' e
next) =
        let newError :: Error
newError = e -> Location -> [Path] -> Error
forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
next Location
fieldLocation [Path]
errorPath'
         in if Type m -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type m
fieldType
             then FieldException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM FieldException
e
             else Error -> ExecutorT m a
forall (m :: * -> *) b.
(Monad m, Serialize b) =>
Error -> ExecutorT m b
returnError Error
newError
    exceptionHandler :: Location -> e -> ExecutorT m a
exceptionHandler Location
errorLocation e
e =
        let newPath :: [Path]
newPath = NonEmpty (Field m) -> Path
forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
errorPath
            newError :: Error
newError = e -> Location -> [Path] -> Error
forall e. Exception e => e -> Location -> [Path] -> Error
constructError e
e Location
errorLocation [Path]
newPath
         in if Type m -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type m
fieldType
             then FieldException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FieldException -> ExecutorT m a)
-> FieldException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Location -> [Path] -> e -> FieldException
forall e. Exception e => Location -> [Path] -> e -> FieldException
FieldException Location
errorLocation [Path]
newPath e
e
             else Error -> ExecutorT m a
forall (m :: * -> *) b.
(Monad m, Serialize b) =>
Error -> ExecutorT m b
returnError Error
newError
    returnError :: Error -> ExecutorT m b
returnError Error
newError = Seq Error -> ExecutorT m ()
forall (m :: * -> *). Monad m => Seq Error -> ExecutorT m ()
tell (Error -> Seq Error
forall a. a -> Seq a
Seq.singleton Error
newError) ExecutorT m () -> ExecutorT m b -> ExecutorT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> ExecutorT m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Serialize a => a
null
    go :: Name -> HashMap Name (Node Input) -> ExecutorT m b
go Name
fieldName HashMap Name (Node Input)
inputArguments = do
        Subs
argumentValues <- HashMap Name Argument
-> HashMap Name (Node Input) -> ExecutorT m Subs
forall (m :: * -> *).
MonadCatch m =>
HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentTypes HashMap Name (Node Input)
inputArguments
        Value
resolvedValue <-
           Resolve m -> Value -> Name -> Subs -> ExecutorT m Value
forall (m :: * -> *).
MonadCatch m =>
Resolve m -> Value -> Name -> Subs -> ExecutorT m Value
resolveFieldValue Resolve m
resolveFunction Value
objectValue Name
fieldName Subs
argumentValues
        Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m b
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue Type m
fieldType NonEmpty (Field m)
fields [Path]
errorPath Value
resolvedValue
    (Field m
resolverField, Resolve m
resolveFunction) = (Field m, Resolve m)
resolverPair
    Out.Field Maybe Name
_ Type m
fieldType HashMap Name Argument
argumentTypes = Field m
resolverField

resolveFieldValue :: MonadCatch m
    => Out.Resolve m
    -> Type.Value
    -> Full.Name
    -> Type.Subs
    -> ExecutorT m Type.Value
resolveFieldValue :: Resolve m -> Value -> Name -> Subs -> ExecutorT m Value
resolveFieldValue Resolve m
resolver Value
objectValue Name
_fieldName Subs
argumentValues =
    m Value -> ExecutorT m Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Value -> ExecutorT m Value) -> m Value -> ExecutorT m Value
forall a b. (a -> b) -> a -> b
$ Resolve m -> Context -> m Value
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Resolve m
resolver Context
context
  where
    context :: Context
context = Context :: Arguments -> Value -> Context
Type.Context
        { arguments :: Arguments
Type.arguments = Subs -> Arguments
Type.Arguments Subs
argumentValues
        , values :: Value
Type.values = Value
objectValue
        }

resolveAbstractType :: Monad m
    => Type.Internal.AbstractType m
    -> Type.Subs
    -> ExecutorT m (Maybe (Out.ObjectType m))
resolveAbstractType :: AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
values'
    | Just (Type.String Name
typeName) <- Name -> Subs -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"__typename" Subs
values' = do
        HashMap Name (Type m)
types' <- ReaderT
  (HashMap Name (Type m))
  (WriterT (Seq Error) m)
  (HashMap Name (Type m))
-> ExecutorT m (HashMap Name (Type m))
forall (m :: * -> *) a.
ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> ExecutorT m a
ExecutorT ReaderT
  (HashMap Name (Type m))
  (WriterT (Seq Error) m)
  (HashMap Name (Type m))
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        case Name -> HashMap Name (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
typeName HashMap Name (Type m)
types' of
            Just (Type.Internal.ObjectType ObjectType m
objectType) ->
                if ObjectType m -> AbstractType m -> Bool
forall (m :: * -> *). ObjectType m -> AbstractType m -> Bool
Type.Internal.instanceOf ObjectType m
objectType AbstractType m
abstractType
                    then Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m)))
-> Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m))
forall a b. (a -> b) -> a -> b
$ ObjectType m -> Maybe (ObjectType m)
forall a. a -> Maybe a
Just ObjectType m
objectType
                    else Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing
            Maybe (Type m)
_ -> Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing
    | Bool
otherwise = Maybe (ObjectType m) -> ExecutorT m (Maybe (ObjectType m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ObjectType m)
forall a. Maybe a
Nothing

completeValue :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> NonEmpty (Transform.Field m)
    -> [Path]
    -> Type.Value
    -> ExecutorT m a
completeValue :: Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue (Type m -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType -> Bool
False) NonEmpty (Field m)
_ [Path]
_ Value
Type.Null =
    a -> ExecutorT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Serialize a => a
null
completeValue outputType :: Type m
outputType@(Out.ListBaseType Type m
listType) NonEmpty (Field m)
fields [Path]
errorPath (Type.List [Value]
list)
    = ((Int, [a]) -> Value -> ExecutorT m (Int, [a]))
-> (Int, [a]) -> [Value] -> ExecutorT m (Int, [a])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Int, [a]) -> Value -> ExecutorT m (Int, [a])
forall a.
Serialize a =>
(Int, [a]) -> Value -> ExecutorT m (Int, [a])
go (Int
0, []) [Value]
list ExecutorT m (Int, [a])
-> ((Int, [a]) -> ExecutorT m a) -> ExecutorT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a)
-> ((Int, [a]) -> Output a) -> (Int, [a]) -> ExecutorT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Output a
forall a. [a] -> Output a
List ([a] -> Output a) -> ((Int, [a]) -> [a]) -> (Int, [a]) -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd
  where
    go :: (Int, [a]) -> Value -> ExecutorT m (Int, [a])
go (Int
index, [a]
accumulator) Value
listItem = do
        let updatedPath :: [Path]
updatedPath = Int -> Path
Index Int
index Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
errorPath
        a
completedValue <- Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> NonEmpty (Field m) -> [Path] -> Value -> ExecutorT m a
completeValue Type m
listType NonEmpty (Field m)
fields [Path]
updatedPath Value
listItem
        (Int, [a]) -> ExecutorT m (Int, [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
completedValue a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
accumulator)
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Int Int32
int) =
    Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Int32 -> Output a
forall a. Int32 -> Output a
Int Int32
int
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Boolean Bool
boolean) =
    Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Bool -> Output a
forall a. Bool -> Output a
Boolean Bool
boolean
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.Float Double
float) =
    Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Double -> Output a
forall a. Double -> Output a
Float Double
float
completeValue outputType :: Type m
outputType@(Out.ScalarBaseType ScalarType
_) NonEmpty (Field m)
_ [Path]
_ (Type.String Name
string) =
    Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Name -> Output a
forall a. Name -> Output a
String Name
string
completeValue outputType :: Type m
outputType@(Out.EnumBaseType EnumType
enumType) NonEmpty (Field m)
_ [Path]
_ (Type.Enum Name
enum) =
    let Type.EnumType Name
_ Maybe Name
_ HashMap Name EnumValue
enumMembers = EnumType
enumType
     in if Name -> HashMap Name EnumValue -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Name
enum HashMap Name EnumValue
enumMembers
        then Type m -> Output a -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType (Output a -> ExecutorT m a) -> Output a -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ Name -> Output a
forall a. Name -> Output a
Enum Name
enum
        else ValueCompletionException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
            (ValueCompletionException -> ExecutorT m a)
-> ValueCompletionException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (Type m -> String
forall a. Show a => a -> String
show Type m
outputType)
            (Value -> ValueCompletionException)
-> Value -> ValueCompletionException
forall a b. (a -> b) -> a -> b
$ Name -> Value
Type.Enum Name
enum
completeValue (Out.ObjectBaseType ObjectType m
objectType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
    = Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result
    ([Path] -> ExecutorT m a) -> [Path] -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Path
forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
errorPath
completeValue outputType :: Type m
outputType@(Out.InterfaceBaseType InterfaceType m
interfaceType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
    | Type.Object Subs
objectMap <- Value
result = do
        let abstractType :: AbstractType m
abstractType = InterfaceType m -> AbstractType m
forall (m :: * -> *). InterfaceType m -> AbstractType m
Type.Internal.AbstractInterfaceType InterfaceType m
interfaceType
        Maybe (ObjectType m)
concreteType <- AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
        case Maybe (ObjectType m)
concreteType of
            Just ObjectType m
objectType
                -> Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result
                ([Path] -> ExecutorT m a) -> [Path] -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Path
forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
errorPath
            Maybe (ObjectType m)
Nothing -> ValueCompletionException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                (ValueCompletionException -> ExecutorT m a)
-> ValueCompletionException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (Type m -> String
forall a. Show a => a -> String
show Type m
outputType) Value
result
completeValue outputType :: Type m
outputType@(Out.UnionBaseType UnionType m
unionType) NonEmpty (Field m)
fields [Path]
errorPath Value
result
    | Type.Object Subs
objectMap <- Value
result = do
        let abstractType :: AbstractType m
abstractType = UnionType m -> AbstractType m
forall (m :: * -> *). UnionType m -> AbstractType m
Type.Internal.AbstractUnionType UnionType m
unionType
        Maybe (ObjectType m)
concreteType <- AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
forall (m :: * -> *).
Monad m =>
AbstractType m -> Subs -> ExecutorT m (Maybe (ObjectType m))
resolveAbstractType AbstractType m
abstractType Subs
objectMap
        case Maybe (ObjectType m)
concreteType of
            Just ObjectType m
objectType
                -> Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet (NonEmpty (Field m) -> Seq (Selection m)
forall (m :: * -> *).
MonadCatch m =>
NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets NonEmpty (Field m)
fields) ObjectType m
objectType Value
result
                ([Path] -> ExecutorT m a) -> [Path] -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ NonEmpty (Field m) -> Path
forall (m :: * -> *). NonEmpty (Field m) -> Path
fieldsSegment NonEmpty (Field m)
fields Path -> [Path] -> [Path]
forall a. a -> [a] -> [a]
: [Path]
errorPath
            Maybe (ObjectType m)
Nothing -> ValueCompletionException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                (ValueCompletionException -> ExecutorT m a)
-> ValueCompletionException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (Type m -> String
forall a. Show a => a -> String
show Type m
outputType) Value
result
completeValue Type m
outputType NonEmpty (Field m)
_ [Path]
_ Value
result =
    ValueCompletionException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ValueCompletionException -> ExecutorT m a)
-> ValueCompletionException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ String -> Value -> ValueCompletionException
ValueCompletionException (Type m -> String
forall a. Show a => a -> String
show Type m
outputType) Value
result

coerceResult :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> Output a
    -> ExecutorT m a
coerceResult :: Type m -> Output a -> ExecutorT m a
coerceResult Type m
outputType Output a
result
    | Just a
serialized <- Type m -> Output a -> Maybe a
forall a (m :: * -> *).
Serialize a =>
Type m -> Output a -> Maybe a
serialize Type m
outputType Output a
result = a -> ExecutorT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
serialized
    | Bool
otherwise = ResultCoercionException -> ExecutorT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ResultCoercionException -> ExecutorT m a)
-> ResultCoercionException -> ExecutorT m a
forall a b. (a -> b) -> a -> b
$ String -> ResultCoercionException
ResultCoercionException (String -> ResultCoercionException)
-> String -> ResultCoercionException
forall a b. (a -> b) -> a -> b
$ Type m -> String
forall a. Show a => a -> String
show Type m
outputType

mergeSelectionSets :: MonadCatch m
    => NonEmpty (Transform.Field m)
    -> Seq (Transform.Selection m)
mergeSelectionSets :: NonEmpty (Field m) -> Seq (Selection m)
mergeSelectionSets = (Field m -> Seq (Selection m) -> Seq (Selection m))
-> Seq (Selection m) -> NonEmpty (Field m) -> Seq (Selection m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Field m -> Seq (Selection m) -> Seq (Selection m)
forall (m :: * -> *).
Field m -> Seq (Selection m) -> Seq (Selection m)
forEach Seq (Selection m)
forall a. Monoid a => a
mempty
  where
    forEach :: Field m -> Seq (Selection m) -> Seq (Selection m)
forEach (Transform.Field Maybe Name
_ Name
_ HashMap Name (Node Input)
_ Seq (Selection m)
fieldSelectionSet Location
_) Seq (Selection m)
selectionSet' =
        Seq (Selection m)
selectionSet' Seq (Selection m) -> Seq (Selection m) -> Seq (Selection m)
forall a. Semigroup a => a -> a -> a
<> Seq (Selection m)
fieldSelectionSet

coerceArgumentValues :: MonadCatch m
    => HashMap Full.Name In.Argument
    -> HashMap Full.Name (Full.Node Transform.Input)
    -> m Type.Subs
coerceArgumentValues :: HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentDefinitions HashMap Name (Node Input)
argumentValues =
    (Name -> Argument -> (Subs -> m Subs) -> Subs -> m Subs)
-> (Subs -> m Subs) -> HashMap Name Argument -> Subs -> m Subs
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Name -> Argument -> (Subs -> m Subs) -> Subs -> m Subs
forall (m :: * -> *) b.
MonadCatch m =>
Name -> Argument -> (Subs -> m b) -> Subs -> m b
c Subs -> m Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Name Argument
argumentDefinitions Subs
forall a. Monoid a => a
mempty
  where
    c :: Name -> Argument -> (Subs -> m b) -> Subs -> m b
c Name
argumentName Argument
argumentType Subs -> m b
pure' Subs
resultMap =
        Name -> Argument -> Subs -> m Subs
forall (m :: * -> *).
MonadCatch m =>
Name -> Argument -> Subs -> m Subs
forEach Name
argumentName Argument
argumentType Subs
resultMap m Subs -> (Subs -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Subs -> m b
pure'
    forEach :: MonadCatch m
         => Full.Name
         -> In.Argument
         -> Type.Subs
         -> m Type.Subs
    forEach :: Name -> Argument -> Subs -> m Subs
forEach Name
argumentName (In.Argument Maybe Name
_ Type
variableType Maybe Value
defaultValue) Subs
resultMap = do
        let matchedMap :: Maybe Subs
matchedMap
                = Name -> Type -> Maybe Value -> Maybe Subs -> Maybe Subs
matchFieldValues' Name
argumentName Type
variableType Maybe Value
defaultValue
                (Maybe Subs -> Maybe Subs) -> Maybe Subs -> Maybe Subs
forall a b. (a -> b) -> a -> b
$ Subs -> Maybe Subs
forall a. a -> Maybe a
Just Subs
resultMap
         in case Maybe Subs
matchedMap of
            Just Subs
matchedValues -> Subs -> m Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
matchedValues
            Maybe Subs
Nothing
                | Just Node Input
inputValue <- Name -> HashMap Name (Node Input) -> Maybe (Node Input)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
argumentName HashMap Name (Node Input)
argumentValues
                    -> InputCoercionException -> m Subs
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                    (InputCoercionException -> m Subs)
-> InputCoercionException -> m Subs
forall a b. (a -> b) -> a -> b
$ String -> Type -> Maybe (Node Input) -> InputCoercionException
InputCoercionException (Name -> String
Text.unpack Name
argumentName) Type
variableType
                    (Maybe (Node Input) -> InputCoercionException)
-> Maybe (Node Input) -> InputCoercionException
forall a b. (a -> b) -> a -> b
$ Node Input -> Maybe (Node Input)
forall a. a -> Maybe a
Just Node Input
inputValue
                | Bool
otherwise -> InputCoercionException -> m Subs
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
                    (InputCoercionException -> m Subs)
-> InputCoercionException -> m Subs
forall a b. (a -> b) -> a -> b
$ String -> Type -> Maybe (Node Input) -> InputCoercionException
InputCoercionException (Name -> String
Text.unpack Name
argumentName) Type
variableType Maybe (Node Input)
forall a. Maybe a
Nothing
    matchFieldValues' :: Name -> Type -> Maybe Value -> Maybe Subs -> Maybe Subs
matchFieldValues' = (Type -> Input -> Maybe Value)
-> HashMap Name Input
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue
        (HashMap Name Input
 -> Name -> Type -> Maybe Value -> Maybe Subs -> Maybe Subs)
-> HashMap Name Input
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a b. (a -> b) -> a -> b
$ Node Input -> Input
forall a. Node a -> a
Full.node (Node Input -> Input)
-> HashMap Name (Node Input) -> HashMap Name Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (Node Input)
argumentValues
    coerceArgumentValue :: Type -> Input -> Maybe Value
coerceArgumentValue Type
inputType (Transform.Int Int32
integer) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Int32 -> Value
Type.Int Int32
integer)
    coerceArgumentValue Type
inputType (Transform.Boolean Bool
boolean) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Bool -> Value
Type.Boolean Bool
boolean)
    coerceArgumentValue Type
inputType (Transform.String Name
string) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Name -> Value
Type.String Name
string)
    coerceArgumentValue Type
inputType (Transform.Float Double
float) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Double -> Value
Type.Float Double
float)
    coerceArgumentValue Type
inputType (Transform.Enum Name
enum) =
        Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType (Name -> Value
Type.Enum Name
enum)
    coerceArgumentValue Type
inputType Input
Transform.Null
        | Type -> Bool
In.isNonNullType Type
inputType = Maybe Value
forall a. Maybe a
Nothing
        | Bool
otherwise = Type -> Value -> Maybe Value
coerceInputLiteral Type
inputType Value
Type.Null
    coerceArgumentValue (In.ListBaseType Type
inputType) (Transform.List [Input]
list) =
        let coerceItem :: Input -> Maybe Value
coerceItem = Type -> Input -> Maybe Value
coerceArgumentValue Type
inputType
         in [Value] -> Value
Type.List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Input -> Maybe Value) -> [Input] -> Maybe [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Input -> Maybe Value
coerceItem [Input]
list
    coerceArgumentValue (In.InputObjectBaseType InputObjectType
inputType) (Transform.Object HashMap Name Input
object)
        | In.InputObjectType Name
_ Maybe Name
_ HashMap Name InputField
inputFields <- InputObjectType
inputType = 
            let go :: Name -> InputField -> Maybe Subs -> Maybe Subs
go = HashMap Name Input
-> Name -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Name Input
object
                resultMap :: Maybe Subs
resultMap = (Name -> InputField -> Maybe Subs -> Maybe Subs)
-> Maybe Subs -> HashMap Name InputField -> Maybe Subs
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Name -> InputField -> Maybe Subs -> Maybe Subs
go (Subs -> Maybe Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
forall a. Monoid a => a
mempty) HashMap Name InputField
inputFields
             in Subs -> Value
Type.Object (Subs -> Value) -> Maybe Subs -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Subs
resultMap
    coerceArgumentValue Type
_ (Transform.Variable Value
variable) = Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
variable
    coerceArgumentValue Type
_ Input
_ = Maybe Value
forall a. Maybe a
Nothing
    forEachField :: HashMap Name Input
-> Name -> InputField -> Maybe Subs -> Maybe Subs
forEachField HashMap Name Input
object Name
variableName (In.InputField Maybe Name
_ Type
variableType Maybe Value
defaultValue) =
        (Type -> Input -> Maybe Value)
-> HashMap Name Input
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues Type -> Input -> Maybe Value
coerceArgumentValue HashMap Name Input
object Name
variableName Type
variableType Maybe Value
defaultValue

collectFields :: Monad m
    => Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> OrderedMap (NonEmpty (Transform.Field m))
collectFields :: ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType = (OrderedMap (NonEmpty (Field m))
 -> Selection m -> OrderedMap (NonEmpty (Field m)))
-> OrderedMap (NonEmpty (Field m))
-> Seq (Selection m)
-> OrderedMap (NonEmpty (Field m))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl OrderedMap (NonEmpty (Field m))
-> Selection m -> OrderedMap (NonEmpty (Field m))
forEach OrderedMap (NonEmpty (Field m))
forall v. OrderedMap v
OrderedMap.empty
  where
    forEach :: OrderedMap (NonEmpty (Field m))
-> Selection m -> OrderedMap (NonEmpty (Field m))
forEach OrderedMap (NonEmpty (Field m))
groupedFields (Transform.FieldSelection Field m
fieldSelection) =
        let Transform.Field Maybe Name
maybeAlias Name
fieldName HashMap Name (Node Input)
_ Seq (Selection m)
_ Location
_ = Field m
fieldSelection
            responseKey :: Name
responseKey = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
fieldName Maybe Name
maybeAlias
         in Name
-> NonEmpty (Field m)
-> OrderedMap (NonEmpty (Field m))
-> OrderedMap (NonEmpty (Field m))
forall v. Semigroup v => Name -> v -> OrderedMap v -> OrderedMap v
OrderedMap.insert Name
responseKey (Field m
fieldSelection Field m -> [Field m] -> NonEmpty (Field m)
forall a. a -> [a] -> NonEmpty a
:| []) OrderedMap (NonEmpty (Field m))
groupedFields
    forEach OrderedMap (NonEmpty (Field m))
groupedFields (Transform.FragmentSelection Fragment m
selectionFragment)
        | Transform.Fragment CompositeType m
fragmentType Seq (Selection m)
fragmentSelectionSet Location
_ <- Fragment m
selectionFragment
        , CompositeType m -> ObjectType m -> Bool
forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
Type.Internal.doesFragmentTypeApply CompositeType m
fragmentType ObjectType m
objectType =
            let fragmentGroupedFieldSet :: OrderedMap (NonEmpty (Field m))
fragmentGroupedFieldSet =
                    ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
objectType Seq (Selection m)
fragmentSelectionSet
             in OrderedMap (NonEmpty (Field m))
groupedFields OrderedMap (NonEmpty (Field m))
-> OrderedMap (NonEmpty (Field m))
-> OrderedMap (NonEmpty (Field m))
forall a. Semigroup a => a -> a -> a
<> OrderedMap (NonEmpty (Field m))
fragmentGroupedFieldSet
        | Bool
otherwise = OrderedMap (NonEmpty (Field m))
groupedFields

coerceVariableValues :: (Monad m, VariableValue b)
    => HashMap Full.Name (Schema.Type m)
    -> Full.OperationDefinition
    -> HashMap Full.Name b
    -> Either QueryError Type.Subs
coerceVariableValues :: HashMap Name (Type m)
-> OperationDefinition -> HashMap Name b -> Either QueryError Subs
coerceVariableValues HashMap Name (Type m)
types OperationDefinition
operationDefinition' HashMap Name b
variableValues
    | Full.OperationDefinition OperationType
_ Maybe Name
_ [VariableDefinition]
variableDefinitions [Directive]
_ SelectionSet
_ Location
_ <-
        OperationDefinition
operationDefinition'
    = (VariableDefinition
 -> Either QueryError Subs -> Either QueryError Subs)
-> Either QueryError Subs
-> [VariableDefinition]
-> Either QueryError Subs
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr VariableDefinition
-> Either QueryError Subs -> Either QueryError Subs
forEach (Subs -> Either QueryError Subs
forall a b. b -> Either a b
Right Subs
forall k v. HashMap k v
HashMap.empty) [VariableDefinition]
variableDefinitions
    | Bool
otherwise = Subs -> Either QueryError Subs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subs
forall a. Monoid a => a
mempty
  where
    forEach :: VariableDefinition
-> Either QueryError Subs -> Either QueryError Subs
forEach VariableDefinition
variableDefinition (Right Subs
coercedValues) =
        let Full.VariableDefinition Name
variableName Type
variableTypeName Maybe (Node ConstValue)
defaultValue Location
_ =
                VariableDefinition
variableDefinition
            defaultValue' :: Maybe Value
defaultValue' = ConstValue -> Value
constValue (ConstValue -> Value)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node (Node ConstValue -> Value)
-> Maybe (Node ConstValue) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Node ConstValue)
defaultValue
         in case Type -> HashMap Name (Type m) -> Maybe Type
forall (m :: * -> *). Type -> HashMap Name (Type m) -> Maybe Type
Type.Internal.lookupInputType Type
variableTypeName HashMap Name (Type m)
types of
            Just Type
variableType ->
                Either QueryError Subs
-> (Subs -> Either QueryError Subs)
-> Maybe Subs
-> Either QueryError Subs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (QueryError -> Either QueryError Subs
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Subs)
-> QueryError -> Either QueryError Subs
forall a b. (a -> b) -> a -> b
$ VariableDefinition -> QueryError
CoercionError VariableDefinition
variableDefinition) Subs -> Either QueryError Subs
forall a b. b -> Either a b
Right
                    (Maybe Subs -> Either QueryError Subs)
-> Maybe Subs -> Either QueryError Subs
forall a b. (a -> b) -> a -> b
$ (Type -> b -> Maybe Value)
-> HashMap Name b
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
forall a.
(Type -> a -> Maybe Value)
-> HashMap Name a
-> Name
-> Type
-> Maybe Value
-> Maybe Subs
-> Maybe Subs
matchFieldValues
                        Type -> b -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue'
                        HashMap Name b
variableValues
                        Name
variableName
                        Type
variableType
                        Maybe Value
defaultValue'
                    (Maybe Subs -> Maybe Subs) -> Maybe Subs -> Maybe Subs
forall a b. (a -> b) -> a -> b
$ Subs -> Maybe Subs
forall a. a -> Maybe a
Just Subs
coercedValues
            Maybe Type
Nothing -> QueryError -> Either QueryError Subs
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Subs)
-> QueryError -> Either QueryError Subs
forall a b. (a -> b) -> a -> b
$ VariableDefinition -> QueryError
UnknownInputType VariableDefinition
variableDefinition
    forEach VariableDefinition
_ Either QueryError Subs
coercedValuesOrError = Either QueryError Subs
coercedValuesOrError
    coerceVariableValue' :: Type -> a -> Maybe Value
coerceVariableValue' Type
variableType a
value'
        = Type -> a -> Maybe Value
forall a. VariableValue a => Type -> a -> Maybe Value
coerceVariableValue Type
variableType a
value'
        Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Value -> Maybe Value
coerceInputLiteral Type
variableType

constValue :: Full.ConstValue -> Type.Value
constValue :: ConstValue -> Value
constValue (Full.ConstInt Int32
i) = Int32 -> Value
Type.Int Int32
i
constValue (Full.ConstFloat Double
f) = Double -> Value
Type.Float Double
f
constValue (Full.ConstString Name
x) = Name -> Value
Type.String Name
x
constValue (Full.ConstBoolean Bool
b) = Bool -> Value
Type.Boolean Bool
b
constValue ConstValue
Full.ConstNull = Value
Type.Null
constValue (Full.ConstEnum Name
e) = Name -> Value
Type.Enum Name
e
constValue (Full.ConstList [Node ConstValue]
list) = [Value] -> Value
Type.List ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ ConstValue -> Value
constValue (ConstValue -> Value)
-> (Node ConstValue -> ConstValue) -> Node ConstValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node (Node ConstValue -> Value) -> [Node ConstValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node ConstValue]
list
constValue (Full.ConstObject [ObjectField ConstValue]
o) =
    Subs -> Value
Type.Object (Subs -> Value) -> Subs -> Value
forall a b. (a -> b) -> a -> b
$ [(Name, Value)] -> Subs
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, Value)] -> Subs) -> [(Name, Value)] -> Subs
forall a b. (a -> b) -> a -> b
$ ObjectField ConstValue -> (Name, Value)
constObjectField (ObjectField ConstValue -> (Name, Value))
-> [ObjectField ConstValue] -> [(Name, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField ConstValue]
o
  where
    constObjectField :: ObjectField ConstValue -> (Name, Value)
constObjectField Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Name
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
location :: Location
name :: Name
..} =
        (Name
name, ConstValue -> Value
constValue (ConstValue -> Value) -> ConstValue -> Value
forall a b. (a -> b) -> a -> b
$ Node ConstValue -> ConstValue
forall a. Node a -> a
Full.node Node ConstValue
value')

subscribe :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> Full.Location
    -> m (Either Error (ResponseEventStream m a))
subscribe :: Seq (Selection m)
-> Schema m
-> Location
-> m (Either Error (ResponseEventStream m a))
subscribe Seq (Selection m)
fields Schema m
schema Location
objectLocation
    | Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema = do
        let types' :: HashMap Name (Type m)
types' = Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema
        Either Error (SourceEventStream m)
sourceStream <-
            HashMap Name (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (SourceEventStream m))
forall (m :: * -> *).
MonadCatch m =>
HashMap Name (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (SourceEventStream m))
createSourceEventStream HashMap Name (Type m)
types' ObjectType m
objectType Location
objectLocation Seq (Selection m)
fields
        let traverser :: SourceEventStream m -> m (ResponseEventStream m a)
traverser =
                HashMap Name (Type m)
-> ObjectType m
-> Seq (Selection m)
-> SourceEventStream m
-> m (ResponseEventStream m a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m
-> Seq (Selection m)
-> SourceEventStream m
-> m (ResponseEventStream m a)
mapSourceToResponseEvent HashMap Name (Type m)
types' ObjectType m
objectType Seq (Selection m)
fields
        (SourceEventStream m -> m (ResponseEventStream m a))
-> Either Error (SourceEventStream m)
-> m (Either Error (ResponseEventStream m a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceEventStream m -> m (ResponseEventStream m a)
traverser Either Error (SourceEventStream m)
sourceStream
    | Bool
otherwise = Either Error (ResponseEventStream m a)
-> m (Either Error (ResponseEventStream m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error (ResponseEventStream m a)
 -> m (Either Error (ResponseEventStream m a)))
-> Either Error (ResponseEventStream m a)
-> m (Either Error (ResponseEventStream m a))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ResponseEventStream m a)
forall a b. a -> Either a b
Left
        (Error -> Either Error (ResponseEventStream m a))
-> Error -> Either Error (ResponseEventStream m a)
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Schema doesn't support subscriptions." [] []

mapSourceToResponseEvent :: (MonadCatch m, Serialize a)
    => HashMap Full.Name (Type m)
    -> Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> Out.SourceEventStream m
    -> m (ResponseEventStream m a)
mapSourceToResponseEvent :: HashMap Name (Type m)
-> ObjectType m
-> Seq (Selection m)
-> SourceEventStream m
-> m (ResponseEventStream m a)
mapSourceToResponseEvent HashMap Name (Type m)
types' ObjectType m
subscriptionType Seq (Selection m)
fields SourceEventStream m
sourceStream
    = ResponseEventStream m a -> m (ResponseEventStream m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ResponseEventStream m a -> m (ResponseEventStream m a))
-> ResponseEventStream m a -> m (ResponseEventStream m a)
forall a b. (a -> b) -> a -> b
$ SourceEventStream m
sourceStream
    SourceEventStream m
-> ConduitM Value (Response a) m () -> ResponseEventStream m a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Value -> m (Response a)) -> ConduitM Value (Response a) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC (HashMap Name (Type m)
-> ObjectType m -> Seq (Selection m) -> Value -> m (Response a)
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
HashMap Name (Type m)
-> ObjectType m -> Seq (Selection m) -> Value -> m (Response a)
executeSubscriptionEvent HashMap Name (Type m)
types' ObjectType m
subscriptionType Seq (Selection m)
fields)

createSourceEventStream :: MonadCatch m
    => HashMap Full.Name (Type m)
    -> Out.ObjectType m
    -> Full.Location
    -> Seq (Transform.Selection m)
    -> m (Either Error (Out.SourceEventStream m))
createSourceEventStream :: HashMap Name (Type m)
-> ObjectType m
-> Location
-> Seq (Selection m)
-> m (Either Error (SourceEventStream m))
createSourceEventStream HashMap Name (Type m)
_types ObjectType m
subscriptionType Location
objectLocation Seq (Selection m)
fields
    | [NonEmpty (Field m)
fieldGroup] <- OrderedMap (NonEmpty (Field m)) -> [NonEmpty (Field m)]
forall v. OrderedMap v -> [v]
OrderedMap.elems OrderedMap (NonEmpty (Field m))
groupedFieldSet
    , Transform.Field Maybe Name
_ Name
fieldName HashMap Name (Node Input)
arguments' Seq (Selection m)
_ Location
errorLocation <-
        NonEmpty (Field m) -> Field m
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (Field m)
fieldGroup
    , Out.ObjectType Name
_ Maybe Name
_ [InterfaceType m]
_ HashMap Name (Resolver m)
fieldTypes <- ObjectType m
subscriptionType
    , Resolver m
resolverT <- HashMap Name (Resolver m)
fieldTypes HashMap Name (Resolver m) -> Name -> Resolver m
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Name
fieldName
    , Out.EventStreamResolver Field m
fieldDefinition Resolve m
_ Subscribe m
resolver <- Resolver m
resolverT
    , Out.Field Maybe Name
_ Type m
_fieldType HashMap Name Argument
argumentDefinitions <- Field m
fieldDefinition =
        case HashMap Name Argument
-> HashMap Name (Node Input) -> Either SomeException Subs
forall (m :: * -> *).
MonadCatch m =>
HashMap Name Argument -> HashMap Name (Node Input) -> m Subs
coerceArgumentValues HashMap Name Argument
argumentDefinitions HashMap Name (Node Input)
arguments' of
            Left SomeException
_ -> Either Error (SourceEventStream m)
-> m (Either Error (SourceEventStream m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (Either Error (SourceEventStream m)
 -> m (Either Error (SourceEventStream m)))
-> Either Error (SourceEventStream m)
-> m (Either Error (SourceEventStream m))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (SourceEventStream m)
forall a b. a -> Either a b
Left
                (Error -> Either Error (SourceEventStream m))
-> Error -> Either Error (SourceEventStream m)
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Argument coercion failed." [Location
errorLocation] []
            Right  Subs
argumentValues -> (String -> Error)
-> Either String (SourceEventStream m)
-> Either Error (SourceEventStream m)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ([Location] -> String -> Error
singleError [Location
errorLocation])
                (Either String (SourceEventStream m)
 -> Either Error (SourceEventStream m))
-> m (Either String (SourceEventStream m))
-> m (Either Error (SourceEventStream m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Subs -> Subscribe m -> m (Either String (SourceEventStream m))
forall (m :: * -> *).
MonadCatch m =>
Value
-> Subs -> Subscribe m -> m (Either String (SourceEventStream m))
resolveFieldEventStream Value
Type.Null Subs
argumentValues Subscribe m
resolver
    | Bool
otherwise = Either Error (SourceEventStream m)
-> m (Either Error (SourceEventStream m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either Error (SourceEventStream m)
 -> m (Either Error (SourceEventStream m)))
-> Either Error (SourceEventStream m)
-> m (Either Error (SourceEventStream m))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (SourceEventStream m)
forall a b. a -> Either a b
Left
        (Error -> Either Error (SourceEventStream m))
-> Error -> Either Error (SourceEventStream m)
forall a b. (a -> b) -> a -> b
$ Name -> [Location] -> [Path] -> Error
Error Name
"Subscription contains more than one field." [Location
objectLocation] []
  where
    groupedFieldSet :: OrderedMap (NonEmpty (Field m))
groupedFieldSet = ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
forall (m :: * -> *).
Monad m =>
ObjectType m
-> Seq (Selection m) -> OrderedMap (NonEmpty (Field m))
collectFields ObjectType m
subscriptionType Seq (Selection m)
fields
    singleError :: [Full.Location] -> String -> Error
    singleError :: [Location] -> String -> Error
singleError [Location]
errorLocations String
message = Name -> [Location] -> [Path] -> Error
Error (String -> Name
Text.pack String
message) [Location]
errorLocations []

resolveFieldEventStream :: MonadCatch m
    => Type.Value
    -> Type.Subs
    -> Out.Subscribe m
    -> m (Either String (Out.SourceEventStream m))
resolveFieldEventStream :: Value
-> Subs -> Subscribe m -> m (Either String (SourceEventStream m))
resolveFieldEventStream Value
result Subs
args Subscribe m
resolver =
    m (Either String (SourceEventStream m))
-> (ResolverException -> m (Either String (SourceEventStream m)))
-> m (Either String (SourceEventStream m))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (SourceEventStream m -> Either String (SourceEventStream m)
forall a b. b -> Either a b
Right (SourceEventStream m -> Either String (SourceEventStream m))
-> m (SourceEventStream m)
-> m (Either String (SourceEventStream m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Subscribe m -> Context -> m (SourceEventStream m)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Subscribe m
resolver Context
context) ResolverException -> m (Either String (SourceEventStream m))
forall (m :: * -> *).
MonadCatch m =>
ResolverException -> m (Either String (SourceEventStream m))
handleEventStreamError
  where
    handleEventStreamError :: MonadCatch m
        => ResolverException
        -> m (Either String (Out.SourceEventStream m))
    handleEventStreamError :: ResolverException -> m (Either String (SourceEventStream m))
handleEventStreamError = Either String (SourceEventStream m)
-> m (Either String (SourceEventStream m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (SourceEventStream m)
 -> m (Either String (SourceEventStream m)))
-> (ResolverException -> Either String (SourceEventStream m))
-> ResolverException
-> m (Either String (SourceEventStream m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (SourceEventStream m)
forall a b. a -> Either a b
Left (String -> Either String (SourceEventStream m))
-> (ResolverException -> String)
-> ResolverException
-> Either String (SourceEventStream m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverException -> String
forall e. Exception e => e -> String
displayException
    context :: Context
context = Context :: Arguments -> Value -> Context
Type.Context
        { arguments :: Arguments
Type.arguments = Subs -> Arguments
Type.Arguments Subs
args
        , values :: Value
Type.values = Value
result
        }

executeSubscriptionEvent :: (MonadCatch m, Serialize a)
    => HashMap Full.Name (Type m)
    -> Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> Type.Value
    -> m (Response a)
executeSubscriptionEvent :: HashMap Name (Type m)
-> ObjectType m -> Seq (Selection m) -> Value -> m (Response a)
executeSubscriptionEvent HashMap Name (Type m)
types' ObjectType m
objectType Seq (Selection m)
fields Value
initialValue = do
    (a
data', Seq Error
errors) <- WriterT (Seq Error) m a -> m (a, Seq Error)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
        (WriterT (Seq Error) m a -> m (a, Seq Error))
-> WriterT (Seq Error) m a -> m (a, Seq Error)
forall a b. (a -> b) -> a -> b
$ (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> HashMap Name (Type m) -> WriterT (Seq Error) m a)
-> HashMap Name (Type m)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> HashMap Name (Type m) -> WriterT (Seq Error) m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HashMap Name (Type m)
types'
        (ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
 -> WriterT (Seq Error) m a)
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
-> WriterT (Seq Error) m a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall (m :: * -> *) a.
ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
runExecutorT
        (ExecutorT m a
 -> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a)
-> ExecutorT m a
-> ReaderT (HashMap Name (Type m)) (WriterT (Seq Error) m) a
forall a b. (a -> b) -> a -> b
$ ExecutorT m a -> (FieldException -> ExecutorT m a) -> ExecutorT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
Seq (Selection m)
-> ObjectType m -> Value -> [Path] -> ExecutorT m a
executeSelectionSet Seq (Selection m)
fields ObjectType m
objectType Value
initialValue [])
        FieldException -> ExecutorT m a
forall (m :: * -> *) a.
(MonadCatch m, Serialize a) =>
FieldException -> ExecutorT m a
handleException
    Response a -> m (Response a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response a -> m (Response a)) -> Response a -> m (Response a)
forall a b. (a -> b) -> a -> b
$ a -> Seq Error -> Response a
forall a. a -> Seq Error -> Response a
Response a
data' Seq Error
errors