Michael Schimmel
126 lines
3.8 KiB
ObjectPascal
126 lines
3.8 KiB
ObjectPascal
unit Myc.Data.Scalar.JSON;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Rtti,
|
|
System.TypInfo,
|
|
System.JSON,
|
|
Myc.Data.Scalar;
|
|
|
|
type
|
|
TRttiAstHelper = class
|
|
private
|
|
// Maps a Delphi RTTI type to its TScalar.TKind.
|
|
class function TypeToScalarKind(AType: TRttiType): TScalar.TKind; static;
|
|
public
|
|
// Creates a JSON definition string from a record type info.
|
|
class function RecordDefinitionToJson<T: record>: 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;
|
|
|
|
{ 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
|
|
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;
|
|
|
|
fields[i].Name := fieldObj.GetValue<string>('name');
|
|
kindStr := fieldObj.GetValue<string>('kind');
|
|
fields[i].Kind := TScalar.TKind(GetEnumValue(TypeInfo(TScalar.TKind), kindStr));
|
|
end;
|
|
Result := TScalarRecordDefinition.Create(fields);
|
|
finally
|
|
jsonValue.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TRttiAstHelper.RecordDefinitionToJson<T>: string;
|
|
var
|
|
ctx: TRttiContext;
|
|
rttiType: TRttiType;
|
|
rttiRecordType: TRttiRecordType;
|
|
field: TRttiField;
|
|
fieldsArray: TJSONArray;
|
|
fieldObj: TJSONObject;
|
|
begin
|
|
ctx := TRttiContext.Create;
|
|
rttiType := ctx.GetType(TypeInfo(T));
|
|
|
|
if not (rttiType is TRttiRecordType) then
|
|
raise EArgumentException.Create('PTypeInfo provided is not a record type.');
|
|
|
|
rttiRecordType := rttiType as TRttiRecordType;
|
|
|
|
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(TScalar.TKind), Ord(TypeToScalarKind(field.FieldType)))));
|
|
fieldsArray.Add(fieldObj);
|
|
end;
|
|
|
|
Result := fieldsArray.ToJSON;
|
|
finally
|
|
fieldsArray.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TRttiAstHelper.TypeToScalarKind(AType: TRttiType): TScalar.TKind;
|
|
var
|
|
typeHandle: PTypeInfo;
|
|
begin
|
|
typeHandle := AType.Handle;
|
|
|
|
if typeHandle = TypeInfo(Int64) then
|
|
Result := TScalar.TKind.Ordinal
|
|
else if typeHandle = TypeInfo(Integer) then
|
|
Result := TScalar.TKind.Ordinal
|
|
else if typeHandle = TypeInfo(UInt64) then
|
|
Result := TScalar.TKind.Ordinal
|
|
else if typeHandle = TypeInfo(Boolean) then
|
|
Result := TScalar.TKind.Ordinal
|
|
else if typeHandle = TypeInfo(Double) then
|
|
Result := TScalar.TKind.Float
|
|
else if typeHandle = TypeInfo(Single) then
|
|
Result := TScalar.TKind.Float
|
|
else if typeHandle = TypeInfo(TDateTime) then
|
|
Result := TScalar.TKind.Float // Correctly handle TDateTime as a Float
|
|
else
|
|
raise EArgumentException.CreateFmt('Unsupported record field type: %s', [AType.Name]);
|
|
end;
|
|
|
|
end.
|