Provide VariableValue instance on the JSON newtype

This commit is contained in:
Eugen Wissner 2022-01-19 10:41:55 +01:00
parent dc813621fd
commit 90abeb6425
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0

View File

@ -49,9 +49,9 @@ instance Serialize JSON where
serialize _ _ = Nothing
null = JSON Aeson.Null
instance VariableValue Aeson.Value where
coerceVariableValue _ Aeson.Null = Just Type.Null
coerceVariableValue (In.ScalarBaseType scalarType) value
instance VariableValue JSON where
coerceVariableValue _ (JSON Aeson.Null) = Just Type.Null
coerceVariableValue (In.ScalarBaseType scalarType) (JSON value)
| (Aeson.String stringValue) <- value = Just $ Type.String stringValue
| (Aeson.Bool booleanValue) <- value = Just $ Type.Boolean booleanValue
| (Aeson.Number numberValue) <- value
@ -59,9 +59,9 @@ instance VariableValue Aeson.Value where
Just $ Type.Float $ toRealFloat numberValue
| (Aeson.Number numberValue) <- value = -- ID or Int
Type.Int <$> toBoundedInteger numberValue
coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
coerceVariableValue (In.EnumBaseType _) (JSON (Aeson.String stringValue)) =
Just $ Type.Enum stringValue
coerceVariableValue (In.InputObjectBaseType objectType) value
coerceVariableValue (In.InputObjectBaseType objectType) (JSON value)
| (Aeson.Object objectValue) <- value = do
let (In.InputObjectType _ _ inputFields) = objectType
(newObjectValue, resultMap) <- foldWithKey objectValue inputFields
@ -86,16 +86,17 @@ instance VariableValue Aeson.Value where
newObjectValue = KeyMap.delete fieldKey objectValue
in case KeyMap.lookup fieldKey objectValue of
Just variableValue -> do
coerced <- coerceVariableValue fieldType variableValue
coerced <- coerceVariableValue fieldType
$ JSON variableValue
pure (newObjectValue, insert coerced)
Nothing -> Just (objectValue, resultMap)
coerceVariableValue (In.ListBaseType listType) value
coerceVariableValue (In.ListBaseType listType) (JSON value)
| (Aeson.Array arrayValue) <- value =
Type.List <$> foldr foldVector (Just []) arrayValue
| otherwise = coerceVariableValue listType value
| otherwise = coerceVariableValue listType $ JSON value
where
foldVector _ Nothing = Nothing
foldVector variableValue (Just list) = do
coerced <- coerceVariableValue listType variableValue
coerced <- coerceVariableValue listType $ JSON variableValue
pure $ coerced : list
coerceVariableValue _ _ = Nothing