Stub selection execution

This commit is contained in:
Eugen Wissner 2021-08-21 07:58:42 +02:00
parent 5751870d2a
commit 9babf64cf6

View File

@ -21,10 +21,12 @@ import Data.Foldable (find)
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 Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Language.GraphQL.Execute.Coerce as Coerce import qualified Language.GraphQL.Execute.Coerce as Coerce
import Language.GraphQL.Execute.OrderedMap (OrderedMap)
import qualified Language.GraphQL.Type.Out as Out
import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type as Type
import qualified Language.GraphQL.Type.Internal as Type.Internal import qualified Language.GraphQL.Type.Internal as Type.Internal
import Language.GraphQL.Type.Schema (Schema) import Language.GraphQL.Type.Schema (Schema)
@ -84,24 +86,20 @@ respondWithQueryError = Response mempty . pure . queryError
-- operationName selectionSet location -- operationName selectionSet location
data Operation = Operation data Operation = Operation
Full.OperationType Full.OperationType
(Maybe String) Type.Subs
[Full.VariableDefinition]
SelectionSet SelectionSet
Full.Location
type SelectionSet = NonEmpty Selection type SelectionSet = [Selection]
data Selection data Selection
= FieldSelection Field = FieldSelection Field
| FragmentSpreadSelection FragmentSpread | FragmentSpreadSelection FragmentSpread
| InlineFragmentSelection InlineFragment | InlineFragmentSelection InlineFragment
type SelectionSetOpt = [Selection]
data Argument = Argument Full.Name (Full.Node Value) Full.Location data Argument = Argument Full.Name (Full.Node Value) Full.Location
data Field = data Field =
Field (Maybe Full.Name) Full.Name [Argument] [Directive] SelectionSetOpt Full.Location Field (Maybe Full.Name) Full.Name [Argument] [Directive] SelectionSet Full.Location
data InlineFragment = InlineFragment data InlineFragment = InlineFragment
(Maybe Full.TypeCondition) [Directive] SelectionSet Full.Location (Maybe Full.TypeCondition) [Directive] SelectionSet Full.Location
@ -135,24 +133,16 @@ document = foldr filterOperation []
operationDefinition' : accumulator operationDefinition' : accumulator
filterOperation _ accumulator = accumulator -- Fragment. filterOperation _ accumulator = accumulator -- Fragment.
operationDefinition :: Full.OperationDefinition -> Operation operationDefinition :: Type.Subs -> Full.OperationDefinition -> Operation
operationDefinition = \case operationDefinition coercedVariableValues = \case
Full.OperationDefinition operationType operationName variables _ selectionSet' operationLocation -> Full.OperationDefinition operationType _ _ _ selectionSet' _ ->
let maybeOperationName = Text.unpack <$> operationName Operation operationType coercedVariableValues
in Operation $ selectionSet selectionSet'
operationType Full.SelectionSet selectionSet' _ ->
maybeOperationName Operation Full.Query coercedVariableValues (selectionSet selectionSet')
variables
(selectionSet selectionSet')
operationLocation
Full.SelectionSet selectionSet' operationLocation ->
Operation Full.Query Nothing [] (selectionSet selectionSet') operationLocation
selectionSet :: Full.SelectionSet -> SelectionSet selectionSet :: Full.SelectionSet -> SelectionSet
selectionSet = fmap selection selectionSet = NonEmpty.toList . fmap selection
selectionSetOpt :: Full.SelectionSetOpt -> SelectionSetOpt
selectionSetOpt = fmap selection
selection :: Full.Selection -> Selection selection :: Full.Selection -> Selection
selection (Full.FieldSelection field') = FieldSelection $ field field' selection (Full.FieldSelection field') = FieldSelection $ field field'
@ -180,7 +170,7 @@ field (Full.Field alias' name' arguments' directives' selectionSet' location') =
name' name'
(argument <$> arguments') (argument <$> arguments')
(directive <$> directives') (directive <$> directives')
(selectionSetOpt selectionSet') (selection <$> selectionSet')
location' location'
argument :: Full.Argument -> Argument argument :: Full.Argument -> Argument
@ -221,24 +211,23 @@ executeRequest :: Schema IO
executeRequest schema sourceDocument operationName variableValues initialValue = executeRequest schema sourceDocument operationName variableValues initialValue =
case operationAndVariables of case operationAndVariables of
Left queryError' -> pure $ respondWithQueryError queryError' Left queryError' -> pure $ respondWithQueryError queryError'
Right (operation, coercedVariableValues') Right operation
| Operation Full.Query _ _ _ _ <- operation -> | Operation Full.Query coercedVariables topSelections <- operation ->
executeQuery operation schema coercedVariableValues' initialValue executeQuery topSelections schema coercedVariables initialValue
| Operation Full.Mutation _ _ _ _ <- operation -> | Operation Full.Mutation corecedVariables topSelections <- operation ->
executeMutation operation schema coercedVariableValues' initialValue executeMutation topSelections schema corecedVariables initialValue
| Operation Full.Subscription _ _ _ _ <- operation -> | Operation Full.Subscription coercedVariables topSelections <- operation ->
subscribe operation schema coercedVariableValues' initialValue subscribe topSelections schema coercedVariables initialValue
where where
schemaTypes = Schema.types schema schemaTypes = Schema.types schema
transformedDocument = document sourceDocument transformedDocument = document sourceDocument
operationAndVariables = do operationAndVariables = do
operation <- operationDefinition operationDefinition' <- getOperation transformedDocument operationName
<$> getOperation transformedDocument operationName
coercedVariableValues <- coerceVariableValues coercedVariableValues <- coerceVariableValues
schemaTypes schemaTypes
operation operationDefinition'
variableValues variableValues
pure (operation, coercedVariableValues) pure $ operationDefinition coercedVariableValues 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
@ -251,18 +240,18 @@ getOperation operations (Just givenOperationName)
findOperationByName _ = False findOperationByName _ = False
getOperation _ _ = Left OperationNameRequired getOperation _ _ = Left OperationNameRequired
executeQuery :: forall m executeQuery :: SelectionSet
. Operation -> Schema IO
-> Schema m
-> Type.Subs -> Type.Subs
-> Aeson.Object -> Aeson.Object
-> IO Response -> IO Response
executeQuery _operation schema _coercedVariableValues _initialValue = executeQuery topSelections schema coercedVariables initialValue =
let _queryType = Schema.query schema let queryType = Schema.query schema
_data = executeSelectionSet topSelections queryType initialValue coercedVariables
in pure $ Response mempty mempty in pure $ Response mempty mempty
executeMutation :: forall m executeMutation :: forall m
. Operation . SelectionSet
-> Schema m -> Schema m
-> Type.Subs -> Type.Subs
-> Aeson.Object -> Aeson.Object
@ -271,7 +260,7 @@ executeMutation _operation _schema _coercedVariableValues _initialValue =
pure $ Response mempty mempty pure $ Response mempty mempty
subscribe :: forall m subscribe :: forall m
. Operation . SelectionSet
-> Schema m -> Schema m
-> Type.Subs -> Type.Subs
-> Aeson.Object -> Aeson.Object
@ -279,15 +268,30 @@ subscribe :: forall m
subscribe _operation _schema _coercedVariableValues _initialValue = subscribe _operation _schema _coercedVariableValues _initialValue =
pure $ Response mempty mempty pure $ Response mempty mempty
executeSelectionSet
:: SelectionSet
-> Out.ObjectType IO
-> Aeson.Object
-> Type.Subs
-> Aeson.Object
executeSelectionSet selections objectType _objectValue variableValues =
let _groupedFieldSet = collectFields objectType selections variableValues
in mempty
collectFields :: Out.ObjectType IO -> SelectionSet -> Type.Subs -> OrderedMap [Selection]
collectFields = mempty
coerceVariableValues :: Coerce.VariableValue a coerceVariableValues :: Coerce.VariableValue a
=> forall m => forall m
. HashMap Full.Name (Schema.Type m) . HashMap Full.Name (Schema.Type m)
-> Operation -> Full.OperationDefinition
-> HashMap Full.Name a -> HashMap Full.Name a
-> Either QueryError Type.Subs -> Either QueryError Type.Subs
coerceVariableValues types operationDefinition' variableValues = coerceVariableValues types operationDefinition' variableValues
let Operation _ _ variableDefinitions _ _ = operationDefinition' | Full.OperationDefinition _ _ variableDefinitions _ _ _ <-
in foldr forEach (Right HashMap.empty) variableDefinitions operationDefinition'
= foldr forEach (Right HashMap.empty) variableDefinitions
| otherwise = pure mempty
where where
forEach variableDefinition (Right coercedValues) = forEach variableDefinition (Right coercedValues) =
let Full.VariableDefinition variableName variableTypeName defaultValue _ = let Full.VariableDefinition variableName variableTypeName defaultValue _ =