Sure, not fully tested.
TSchemaJSONType = class(TSchemaScalarType)
strict protected
function ParseLiteral(Value: TASTValue): TValue; override;
public
constructor Create; reintroduce;
public
function ParseValue(const Value: TValue): TValue; override;
function Serialize(const Value: TValue): TValue; override;
end;
implementation
procedure RegisterGlobalTypes(Schema: TSchemaDocument);
begin
Schema.Add(TSchemaDateTimeType.Create);
Schema.Add(TSchemaJSONType.Create);
end;
{ TSchemaJSONType }
constructor TSchemaJSONType.Create;
begin
inherited Create('JSON');
end;
function TSchemaJSONType.ParseLiteral(Value: TASTValue): TValue;
var
JsonValue: TJSONObject;
begin
if Value is TASTObjectValue then begin
JsonValue := TJSONObject.ParseJSONValue(TASTSTringValue(Value).Value) as TJSONObject;
if not Assigned(JsonValue) then
raise EGraphQLCoercingParseLiteral.Create(Self.DisplayName, Value);
Result := TValue.From<TJSONObject>(JsonValue);
end
else
raise EGraphQLCoercingParseLiteral.Create(Self.DisplayName, Value);
end;
function TSchemaJSONType.ParseValue(const Value: TValue): TValue;
function GraphQLAsJson(const AGraphQL: IGraphQLList): TJSONArray; overload; forward;
function GraphQLAsJson(const AGraphQL: IGraphQLMap): TJSONObject; overload;
begin
Result := nil;
for var I := 0 to AGraphQL.Count-1 do begin
if AGraphQL.Values[I].IsType<IGraphQLMap> then
Result := GraphQLAsJson(AGraphQL.Values[I].AsType<IGraphQLMap>)
else if AGraphQL.Values[I].IsType<IGraphQLList> then begin
if not Assigned(Result) then
Result := TJSONObject.Create;
Result.AddPair(AGraphQL.Keys[I], GraphQLAsJson(AGraphQL.Values[I].AsType<IGraphQLList>))
end
else begin
if not Assigned(Result) then
Result := TJSONObject.Create;
case AGraphQL.Values[I].Kind of
tkInt64:
Result.AddPair(AGraphQL.Keys[I], AGraphQL.Values[I].AsType<Int64>);
tkInteger, tkEnumeration:
Result.AddPair(AGraphQL.Keys[I], AGraphQL.Values[I].AsType<Integer>);
tkFloat:
Result.AddPair(AGraphQL.Keys[I], AGraphQL.Values[I].AsType<Extended>);
tkChar, tkWChar:
Result.AddPair(AGraphQL.Keys[I], AGraphQL.Values[I].AsType<Char>);
tkString, tkUString, tkLString, tkWString:
Result.AddPair(AGraphQL.Keys[I], AGraphQL.Values[I].AsType<String>);
// , tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
// tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray, tkUString,
// tkClassRef, tkPointer, tkProcedure, tkMRecord
end;
end;
end;
end;
function GraphQLAsJson(const AGraphQL: IGraphQLList): TJSONArray; overload;
begin
Result := TJSONArray.Create;
for var I := 0 to AGraphQL.Count-1 do begin
if AGraphQL.Items[I].IsType<IGraphQLMap> then
Result.Add(GraphQLAsJson(AGraphQL.Items[I].AsType<IGraphQLMap>))
else if AGraphQL.Items[I].IsType<IGraphQLList> then
Result.Add(GraphQLAsJson(AGraphQL.Items[I].AsType<IGraphQLList>))
else
case AGraphQL.Items[I].Kind of
tkInt64:
Result.Add(AGraphQL.Items[I].AsType<Int64>);
tkInteger, tkEnumeration:
Result.Add(AGraphQL.Items[I].AsType<Integer>);
tkFloat:
Result.Add(AGraphQL.Items[I].AsType<Extended>);
tkChar, tkWChar:
Result.Add(AGraphQL.Items[I].AsType<Char>);
tkString, tkUString, tkLString, tkWString:
Result.Add(AGraphQL.Items[I].AsType<String>);
// , tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
// tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray, tkUString,
// tkClassRef, tkPointer, tkProcedure, tkMRecord
end;
end;
end;
begin
if (Value.TypeInfo=System.TypeInfo(IGraphQLMap)) or (Value.TypeInfo=System.TypeInfo(IGraphQLList)) then begin
if Value.IsType<IGraphQLMap> then
Result := TValue.From<TJSONObject>(GraphQLAsJson(Value.AsType<IGraphQLMap>))
else if Value.IsType<IGraphQLList> then
Result := TValue.From<TJSONArray>(GraphQLAsJson(Value.AsType<IGraphQLList>))
else
raise EGraphQLCoercingParseValue.Create(Self.DisplayName, Value);
end
else
raise EGraphQLCoercingParseValue.Create(Self.DisplayName, Value);
end;
function TSchemaJSONType.Serialize(const Value: TValue): TValue;
begin
if Value.IsEmpty then
Exit(TValue.Empty);
if not Value.TryCast(TypeInfo(TJSONObject), Result) then
raise EGraphQLCoercingSerialize.Create(Self.DisplayName, Value);
Result := Value.AsType<TJSONObject>.ToJSON;
end;
initialization
TSchemaDocument.OnGlobalCreate := RegisterGlobalTypes;