aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/Execute/Transform.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/Execute/Transform.hs')
-rw-r--r--src/Language/GraphQL/Execute/Transform.hs91
1 files changed, 50 insertions, 41 deletions
diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs
index 010899b..117b708 100644
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@@ -1,3 +1,7 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -25,7 +29,6 @@ module Language.GraphQL.Execute.Transform
, QueryError(..)
, Selection(..)
, document
- , queryError
) where
import Control.Monad (foldM, unless)
@@ -71,16 +74,18 @@ data Selection m
| SelectionField (Field m)
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
---
--- Currently only queries and mutations are supported.
data Operation m
- = Query (Maybe Text) (Seq (Selection m))
- | Mutation (Maybe Text) (Seq (Selection m))
- | Subscription (Maybe Text) (Seq (Selection m))
+ = Query (Maybe Text) (Seq (Selection m)) Full.Location
+ | Mutation (Maybe Text) (Seq (Selection m)) Full.Location
+ | Subscription (Maybe Text) (Seq (Selection m)) Full.Location
-- | Single GraphQL field.
data Field m = Field
- (Maybe Full.Name) Full.Name (HashMap Full.Name Input) (Seq (Selection m))
+ (Maybe Full.Name)
+ Full.Name
+ (HashMap Full.Name (Full.Node Input))
+ (Seq (Selection m))
+ Full.Location
-- | Contains the operation to be executed along with its root type.
data Document m = Document
@@ -92,16 +97,26 @@ data OperationDefinition = OperationDefinition
[Full.VariableDefinition]
[Full.Directive]
Full.SelectionSet
+ Full.Location
-- | Query error types.
data QueryError
= OperationNotFound Text
| OperationNameRequired
| CoercionError
- | TransformationError
| EmptyDocument
| UnsupportedRootOperation
+instance Show QueryError where
+ show (OperationNotFound operationName) = unwords
+ ["Operation", Text.unpack operationName, "couldn't be found in the document."]
+ show OperationNameRequired = "Missing operation name."
+ show CoercionError = "Coercion error."
+ show EmptyDocument =
+ "The document doesn't contain any executable operations."
+ show UnsupportedRootOperation =
+ "Root operation type couldn't be found in the schema."
+
data Input
= Int Int32
| Float Double
@@ -114,17 +129,6 @@ data Input
| Variable Type.Value
deriving (Eq, Show)
-queryError :: QueryError -> Text
-queryError (OperationNotFound operationName) = Text.unwords
- ["Operation", operationName, "couldn't be found in the document."]
-queryError OperationNameRequired = "Missing operation name."
-queryError CoercionError = "Coercion error."
-queryError TransformationError = "Schema transformation error."
-queryError EmptyDocument =
- "The document doesn't contain any executable operations."
-queryError UnsupportedRootOperation =
- "Root operation type couldn't be found in the schema."
-
getOperation
:: Maybe Full.Name
-> NonEmpty OperationDefinition
@@ -135,7 +139,7 @@ getOperation (Just operationName) operations
| Just operation' <- find matchingName operations = pure operation'
| otherwise = Left $ OperationNotFound operationName
where
- matchingName (OperationDefinition _ name _ _ _) =
+ matchingName (OperationDefinition _ name _ _ _ _) =
name == Just operationName
coerceVariableValues :: Coerce.VariableValue a
@@ -145,7 +149,7 @@ coerceVariableValues :: Coerce.VariableValue a
-> HashMap.HashMap Full.Name a
-> Either QueryError Type.Subs
coerceVariableValues types operationDefinition variableValues =
- let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
+ let OperationDefinition _ _ variableDefinitions _ _ _ = operationDefinition
in maybe (Left CoercionError) Right
$ foldr forEach (Just HashMap.empty) variableDefinitions
where
@@ -173,7 +177,7 @@ constValue (Full.ConstString x) = Type.String x
constValue (Full.ConstBoolean b) = Type.Boolean b
constValue Full.ConstNull = Type.Null
constValue (Full.ConstEnum e) = Type.Enum e
-constValue (Full.ConstList l) = Type.List $ constValue <$> l
+constValue (Full.ConstList list) = Type.List $ constValue . Full.node <$> list
constValue (Full.ConstObject o) =
Type.Object $ HashMap.fromList $ constObjectField <$> o
where
@@ -203,14 +207,14 @@ document schema operationName subs ast = do
, types = referencedTypes
}
case chosenOperation of
- OperationDefinition Full.Query _ _ _ _ ->
+ OperationDefinition Full.Query _ _ _ _ _ ->
pure $ Document referencedTypes (Schema.query schema)
$ operation chosenOperation replacement
- OperationDefinition Full.Mutation _ _ _ _
+ OperationDefinition Full.Mutation _ _ _ _ _
| Just mutationType <- Schema.mutation schema ->
pure $ Document referencedTypes mutationType
$ operation chosenOperation replacement
- OperationDefinition Full.Subscription _ _ _ _
+ OperationDefinition Full.Subscription _ _ _ _ _
| Just subscriptionType <- Schema.subscription schema ->
pure $ Document referencedTypes subscriptionType
$ operation chosenOperation replacement
@@ -235,10 +239,10 @@ defragment ast =
(operations, HashMap.insert name fragment fragments')
defragment' _ acc = acc
transform = \case
- Full.OperationDefinition type' name variables directives' selections _ ->
- OperationDefinition type' name variables directives' selections
- Full.SelectionSet selectionSet _ ->
- OperationDefinition Full.Query Nothing mempty mempty selectionSet
+ Full.OperationDefinition type' name variables directives' selections location ->
+ OperationDefinition type' name variables directives' selections location
+ Full.SelectionSet selectionSet location ->
+ OperationDefinition Full.Query Nothing mempty mempty selectionSet location
-- * Operation
@@ -247,12 +251,12 @@ operation operationDefinition replacement
= runIdentity
$ evalStateT (collectFragments >> transform operationDefinition) replacement
where
- transform (OperationDefinition Full.Query name _ _ sels) =
- Query name <$> appendSelection sels
- transform (OperationDefinition Full.Mutation name _ _ sels) =
- Mutation name <$> appendSelection sels
- transform (OperationDefinition Full.Subscription name _ _ sels) =
- Subscription name <$> appendSelection sels
+ transform (OperationDefinition Full.Query name _ _ sels location) =
+ flip (Query name) location <$> appendSelection sels
+ transform (OperationDefinition Full.Mutation name _ _ sels location) =
+ flip (Mutation name) location <$> appendSelection sels
+ transform (OperationDefinition Full.Subscription name _ _ sels location) =
+ flip (Subscription name) location <$> appendSelection sels
-- * Selection
@@ -268,15 +272,20 @@ selection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment fragmentSelection
field :: Full.Field -> State (Replacement m) (Maybe (Field m))
-field (Full.Field alias name arguments' directives' selections _) = do
+field (Full.Field alias name arguments' directives' selections location) = do
fieldArguments <- foldM go HashMap.empty arguments'
fieldSelections <- appendSelection selections
fieldDirectives <- Definition.selection <$> directives directives'
- let field' = Field alias name fieldArguments fieldSelections
+ let field' = Field alias name fieldArguments fieldSelections location
pure $ field' <$ fieldDirectives
where
- go arguments (Full.Argument name' (Full.Node value' _) _) =
- inputField arguments name' value'
+ go arguments (Full.Argument name' (Full.Node value' _) location') = do
+ objectFieldValue <- input value'
+ case objectFieldValue of
+ Just fieldValue ->
+ let argumentNode = Full.Node fieldValue location'
+ in pure $ HashMap.insert name' argumentNode arguments
+ Nothing -> pure arguments
fragmentSpread
:: Full.FragmentSpread
@@ -380,7 +389,7 @@ value (Full.String string) = pure $ Type.String string
value (Full.Boolean boolean) = pure $ Type.Boolean boolean
value Full.Null = pure Type.Null
value (Full.Enum enum) = pure $ Type.Enum enum
-value (Full.List list) = Type.List <$> traverse value list
+value (Full.List list) = Type.List <$> traverse (value . Full.node) list
value (Full.Object object) =
Type.Object . HashMap.fromList <$> traverse objectField object
where
@@ -396,7 +405,7 @@ input (Full.String string) = pure $ pure $ String string
input (Full.Boolean boolean) = pure $ pure $ Boolean boolean
input Full.Null = pure $ pure Null
input (Full.Enum enum) = pure $ pure $ Enum enum
-input (Full.List list) = pure . List <$> traverse value list
+input (Full.List list) = pure . List <$> traverse (value . Full.node) list
input (Full.Object object) = do
objectFields <- foldM objectField HashMap.empty object
pure $ pure $ Object objectFields
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:02:02 +0000