Pass variables when generating the IR
This commit is contained in:
parent
9babf64cf6
commit
5e234ad4a9
@ -3,7 +3,6 @@
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Language.GraphQL.Executor
|
||||
@ -15,12 +14,16 @@ module Language.GraphQL.Executor
|
||||
, executeRequest
|
||||
) 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 Data.Aeson as Aeson
|
||||
import Data.Foldable (find)
|
||||
import Data.Functor.Identity (Identity)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Int (Int32)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Text (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 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 Error = Error
|
||||
@ -133,44 +155,48 @@ document = foldr filterOperation []
|
||||
operationDefinition' : accumulator
|
||||
filterOperation _ accumulator = accumulator -- Fragment.
|
||||
|
||||
operationDefinition :: Type.Subs -> Full.OperationDefinition -> Operation
|
||||
operationDefinition coercedVariableValues = \case
|
||||
Full.OperationDefinition operationType _ _ _ selectionSet' _ ->
|
||||
Operation operationType coercedVariableValues
|
||||
$ selectionSet selectionSet'
|
||||
Full.SelectionSet selectionSet' _ ->
|
||||
Operation Full.Query coercedVariableValues (selectionSet selectionSet')
|
||||
transform :: Full.OperationDefinition -> Transform Operation
|
||||
transform (Full.OperationDefinition operationType _ _ _ selectionSet' _) = do
|
||||
coercedVariableValues <- TransformT ask
|
||||
transformedSelections <- selectionSet selectionSet'
|
||||
pure $ Operation operationType coercedVariableValues transformedSelections
|
||||
transform (Full.SelectionSet selectionSet' _) = do
|
||||
coercedVariableValues <- TransformT ask
|
||||
transformedSelections <- selectionSet selectionSet'
|
||||
pure $ Operation Full.Query coercedVariableValues transformedSelections
|
||||
|
||||
selectionSet :: Full.SelectionSet -> SelectionSet
|
||||
selectionSet = NonEmpty.toList . fmap selection
|
||||
selectionSet :: Full.SelectionSet -> Transform SelectionSet
|
||||
selectionSet = traverse selection . NonEmpty.toList
|
||||
|
||||
selection :: Full.Selection -> Selection
|
||||
selection (Full.FieldSelection field') = FieldSelection $ field field'
|
||||
selection :: Full.Selection -> Transform Selection
|
||||
selection (Full.FieldSelection field') = FieldSelection <$> field field'
|
||||
selection (Full.FragmentSpreadSelection fragmentSpread') =
|
||||
FragmentSpreadSelection $ fragmentSpread fragmentSpread'
|
||||
FragmentSpreadSelection <$> fragmentSpread fragmentSpread'
|
||||
selection (Full.InlineFragmentSelection inlineFragment') =
|
||||
InlineFragmentSelection $ inlineFragment inlineFragment'
|
||||
InlineFragmentSelection <$> inlineFragment inlineFragment'
|
||||
|
||||
inlineFragment :: Full.InlineFragment -> InlineFragment
|
||||
inlineFragment (Full.InlineFragment typeCondition directives selectionSet' location) =
|
||||
InlineFragment
|
||||
inlineFragment :: Full.InlineFragment -> Transform InlineFragment
|
||||
inlineFragment (Full.InlineFragment typeCondition directives selectionSet' location) = do
|
||||
transformedSelections <- selectionSet selectionSet'
|
||||
pure $ InlineFragment
|
||||
typeCondition
|
||||
(directive <$> directives)
|
||||
(selectionSet selectionSet')
|
||||
transformedSelections
|
||||
location
|
||||
|
||||
fragmentSpread :: Full.FragmentSpread -> FragmentSpread
|
||||
fragmentSpread :: Full.FragmentSpread -> Transform FragmentSpread
|
||||
fragmentSpread (Full.FragmentSpread name' directives location) =
|
||||
FragmentSpread name' (directive <$> directives) location
|
||||
pure $ FragmentSpread name' (directive <$> directives) location
|
||||
|
||||
field :: Full.Field -> Field
|
||||
field (Full.Field alias' name' arguments' directives' selectionSet' location') =
|
||||
Field
|
||||
field :: Full.Field -> Transform Field
|
||||
field (Full.Field alias' name' arguments' directives' selectionSet' location') = do
|
||||
transformedSelections <- traverse selection selectionSet'
|
||||
pure $ Field
|
||||
alias'
|
||||
name'
|
||||
(argument <$> arguments')
|
||||
(directive <$> directives')
|
||||
(selection <$> selectionSet')
|
||||
transformedSelections
|
||||
location'
|
||||
|
||||
argument :: Full.Argument -> Argument
|
||||
@ -220,14 +246,17 @@ executeRequest schema sourceDocument operationName variableValues initialValue =
|
||||
subscribe topSelections schema coercedVariables initialValue
|
||||
where
|
||||
schemaTypes = Schema.types schema
|
||||
transformedDocument = document sourceDocument
|
||||
operationDefinitions = document sourceDocument
|
||||
operationAndVariables = do
|
||||
operationDefinition' <- getOperation transformedDocument operationName
|
||||
operationDefinition <- getOperation operationDefinitions operationName
|
||||
coercedVariableValues <- coerceVariableValues
|
||||
schemaTypes
|
||||
operationDefinition'
|
||||
operationDefinition
|
||||
variableValues
|
||||
pure $ operationDefinition coercedVariableValues operationDefinition'
|
||||
pure
|
||||
$ flip runReader coercedVariableValues
|
||||
$ runTransformT
|
||||
$ transform operationDefinition
|
||||
|
||||
getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
|
||||
getOperation [operation] Nothing = Right operation
|
||||
@ -278,7 +307,7 @@ executeSelectionSet selections objectType _objectValue variableValues =
|
||||
let _groupedFieldSet = collectFields objectType selections variableValues
|
||||
in mempty
|
||||
|
||||
collectFields :: Out.ObjectType IO -> SelectionSet -> Type.Subs -> OrderedMap [Selection]
|
||||
collectFields :: Out.ObjectType IO -> SelectionSet -> Type.Subs -> OrderedMap (NonEmpty Selection)
|
||||
collectFields = mempty
|
||||
|
||||
coerceVariableValues :: Coerce.VariableValue a
|
||||
|
||||
Loading…
Reference in New Issue
Block a user