Add location information to list values

This commit is contained in:
Eugen Wissner 2021-03-14 12:19:30 +01:00
parent cbccb9ed0b
commit 4d762d6356
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
6 changed files with 20 additions and 21 deletions

View File

@ -263,7 +263,7 @@ data Value
| Boolean Bool | Boolean Bool
| Null | Null
| Enum Name | Enum Name
| List [Value] | List [Node Value]
| Object [ObjectField Value] | Object [ObjectField Value]
deriving Eq deriving Eq
@ -287,7 +287,7 @@ data ConstValue
| ConstBoolean Bool | ConstBoolean Bool
| ConstNull | ConstNull
| ConstEnum Name | ConstEnum Name
| ConstList [ConstValue] | ConstList [Node ConstValue]
| ConstObject [ObjectField ConstValue] | ConstObject [ObjectField ConstValue]
deriving Eq deriving Eq

View File

@ -219,7 +219,7 @@ fromConstValue (Full.ConstBoolean x) = Full.Boolean x
fromConstValue Full.ConstNull = Full.Null fromConstValue Full.ConstNull = Full.Null
fromConstValue (Full.ConstString string) = Full.String string fromConstValue (Full.ConstString string) = Full.String string
fromConstValue (Full.ConstEnum x) = Full.Enum x 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 fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x
where where
fromConstObjectField Full.ObjectField{value = value', ..} = fromConstObjectField Full.ObjectField{value = value', ..} =
@ -266,8 +266,8 @@ stringValue (Pretty indentation) string =
= Builder.fromLazyText (indent (indentation + 1)) = Builder.fromLazyText (indent (indentation + 1))
<> line' <> newline <> acc <> line' <> newline <> acc
listValue :: Formatter -> [Full.Value] -> Lazy.Text listValue :: Formatter -> [Full.Node Full.Value] -> Lazy.Text
listValue formatter = bracketsCommas formatter $ value formatter listValue formatter = bracketsCommas formatter $ value formatter . Full.node
objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
objectValue formatter = intercalate $ objectField formatter objectValue formatter = intercalate $ objectField formatter

View File

@ -450,7 +450,7 @@ value = Full.Variable <$> variable
<|> Full.Null <$ nullValue <|> Full.Null <$ nullValue
<|> Full.String <$> stringValue <|> Full.String <$> stringValue
<|> Full.Enum <$> try enumValue <|> Full.Enum <$> try enumValue
<|> Full.List <$> brackets (some value) <|> Full.List <$> brackets (some $ valueNode value)
<|> Full.Object <$> braces (some $ objectField $ valueNode value) <|> Full.Object <$> braces (some $ objectField $ valueNode value)
<?> "Value" <?> "Value"
@ -461,7 +461,7 @@ constValue = Full.ConstFloat <$> try float
<|> Full.ConstNull <$ nullValue <|> Full.ConstNull <$ nullValue
<|> Full.ConstString <$> stringValue <|> Full.ConstString <$> stringValue
<|> Full.ConstEnum <$> try enumValue <|> Full.ConstEnum <$> try enumValue
<|> Full.ConstList <$> brackets (many constValue) <|> Full.ConstList <$> brackets (many $ valueNode constValue)
<|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue) <|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue)
<?> "Value" <?> "Value"

View File

@ -173,7 +173,7 @@ constValue (Full.ConstString x) = Type.String x
constValue (Full.ConstBoolean b) = Type.Boolean b constValue (Full.ConstBoolean b) = Type.Boolean b
constValue Full.ConstNull = Type.Null constValue Full.ConstNull = Type.Null
constValue (Full.ConstEnum e) = Type.Enum e 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) = constValue (Full.ConstObject o) =
Type.Object $ HashMap.fromList $ constObjectField <$> o Type.Object $ HashMap.fromList $ constObjectField <$> o
where where
@ -380,7 +380,7 @@ value (Full.String string) = pure $ Type.String string
value (Full.Boolean boolean) = pure $ Type.Boolean boolean value (Full.Boolean boolean) = pure $ Type.Boolean boolean
value Full.Null = pure Type.Null value Full.Null = pure Type.Null
value (Full.Enum enum) = pure $ Type.Enum enum 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) = value (Full.Object object) =
Type.Object . HashMap.fromList <$> traverse objectField object Type.Object . HashMap.fromList <$> traverse objectField object
where where
@ -396,7 +396,7 @@ input (Full.String string) = pure $ pure $ String string
input (Full.Boolean boolean) = pure $ pure $ Boolean boolean input (Full.Boolean boolean) = pure $ pure $ Boolean boolean
input Full.Null = pure $ pure Null input Full.Null = pure $ pure Null
input (Full.Enum enum) = pure $ pure $ Enum enum 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 input (Full.Object object) = do
objectFields <- foldM objectField HashMap.empty object objectFields <- foldM objectField HashMap.empty object
pure $ pure $ Object objectFields pure $ pure $ Object objectFields

