From 4d762d635666a954000be76832303eb3170f4ee2 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 14 Mar 2021 12:19:30 +0100 Subject: [PATCH] Add location information to list values --- src/Language/GraphQL/AST/Document.hs | 4 ++-- src/Language/GraphQL/AST/Encoder.hs | 6 +++--- src/Language/GraphQL/AST/Parser.hs | 4 ++-- src/Language/GraphQL/Execute/Transform.hs | 6 +++--- src/Language/GraphQL/Validate.hs | 17 ++++++++--------- src/Language/GraphQL/Validate/Rules.hs | 4 ++-- 6 files changed, 20 insertions(+), 21 deletions(-) diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index 41b417c..a698d2e 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -263,7 +263,7 @@ data Value | Boolean Bool | Null | Enum Name - | List [Value] + | List [Node Value] | Object [ObjectField Value] deriving Eq @@ -287,7 +287,7 @@ data ConstValue | ConstBoolean Bool | ConstNull | ConstEnum Name - | ConstList [ConstValue] + | ConstList [Node ConstValue] | ConstObject [ObjectField ConstValue] deriving Eq diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index f04f385..0d448df 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -219,7 +219,7 @@ fromConstValue (Full.ConstBoolean x) = Full.Boolean x fromConstValue Full.ConstNull = Full.Null fromConstValue (Full.ConstString string) = Full.String string fromConstValue (Full.ConstEnum x) = Full.Enum x -fromConstValue (Full.ConstList x) = Full.List $ fromConstValue <$> x +fromConstValue (Full.ConstList x) = Full.List $ fmap fromConstValue <$> x fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x where fromConstObjectField Full.ObjectField{value = value', ..} = @@ -266,8 +266,8 @@ stringValue (Pretty indentation) string = = Builder.fromLazyText (indent (indentation + 1)) <> line' <> newline <> acc -listValue :: Formatter -> [Full.Value] -> Lazy.Text -listValue formatter = bracketsCommas formatter $ value formatter +listValue :: Formatter -> [Full.Node Full.Value] -> Lazy.Text +listValue formatter = bracketsCommas formatter $ value formatter . Full.node objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text objectValue formatter = intercalate $ objectField formatter diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 05f7c43..19251ab 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -450,7 +450,7 @@ value = Full.Variable <$> variable <|> Full.Null <$ nullValue <|> Full.String <$> stringValue <|> Full.Enum <$> try enumValue - <|> Full.List <$> brackets (some value) + <|> Full.List <$> brackets (some $ valueNode value) <|> Full.Object <$> braces (some $ objectField $ valueNode value) "Value" @@ -461,7 +461,7 @@ constValue = Full.ConstFloat <$> try float <|> Full.ConstNull <$ nullValue <|> Full.ConstString <$> stringValue <|> Full.ConstEnum <$> try enumValue - <|> Full.ConstList <$> brackets (many constValue) + <|> Full.ConstList <$> brackets (many $ valueNode constValue) <|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue) "Value" diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 010899b..ebbe633 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -173,7 +173,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 @@ -380,7 +380,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 +396,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 diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index ea72018..b0c47cd 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -315,8 +315,8 @@ constValue (Validation.ValueRule _ rule) valueType = go valueType go inputObjectType value'@(Full.Node (Full.ConstObject fields) _) = foldMap (forEach inputObjectType) (Seq.fromList fields) |> rule inputObjectType value' - go listType value'@(Full.Node (Full.ConstList values) location') - = embedListLocation go listType values location' + go listType value'@(Full.Node (Full.ConstList values) _location) + = embedListLocation go listType values |> rule listType value' go anotherValue value' = pure $ rule anotherValue value' forEach inputObjectType Full.ObjectField{value = value', ..} = @@ -421,16 +421,15 @@ argument rule argumentType (Full.Argument _ value' _) = where valueType (In.Argument _ valueType' _) = valueType' --- valueTypeFromList :: Maybe In.Type -> Maybe In.Type +-- Applies a validation rule to each list value and merges returned errors. embedListLocation :: forall a m . (Maybe In.Type -> Full.Node a -> Seq m) -> Maybe In.Type - -> [a] - -> Full.Location + -> [Full.Node a] -> Seq m -embedListLocation go listType values location' +embedListLocation go listType = foldMap (go $ valueTypeFromList listType) - $ flip Full.Node location' <$> Seq.fromList values + . Seq.fromList where valueTypeFromList (Just (In.ListBaseType baseType)) = Just baseType valueTypeFromList _ = Nothing @@ -445,8 +444,8 @@ value (Validation.ValueRule rule _) valueType = go valueType go inputObjectType value'@(Full.Node (Full.Object fields) _) = foldMap (forEach inputObjectType) (Seq.fromList fields) |> rule inputObjectType value' - go listType value'@(Full.Node (Full.List values) location') - = embedListLocation go listType values location' + go listType value'@(Full.Node (Full.List values) _location) + = embedListLocation go listType values |> rule listType value' go anotherValue value' = pure $ rule anotherValue value' forEach inputObjectType Full.ObjectField{value = value', ..} = diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index 71455d3..ee2fdbe 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -1550,7 +1550,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo toConst Full.Null = Just Full.ConstNull toConst (Full.Enum enum) = Just $ Full.ConstEnum enum toConst (Full.List values) = - Just $ Full.ConstList $ catMaybes $ toConst <$> values + Just $ Full.ConstList $ catMaybes $ toConstNode <$> values toConst (Full.Object fields) = Just $ Full.ConstObject $ catMaybes $ constObjectField <$> fields constObjectField Full.ObjectField{..} @@ -1587,7 +1587,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo foldMap (checkObjectField typeFields) valueFields check (In.ListBaseType listType) constValue@Full.Node{ .. } | Full.ConstList listValues <- node = - foldMap (check listType) $ flip Full.Node location <$> listValues + foldMap (check listType) listValues | otherwise = check listType constValue check inputType Full.Node{ .. } = pure $ Error { message = concat