MycLib/Src/Myc.DataRecord.pas

unit Myc.DataRecord;

interface

uses
    System.Rtti,
    System.SysUtils,
    System.Generics.Collections,
    System.Generics.Defaults;

type
    // Provides generic access to a value of type T.
    IAccess<T> = interface
        ['{1D422E3A-25C8-459B-A480-2E246942CF56}']
        function GetValue: T;
        procedure SetValue(const Value: T);
        property Value: T read GetValue write SetValue;
    end;

    // A record that provides field-level access to data, stored in a sorted array.
    TDataRecord = record
    public
        type
            // Builder for dynamically creating a TDataRecord.
            TBuilder = record
            private
                // Use a list for efficient additions. Will be sorted on creation.
                FStagedValues: TList<TPair<string, TValue>>;
                class operator Initialize(out Dest: TBuilder);
                class operator Finalize(var Dest: TBuilder);
            public
                procedure AddField<T>(const Name: String; const Value: T);
                function CreateRec: TDataRecord;
            end;

    private
        FValues: TArray<TPair<string, TValue>>;
        class operator Initialize(out Dest: TDataRecord);
        class operator Finalize(var Dest: TDataRecord);
    public
        function GetAccess<T>(const Name: String): IAccess<T>;

        class function CreateFromRec<T>(const Rec: T): TDataRecord; static;
        class function CreateBuilder: TDataRecord.TBuilder; static;
        class function CreateFromJSON(const JSON: string): TDataRecord; static;
    end;

    TValueAccessor<T> = class(TInterfacedObject, IAccess<T>)
    private
        FValues: TArray<TPair<string, TValue>>;
        FKey: string;
        function FindIndex: Integer;
    public
        constructor Create(AValues: TArray<TPair<string, TValue>>; const AKey: string);
        function GetValue: T;
        procedure SetValue(const Value: T);
    end;

    // Comparer for sorting and searching pairs by their string key (Singleton).
    TPairKeyComparer = class(TComparer<TPair<string, TValue>>)
    strict private
        class var
            FDefault: IComparer<TPair<string, TValue>>;
        class constructor CreateClass;
        class destructor DestroyClass;
    public
        function Compare(const Left, Right: TPair<string, TValue>): Integer; override;
        class property Default: IComparer<TPair<string, TValue>> read FDefault;
    end;

procedure Testfunc;

implementation

uses
    System.TypInfo,
    System.JSON;

{$region 'TPairKeyComparer'}
class constructor TPairKeyComparer.CreateClass;
begin
    FDefault := TPairKeyComparer.Create;
end;

class destructor TPairKeyComparer.DestroyClass;
begin
    FDefault := nil;
end;

function TPairKeyComparer.Compare(const Left, Right: TPair<string, TValue>): Integer;
begin
    Result := TComparer<string>.Default.Compare(Left.Key, Right.Key);
end;
{$endregion}

{$region 'TValueAccessor<T>'}
constructor TValueAccessor<T>.Create(AValues: TArray<TPair<string, TValue>>; const AKey: string);
begin
    inherited Create;
    FValues := AValues;
    FKey := AKey;
end;

function TValueAccessor<T>.FindIndex: Integer;
var
    dummyPair: TPair<string, TValue>;
begin
    // Find the index of the key using binary search with the singleton comparer.
    dummyPair := TPair<string, TValue>.Create(FKey, TValue.Empty);
    if not TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, Result, TPairKeyComparer.Default) then
        Result := -1;
end;

function TValueAccessor<T>.GetValue: T;
var
    idx: Integer;
begin
    idx := FindIndex;
    if idx > -1 then
        Result := FValues[idx].Value.AsType<T>
    else
        raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
end;

procedure TValueAccessor<T>.SetValue(const Value: T);
var
    idx: Integer;
begin
    idx := FindIndex;
    if idx > -1 then
        // Directly modify the TValue within the TPair in the array.
        FValues[idx].Value := TValue.From<T>(Value)
    else
        raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
end;
{$endregion}

{$region 'TDataRecord'}
function TDataRecord.GetAccess<T>(const Name: String): IAccess<T>;
var
    dummyPair: TPair<string, TValue>;
    val: TValue;
    index: Integer;
    targetTypeInfo: PTypeInfo;
begin
    Result := nil;

    // Use a binary search on the sorted array with the singleton comparer.
    dummyPair := TPair<string, TValue>.Create(Name, TValue.Empty);

    if TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, index, TPairKeyComparer.Default) then
    begin
        val := FValues[index].Value;
        targetTypeInfo := System.TypeInfo(T);
        if (val.TypeInfo <> nil) and (val.TypeInfo = targetTypeInfo) then
        begin
            Result := TValueAccessor<T>.Create(FValues, Name);
        end;
    end;
end;

class function TDataRecord.CreateFromRec<T>(const Rec: T): TDataRecord;
var
    ctx: TRttiContext;
    recType: TRttiRecordType;
    field: TRttiField;
    recValue: TValue;
    stagedValues: TList<TPair<string, TValue>>;
begin
    stagedValues := TList<TPair<string, TValue>>.Create;
    try
        ctx := TRttiContext.Create;
        recType := ctx.GetType(TypeInfo(T)) as TRttiRecordType;
        recValue := TValue.From<T>(Rec);

        for field in recType.GetFields do
            stagedValues.Add(TPair<string, TValue>.Create(field.Name, field.GetValue(recValue.GetReferenceToRawData)));

        // Sort the list and assign it to the result array.
        stagedValues.Sort(TPairKeyComparer.Default);
        Result.FValues := stagedValues.ToArray;
    finally
        stagedValues.Free;
    end;
end;

