summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2021-08-21 07:58:42 +0200
committerEugen Wissner <belka@caraus.de>2021-08-31 17:30:04 +0200
commit9babf64cf6c4d6b992b14b8e53fef59bad928e20 (patch)
tree965a0589d732e52421003e7ec69c2401b0f92f15 /src/Language/GraphQL
parent5751870d2a5d315f8ec8e06107f428866ef81254 (diff)
downloadgraphql-9babf64cf6c4d6b992b14b8e53fef59bad928e20.tar.gz
Stub selection execution
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/Executor.hs100
1 files changed, 52 insertions, 48 deletions
diff --git a/src/Language/GraphQL/Executor.hs b/src/Language/GraphQL/Executor.hs
index 908bf4b..878dee6 100644
--- a/src/Language/GraphQL/Executor.hs
+++ b/src/Language/GraphQL/Executor.hs
@@ -21,10 +21,12 @@ import Data.Foldable (find)
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
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.Internal as Type.Internal
import Language.GraphQL.Type.Schema (Schema)
@@ -84,24 +86,20 @@ respondWithQueryError = Response mempty . pure . queryError
-- operationName selectionSet location
data Operation = Operation
Full.OperationType
- (Maybe String)
- [Full.VariableDefinition]
+ Type.Subs
SelectionSet
- Full.Location
-type SelectionSet = NonEmpty Selection
+type SelectionSet = [Selection]
data Selection
= FieldSelection Field
| FragmentSpreadSelection FragmentSpread
| InlineFragmentSelection InlineFragment
-type SelectionSetOpt = [Selection]
-
data Argument = Argument Full.Name (Full.Node Value) Full.Location
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
(Maybe Full.TypeCondition) [Directive] SelectionSet Full.Location
@@ -132,27 +130,19 @@ document = foldr filterOperation []
where
filterOperation (Full.ExecutableDefinition executableDefinition) accumulator
| Full.DefinitionOperation operationDefinition' <- executableDefinition =
- operationDefinition' : accumulator
+ operationDefinition' : accumulator
filterOperation _ accumulator = accumulator -- Fragment.
-operationDefinition :: Full.OperationDefinition -> Operation
-operationDefinition = \case
- Full.OperationDefinition operationType operationName variables _ selectionSet' operationLocation ->
- let maybeOperationName = Text.unpack <$> operationName
- in Operation
- operationType
- maybeOperationName
- variables
- (selectionSet selectionSet')
- operationLocation
- Full.SelectionSet selectionSet' operationLocation ->
- Operation Full.Query Nothing [] (selectionSet selectionSet') operationLocation
+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')
selectionSet :: Full.SelectionSet -> SelectionSet
-selectionSet = fmap selection
-
-selectionSetOpt :: Full.SelectionSetOpt -> SelectionSetOpt
-selectionSetOpt = fmap selection
+selectionSet = NonEmpty.toList . fmap selection
selection :: Full.Selection -> Selection
selection (Full.FieldSelection field') = FieldSelection $ field field'
@@ -180,7 +170,7 @@ field (Full.Field alias' name' arguments' directives' selectionSet' location') =
name'
(argument <$> arguments')
(directive <$> directives')
- (selectionSetOpt selectionSet')
+ (selection <$> selectionSet')
location'
argument :: Full.Argument -> Argument
@@ -221,24 +211,23 @@ executeRequest :: Schema IO
executeRequest schema sourceDocument operationName variableValues initialValue =
case operationAndVariables of
Left queryError' -> pure $ respondWithQueryError queryError'
- Right (operation, coercedVariableValues')
- | Operation Full.Query _ _ _ _ <- operation ->
- executeQuery operation schema coercedVariableValues' initialValue
- | Operation Full.Mutation _ _ _ _ <- operation ->
- executeMutation operation schema coercedVariableValues' initialValue
- | Operation Full.Subscription _ _ _ _ <- operation ->
- subscribe operation schema coercedVariableValues' initialValue
+ Right operation
+ | Operation Full.Query coercedVariables topSelections <- operation ->
+ executeQuery topSelections schema coercedVariables initialValue
+ | Operation Full.Mutation corecedVariables topSelections <- operation ->
+ executeMutation topSelections schema corecedVariables initialValue
+ | Operation Full.Subscription coercedVariables topSelections <- operation ->
+ subscribe topSelections schema coercedVariables initialValue
where
schemaTypes = Schema.types schema
transformedDocument = document sourceDocument
operationAndVariables = do
- operation <- operationDefinition
- <$> getOperation transformedDocument operationName
+ operationDefinition' <- getOperation transformedDocument operationName
coercedVariableValues <- coerceVariableValues
schemaTypes
- operation
+ operationDefinition'
variableValues
- pure (operation, coercedVariableValues)
+ pure $ operationDefinition coercedVariableValues operationDefinition'
getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
getOperation [operation] Nothing = Right operation
@@ -251,18 +240,18 @@ getOperation operations (Just givenOperationName)
findOperationByName _ = False
getOperation _ _ = Left OperationNameRequired
-executeQuery :: forall m
- . Operation
- -> Schema m
+executeQuery :: SelectionSet
+ -> Schema IO
-> Type.Subs
-> Aeson.Object
-> IO Response
-executeQuery _operation schema _coercedVariableValues _initialValue =
- let _queryType = Schema.query schema
+executeQuery topSelections schema coercedVariables initialValue =
+ let queryType = Schema.query schema
+ _data = executeSelectionSet topSelections queryType initialValue coercedVariables
in pure $ Response mempty mempty
executeMutation :: forall m
- . Operation
+ . SelectionSet
-> Schema m
-> Type.Subs
-> Aeson.Object
@@ -271,7 +260,7 @@ executeMutation _operation _schema _coercedVariableValues _initialValue =
pure $ Response mempty mempty
subscribe :: forall m
- . Operation
+ . SelectionSet
-> Schema m
-> Type.Subs
-> Aeson.Object
@@ -279,15 +268,30 @@ subscribe :: forall m
subscribe _operation _schema _coercedVariableValues _initialValue =
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
=> forall m
. HashMap Full.Name (Schema.Type m)
- -> Operation
+ -> Full.OperationDefinition
-> HashMap Full.Name a
-> Either QueryError Type.Subs
-coerceVariableValues types operationDefinition' variableValues =
- let Operation _ _ variableDefinitions _ _ = operationDefinition'
- in foldr forEach (Right HashMap.empty) variableDefinitions
+coerceVariableValues types operationDefinition' variableValues
+ | Full.OperationDefinition _ _ variableDefinitions _ _ _ <-
+ operationDefinition'
+ = foldr forEach (Right HashMap.empty) variableDefinitions
+ | otherwise = pure mempty
where
forEach variableDefinition (Right coercedValues) =
let Full.VariableDefinition variableName variableTypeName defaultValue _ =