MycLib/Src/Myc.DataRecord.pas

unit Myc.DataRecord;

interface

uses
    System.SysUtils,
    System.Rtti,
    System.TypInfo;

type
    // A record that provides field-level access to data, stored in a packed byte buffer.
    TDataRecord = record
    public
        type
            IField = interface
                procedure GetRaw(Dst: Pointer);
                procedure SetRaw(Src: Pointer);
            end;

            IField<T> = interface(IField)
                {$region 'private'}
                function GetValue: T;
                procedure SetValue(const Value: T);
                {$endregion}
                property Value: T read GetValue write SetValue;
            end;

            TFieldLayout = record
                Name: string;
                Offset: Integer;
                Size: Integer;
                TypeInfo: PTypeInfo;
            end;

            IBuilder = interface
                procedure AddField(const Name: String; const Value: TValue); overload;
                procedure SetupRecord(out Layout: TArray<TFieldLayout>; out Buffer: TBytes);
            end;

            // The interface helper record that provides the generic AddField<T> method.
            TBuilder = record
            private
                FBuilder: IBuilder;
            public
                constructor Create(const ABuilder: IBuilder);

                // This generic method is the reason for the helper's existence.
                procedure AddField<T>(const Name: String; const Value: T); inline;

                // Wrapper for methods on the underlying interface.
                function CreateRec: TDataRecord; inline;

                // Implicit operators for seamless casting between the helper and the interface.
                class operator Implicit(const AValue: IBuilder): TBuilder; overload;
                class operator Implicit(const AValue: TBuilder): IBuilder; overload;
            end;

    private
        FLayout: TArray<TFieldLayout>;
        FBuffer: TBytes;
    public
        class operator Initialize(out Dest: TDataRecord);
        class operator Finalize(var Dest: TDataRecord);
        class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);

        // Factory method now returns the helper record instance.
        class function CreateBuilder: TBuilder; static;
        function IndexOf(const Name: String): Integer;
        function GetField(const Name: String): IField; overload;
        function GetField<T>(const Name: String): IField<T>; overload;
        property Layout: TArray<TFieldLayout> read FLayout;
    end;

implementation

uses
    System.Classes,
    System.Generics.Collections,
    Myc.DataRecord.Impl;

{ TDataRecord.TBuilder }

constructor TDataRecord.TBuilder.Create(const ABuilder: IBuilder);
begin
    FBuilder := ABuilder;
end;

procedure TDataRecord.TBuilder.AddField<T>(const Name: String; const Value: T);
begin
    FBuilder.AddField(Name, TValue.From<T>(Value));
end;

function TDataRecord.TBuilder.CreateRec: TDataRecord;
begin
    FBuilder.SetupRecord(Result.FLayout, Result.FBuffer);
end;

class operator TDataRecord.TBuilder.Implicit(const AValue: IBuilder): TBuilder;
begin
    Result.FBuilder := AValue;
end;

class operator TDataRecord.TBuilder.Implicit(const AValue: TBuilder): IBuilder;
begin
    Result := AValue.FBuilder;
end;

{ TDataRecord }

function TDataRecord.GetField<T>(const Name: String): IField<T>;
var
    idx: Integer;
begin
    idx := IndexOf(Name);
    if idx < 0 then
        exit;
    if TypeInfo(T) <> FLayout[idx].TypeInfo then
        exit;
    Result := TGenericField<T>.Create(FBuffer, FLayout[idx]);
end;

class function TDataRecord.CreateBuilder: TBuilder;
begin
    // Create the implementation class and wrap it in the helper record.
    Result := TDataRecord.TBuilder.Create(TDataRecordBuilder.Create);
end;

function TDataRecord.GetField(const Name: String): IField;
var
    idx: Integer;
begin
    idx := IndexOf(Name);
    if idx < 0 then
        exit;
    var typeInfo := FLayout[idx].TypeInfo;
    case typeInfo.Kind of
        tkInteger: Result := TIntegerField.Create(FBuffer, FLayout[idx]);
        tkFloat:
            case GetTypeData(typeInfo).FloatType of
                ftSingle: Result := TSingleField.Create(FBuffer, FLayout[idx]);
                ftDouble: Result := TDoubleField.Create(FBuffer, FLayout[idx]);
            end;
        tkInt64: Result := TInt64Field.Create(FBuffer, FLayout[idx]);
        tkString: Result := TStringField.Create(FBuffer, FLayout[idx]);
    end;
    if not Assigned(Result) then
        Result := TField.Create(FBuffer, FLayout[idx]);
end;

function TDataRecord.IndexOf(const Name: String): Integer;
var
    dummyLayout: TFieldLayout;
begin
    dummyLayout.Name := Name;
    if not TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, Result, TFieldLayoutComparer.DefaultComparer) then
        Result := -1;
end;

class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
begin
    Finalize(Dest);

    Dest.FLayout := Src.FLayout;
    SetLength(Dest.FBuffer, Length(Src.FBuffer));
    for var layout in Dest.FLayout do
    begin
        var P: PByte := @Dest.FBuffer[layout.Offset];
        var Q: PByte := @Src.FBuffer[layout.Offset];
        var Val: TValue;
        TValue.Make(Q, layout.TypeInfo, val);
        val.ExtractRawData(P);
    end;
end;

class operator TDataRecord.Initialize(out Dest: TDataRecord);
begin
    Dest.FLayout := nil;
    Dest.FBuffer := nil;
end;

class operator TDataRecord.Finalize(var Dest: TDataRecord);
begin
    if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
        Exit;
    for var layout in Dest.FLayout do
    begin
        var P: PByte := @Dest.FBuffer[layout.Offset];
        var Val: TValue;
        // IsMoved has to be false, because we want the local TValue to own the field and destroy it when it looses scope!
        TValue.MakeWithoutCopy(P, layout.TypeInfo, val, false);
    end;
    Dest.FLayout := nil;
    Dest.FBuffer := nil;
end;

end.