Michael Schimmel
139 lines
4.3 KiB
ObjectPascal
139 lines
4.3 KiB
ObjectPascal
unit Myc.Data.Scalar.JSON;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Rtti,
|
|
System.TypInfo,
|
|
Myc.Data.Scalar;
|
|
|
|
type
|
|
TRttiAstHelper = class
|
|
private
|
|
// Maps a Delphi RTTI type to its TScalarKind.
|
|
class function TypeToScalarKind(AType: TRttiType): TScalarKind; static;
|
|
public
|
|
// Creates a JSON definition string from a record type info.
|
|
class function RecordDefinitionToJson(ATypeInfo: PTypeInfo): string; static;
|
|
// Creates a record definition from a JSON string.
|
|
class function JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition; static;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Myc.Data.Decimal,
|
|
System.Generics.Collections,
|
|
System.JSON;
|
|
|
|
{ TRttiAstHelper }
|
|
|
|
class function TRttiAstHelper.JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition;
|
|
var
|
|
jsonValue: TJSONValue;
|
|
fieldsArray: TJSONArray;
|
|
i: Integer;
|
|
fieldObj: TJSONObject;
|
|
kindStr: string;
|
|
fields: TArray<TScalarRecordField>;
|
|
begin
|
|
jsonValue := TJSONObject.ParseJSONValue(AJson);
|
|
if not Assigned(jsonValue) then
|
|
exit;
|
|
|
|
try
|
|
// The root element is expected to be a JSON array directly.
|
|
if not (jsonValue is TJSONArray) then
|
|
exit;
|
|
|
|
fieldsArray := jsonValue as TJSONArray;
|
|
|
|
SetLength(fields, fieldsArray.Count);
|
|
for i := 0 to fieldsArray.Count - 1 do
|
|
begin
|
|
fieldObj := fieldsArray.Items[i] as TJSONObject;
|
|
if not Assigned(fieldObj) then
|
|
continue; // or raise error
|
|
|
|
fields[i].Name := fieldObj.GetValue<string>('name');
|
|
|
|
kindStr := fieldObj.GetValue<string>('kind');
|
|
fields[i].Kind := TScalarKind(GetEnumValue(TypeInfo(TScalarKind), kindStr));
|
|
end;
|
|
Result := TScalarRecordDefinition.Create(fields);
|
|
finally
|
|
jsonValue.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TRttiAstHelper.RecordDefinitionToJson(ATypeInfo: PTypeInfo): string;
|
|
var
|
|
ctx: TRttiContext;
|
|
rttiType: TRttiType;
|
|
rttiRecordType: TRttiRecordType;
|
|
field: TRttiField;
|
|
fieldsArray: TJSONArray;
|
|
fieldObj: TJSONObject;
|
|
begin
|
|
ctx := TRttiContext.Create;
|
|
rttiType := ctx.GetType(ATypeInfo);
|
|
|
|
if not (rttiType is TRttiRecordType) then
|
|
raise EArgumentException.Create('PTypeInfo provided is not a record type.');
|
|
|
|
rttiRecordType := rttiType as TRttiRecordType;
|
|
|
|
// The root element is now the array itself.
|
|
fieldsArray := TJSONArray.Create;
|
|
try
|
|
for field in rttiRecordType.GetFields do
|
|
begin
|
|
fieldObj := TJSONObject.Create;
|
|
fieldObj.AddPair('name', TJSONString.Create(field.Name));
|
|
fieldObj.AddPair('kind', TJSONString.Create(GetEnumName(TypeInfo(TScalarKind), Ord(TypeToScalarKind(field.FieldType)))));
|
|
fieldsArray.Add(fieldObj);
|
|
end;
|
|
|
|
// Convert the array directly to a JSON string.
|
|
Result := fieldsArray.ToJSON;
|
|
finally
|
|
fieldsArray.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalarKind;
|
|
var
|
|
typeHandle: PTypeInfo;
|
|
begin
|
|
// 1. Use a case statement or if-checks on AType.Handle.
|
|
typeHandle := AType.Handle;
|
|
|
|
// 2. Compare with TypeInfo(Integer), TypeInfo(Double), TypeInfo(TDecimal) etc.
|
|
if typeHandle = TypeInfo(Integer) then
|
|
Result := skInteger
|
|
else if typeHandle = TypeInfo(Int64) then
|
|
Result := skInt64
|
|
else if typeHandle = TypeInfo(UInt64) then
|
|
Result := skUInt64
|
|
else if typeHandle = TypeInfo(Single) then
|
|
Result := skSingle
|
|
else if typeHandle = TypeInfo(Double) then
|
|
Result := skDouble
|
|
else if typeHandle = TypeInfo(TDateTime) then
|
|
Result := skDateTime
|
|
else if typeHandle = TypeInfo(Boolean) then
|
|
Result := skBoolean
|
|
else if typeHandle = TypeInfo(Char) then
|
|
Result := skChar
|
|
else if typeHandle = TypeInfo(TDecimal) then
|
|
Result := skDecimal
|
|
else if typeHandle = TypeInfo(TTimestamp) then
|
|
Result := skTimestamp
|
|
else
|
|
// 4. Raise an exception for unsupported types.
|
|
raise EArgumentException.CreateFmt('Unsupported record field type: %s', [AType.Name]);
|
|
end;
|
|
|
|
end.
|