Stub selection execution
This commit is contained in:
parent
5751870d2a
commit
9babf64cf6
@ -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
|
||||||
@ -132,27 +130,19 @@ document = foldr filterOperation []
|
|||||||
where
|
where
|
||||||
filterOperation (Full.ExecutableDefinition executableDefinition) accumulator
|
filterOperation (Full.ExecutableDefinition executableDefinition) accumulator
|
||||||
| Full.DefinitionOperation operationDefinition' <- executableDefinition =
|
| Full.DefinitionOperation operationDefinition' <- executableDefinition =
|
||||||
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 _ =
|
||||||
|
Loading…
Reference in New Issue
Block a user