View File

@ -315,8 +315,8 @@ constValue (Validation.ValueRule _ rule) valueType = go valueType
go inputObjectType value'@(Full.Node (Full.ConstObject fields) _) go inputObjectType value'@(Full.Node (Full.ConstObject fields) _)
= foldMap (forEach inputObjectType) (Seq.fromList fields) = foldMap (forEach inputObjectType) (Seq.fromList fields)
|> rule inputObjectType value' |> rule inputObjectType value'
go listType value'@(Full.Node (Full.ConstList values) location') go listType value'@(Full.Node (Full.ConstList values) _location)
= embedListLocation go listType values location' = embedListLocation go listType values
|> rule listType value' |> rule listType value'
go anotherValue value' = pure $ rule anotherValue value' go anotherValue value' = pure $ rule anotherValue value'
forEach inputObjectType Full.ObjectField{value = value', ..} = forEach inputObjectType Full.ObjectField{value = value', ..} =
@ -421,16 +421,15 @@ argument rule argumentType (Full.Argument _ value' _) =
where where
valueType (In.Argument _ valueType' _) = valueType' 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 embedListLocation :: forall a m
. (Maybe In.Type -> Full.Node a -> Seq m) . (Maybe In.Type -> Full.Node a -> Seq m)
-> Maybe In.Type -> Maybe In.Type
-> [a] -> [Full.Node a]
-> Full.Location
-> Seq m -> Seq m
embedListLocation go listType values location' embedListLocation go listType
= foldMap (go $ valueTypeFromList listType) = foldMap (go $ valueTypeFromList listType)
$ flip Full.Node location' <$> Seq.fromList values . Seq.fromList
where where
valueTypeFromList (Just (In.ListBaseType baseType)) = Just baseType valueTypeFromList (Just (In.ListBaseType baseType)) = Just baseType
valueTypeFromList _ = Nothing valueTypeFromList _ = Nothing
@ -445,8 +444,8 @@ value (Validation.ValueRule rule _) valueType = go valueType
go inputObjectType value'@(Full.Node (Full.Object fields) _) go inputObjectType value'@(Full.Node (Full.Object fields) _)
= foldMap (forEach inputObjectType) (Seq.fromList fields) = foldMap (forEach inputObjectType) (Seq.fromList fields)
|> rule inputObjectType value' |> rule inputObjectType value'
go listType value'@(Full.Node (Full.List values) location') go listType value'@(Full.Node (Full.List values) _location)
= embedListLocation go listType values location' = embedListLocation go listType values
|> rule listType value' |> rule listType value'
go anotherValue value' = pure $ rule anotherValue value' go anotherValue value' = pure $ rule anotherValue value'
forEach inputObjectType Full.ObjectField{value = value', ..} = forEach inputObjectType Full.ObjectField{value = value', ..} =

View File

@ -1550,7 +1550,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo
toConst Full.Null = Just Full.ConstNull toConst Full.Null = Just Full.ConstNull
toConst (Full.Enum enum) = Just $ Full.ConstEnum enum toConst (Full.Enum enum) = Just $ Full.ConstEnum enum
toConst (Full.List values) = toConst (Full.List values) =
Just $ Full.ConstList $ catMaybes $ toConst <$> values Just $ Full.ConstList $ catMaybes $ toConstNode <$> values
toConst (Full.Object fields) = Just $ Full.ConstObject toConst (Full.Object fields) = Just $ Full.ConstObject
$ catMaybes $ constObjectField <$> fields $ catMaybes $ constObjectField <$> fields
constObjectField Full.ObjectField{..} constObjectField Full.ObjectField{..}
@ -1587,7 +1587,7 @@ valuesOfCorrectTypeRule = ValueRule go constGo
foldMap (checkObjectField typeFields) valueFields foldMap (checkObjectField typeFields) valueFields
check (In.ListBaseType listType) constValue@Full.Node{ .. } check (In.ListBaseType listType) constValue@Full.Node{ .. }
| Full.ConstList listValues <- node = | Full.ConstList listValues <- node =
foldMap (check listType) $ flip Full.Node location <$> listValues foldMap (check listType) listValues
| otherwise = check listType constValue | otherwise = check listType constValue
check inputType Full.Node{ .. } = pure $ Error check inputType Full.Node{ .. } = pure $ Error
{ message = concat { message = concat