class function TDataRecord.CreateFromJSON(const JSON: string): TDataRecord;
var
    jsonValue: TJSONValue;
    jsonObject: TJSONObject;
    pair: TJSONPair;
    pairValue: TJSONValue;
    s: string;
    b: Boolean;
    i64: Int64;
    dbl: Double;
    stagedValues: TList<TPair<string, TValue>>;
begin
    stagedValues := TList<TPair<string, TValue>>.Create;
    try
        jsonValue := TJSONObject.ParseJSONValue(JSON);
        if not Assigned(jsonValue) or not (jsonValue is TJSONObject) then
        begin
            Result.FValues := [];
            Exit;
        end;
        try
            jsonObject := jsonValue as TJSONObject;
            for pair in jsonObject do
            begin
                pairValue := pair.JsonValue;
                if pairValue is TJSONNumber then
                begin
                    if pairValue.TryGetValue<Int64>(i64) then
                        stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Int64>(i64)))
                    else if pairValue.TryGetValue<Double>(dbl) then
                        stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Double>(dbl)));
                end
                else if pairValue is TJSONString then
                begin
                    if pairValue.TryGetValue<string>(s) then
                        stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<string>(s)));
                end
                else if pairValue is TJSONBool then
                begin
                    if pairValue.TryGetValue<Boolean>(b) then
                        stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Boolean>(b)));
                end
                else if pairValue is TJSONNull then
                    stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.Empty));
            end;
        finally
            jsonValue.Free;
        end;
        // Sort the list and assign it to the result array.
        stagedValues.Sort(TPairKeyComparer.Default);
        Result.FValues := stagedValues.ToArray;
    finally
        stagedValues.Free;
    end;
end;

class function TDataRecord.CreateBuilder: TDataRecord.TBuilder;
begin
    Result := Default(TDataRecord.TBuilder);
end;

class operator TDataRecord.Initialize(out Dest: TDataRecord);
begin
    // Initialize the array for a new TDataRecord instance.
    Dest.FValues := nil;
end;

class operator TDataRecord.Finalize(var Dest: TDataRecord);
begin
    // Finalize the array.
    Dest.FValues := nil;
end;
{$endregion}

{$region 'TDataRecord.TBuilder'}
procedure TDataRecord.TBuilder.AddField<T>(const Name: String; const Value: T);
begin
    FStagedValues.Add(TPair<string, TValue>.Create(Name, TValue.From<T>(Value)));
end;

function TDataRecord.TBuilder.CreateRec: TDataRecord;
begin
    // Sort the staged list and create the final record's array from it.
    FStagedValues.Sort(TPairKeyComparer.Default);
    Result.FValues := FStagedValues.ToArray;
    FStagedValues.Clear; // Clear the list after consuming it.
end;

class operator TDataRecord.TBuilder.Initialize(out Dest: TBuilder);
begin
    Dest.FStagedValues := TList<TPair<string, TValue>>.Create;
end;

class operator TDataRecord.TBuilder.Finalize(var Dest: TBuilder);
begin
    Dest.FStagedValues.Free;
end;
{$endregion}

type
    TTestRec = record
        A, B, C: Integer;
        Name: String;
        Val: Double;
    end;

procedure Testfunc;
var
    testRec: TTestRec;
    R: TDataRecord;
    nameAccess: IAccess<String>;
    bAccess: IAccess<Integer>;
const
    JSON_DATA = '{"IntValue": 123, "StringValue": "Hello JSON", "FloatValue": 99.9, "BoolValue": true, "NullValue": null}';
begin
    testRec.A := 1;
    testRec.B := 5;
    testRec.C := 10;
    testRec.Name := 'Hi';
    testRec.Val := 3.14;

    R := TDataRecord.CreateFromRec<TTestRec>(testRec);

    // Test reading a string value
    nameAccess := R.GetAccess<String>('Name');
    Assert(Assigned(nameAccess));
    Assert(nameAccess.Value = 'Hi');

    // Test reading an integer value
    bAccess := R.GetAccess<Integer>('B');
    Assert(Assigned(bAccess));
    Assert(bAccess.Value = 5);

    // Test writing a value
    bAccess.Value := 99;
    Assert(bAccess.Value = 99);

    // Verify that a request for a wrong type returns nil
    var aAccess := R.GetAccess<String>('A');
    Assert(not Assigned(aAccess));

    // Test the builder pattern
    var RecBuilder: TDataRecord.TBuilder := TDataRecord.CreateBuilder;
    RecBuilder.AddField<Double>('ZValue', 222.0); // Changed key to test sorting
    RecBuilder.AddField<string>('AValue', 'Builder Test');
    var S := RecBuilder.CreateRec;

    var dblAccess := S.GetAccess<Double>('ZValue');
    Assert(Assigned(dblAccess));
    Assert(dblAccess.Value = 222.0);

    var strAccess := S.GetAccess<String>('AValue');
    Assert(Assigned(strAccess));
    Assert(strAccess.Value = 'Builder Test');

    // Test JSON parsing
    var jsonRec := TDataRecord.CreateFromJSON(JSON_DATA);
    var intAccess := jsonRec.GetAccess<Int64>('IntValue');
    Assert(Assigned(intAccess));
    Assert(intAccess.Value = 123);

    strAccess := jsonRec.GetAccess<string>('StringValue');
    Assert(Assigned(strAccess));
    Assert(strAccess.Value = 'Hello JSON');

    dblAccess := jsonRec.GetAccess<Double>('FloatValue');
    Assert(Assigned(dblAccess));
    Assert(dblAccess.Value = 99.9);

    var boolAccess := jsonRec.GetAccess<Boolean>('BoolValue');
    Assert(Assigned(boolAccess));
    Assert(boolAccess.Value = true);
end;

end.