OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Pass variables when generating the IR

Browse Source
This commit is contained in:
Eugen Wissner 2021-08-22 16:07:59 +02:00
parent 9babf64cf6
commit 5e234ad4a9
1 changed files with 58 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
src/Language/GraphQL/Executor.hs
View File

@ -3,7 +3,6 @@
obtain one at https://mozilla.org/MPL/2.0/. -} obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.Executor module Language.GraphQL.Executor
@ -15,12 +14,16 @@ module Language.GraphQL.Executor
, executeRequest , executeRequest
) where ) where
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask, runReader)
import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.AST.Document as Full
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Foldable (find) import Data.Foldable (find)
import Data.Functor.Identity (Identity)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int32) import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
@ -32,6 +35,25 @@ import qualified Language.GraphQL.Type.Internal as Type.Internal
import Language.GraphQL.Type.Schema (Schema) import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema import qualified Language.GraphQL.Type.Schema as Schema
newtype TransformT m a = TransformT
{ runTransformT :: ReaderT Type.Subs m a
}
instance Functor m => Functor (TransformT m) where
fmap f = TransformT . fmap f . runTransformT
instance Applicative m => Applicative (TransformT m) where
pure = TransformT . pure
TransformT f <*> TransformT x = TransformT $ f <*> x
instance Monad m => Monad (TransformT m) where
TransformT x >>= f = TransformT $ x >>= runTransformT . f
instance MonadTrans TransformT where
lift = TransformT . lift
type Transform = TransformT Identity
data Segment = Segment String | Index Int data Segment = Segment String | Index Int
data Error = Error data Error = Error
@ -133,44 +155,48 @@ document = foldr filterOperation []
operationDefinition' : accumulator operationDefinition' : accumulator
filterOperation _ accumulator = accumulator -- Fragment. filterOperation _ accumulator = accumulator -- Fragment.
operationDefinition :: Type.Subs -> Full.OperationDefinition -> Operation transform :: Full.OperationDefinition -> Transform Operation
operationDefinition coercedVariableValues = \case transform (Full.OperationDefinition operationType _ _ _ selectionSet' _) = do
Full.OperationDefinition operationType _ _ _ selectionSet' _ -> coercedVariableValues <- TransformT ask
Operation operationType coercedVariableValues transformedSelections <- selectionSet selectionSet'
$ selectionSet selectionSet' pure $ Operation operationType coercedVariableValues transformedSelections
Full.SelectionSet selectionSet' _ -> transform (Full.SelectionSet selectionSet' _) = do
Operation Full.Query coercedVariableValues (selectionSet selectionSet') coercedVariableValues <- TransformT ask
transformedSelections <- selectionSet selectionSet'
pure $ Operation Full.Query coercedVariableValues transformedSelections
selectionSet :: Full.SelectionSet -> SelectionSet selectionSet :: Full.SelectionSet -> Transform SelectionSet
selectionSet = NonEmpty.toList . fmap selection selectionSet = traverse selection . NonEmpty.toList
selection :: Full.Selection -> Selection selection :: Full.Selection -> Transform Selection
selection (Full.FieldSelection field') = FieldSelection $ field field' selection (Full.FieldSelection field') = FieldSelection <$> field field'
selection (Full.FragmentSpreadSelection fragmentSpread') = selection (Full.FragmentSpreadSelection fragmentSpread') =
FragmentSpreadSelection $ fragmentSpread fragmentSpread' FragmentSpreadSelection <$> fragmentSpread fragmentSpread'
selection (Full.InlineFragmentSelection inlineFragment') = selection (Full.InlineFragmentSelection inlineFragment') =
InlineFragmentSelection $ inlineFragment inlineFragment' InlineFragmentSelection <$> inlineFragment inlineFragment'
inlineFragment :: Full.InlineFragment -> InlineFragment inlineFragment :: Full.InlineFragment -> Transform InlineFragment
inlineFragment (Full.InlineFragment typeCondition directives selectionSet' location) = inlineFragment (Full.InlineFragment typeCondition directives selectionSet' location) = do
InlineFragment transformedSelections <- selectionSet selectionSet'
pure $ InlineFragment
typeCondition typeCondition
(directive <$> directives) (directive <$> directives)
(selectionSet selectionSet') transformedSelections
location location
fragmentSpread :: Full.FragmentSpread -> FragmentSpread fragmentSpread :: Full.FragmentSpread -> Transform FragmentSpread
fragmentSpread (Full.FragmentSpread name' directives location) = fragmentSpread (Full.FragmentSpread name' directives location) =
FragmentSpread name' (directive <$> directives) location pure $ FragmentSpread name' (directive <$> directives) location
field :: Full.Field -> Field field :: Full.Field -> Transform Field
field (Full.Field alias' name' arguments' directives' selectionSet' location') = field (Full.Field alias' name' arguments' directives' selectionSet' location') = do
Field transformedSelections <- traverse selection selectionSet'
pure $ Field
alias' alias'
name' name'
(argument <$> arguments') (argument <$> arguments')
(directive <$> directives') (directive <$> directives')
(selection <$> selectionSet') transformedSelections
location' location'
argument :: Full.Argument -> Argument argument :: Full.Argument -> Argument
@ -220,14 +246,17 @@ executeRequest schema sourceDocument operationName variableValues initialValue =
subscribe topSelections schema coercedVariables initialValue subscribe topSelections schema coercedVariables initialValue
where where
schemaTypes = Schema.types schema schemaTypes = Schema.types schema
transformedDocument = document sourceDocument operationDefinitions = document sourceDocument
operationAndVariables = do operationAndVariables = do
operationDefinition' <- getOperation transformedDocument operationName operationDefinition <- getOperation operationDefinitions operationName
coercedVariableValues <- coerceVariableValues coercedVariableValues <- coerceVariableValues
schemaTypes schemaTypes
operationDefinition' operationDefinition
variableValues variableValues
pure $ operationDefinition coercedVariableValues operationDefinition' pure
$ flip runReader coercedVariableValues
$ runTransformT
$ transform operationDefinition
getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
getOperation [operation] Nothing = Right operation getOperation [operation] Nothing = Right operation
@ -278,7 +307,7 @@ executeSelectionSet selections objectType _objectValue variableValues =
let _groupedFieldSet = collectFields objectType selections variableValues let _groupedFieldSet = collectFields objectType selections variableValues
in mempty in mempty
collectFields :: Out.ObjectType IO -> SelectionSet -> Type.Subs -> OrderedMap [Selection] collectFields :: Out.ObjectType IO -> SelectionSet -> Type.Subs -> OrderedMap (NonEmpty Selection)
collectFields = mempty collectFields = mempty
coerceVariableValues :: Coerce.VariableValue a coerceVariableValues :: Coerce.VariableValue a