MycLib/Src/Myc.Data.Records.pas

unit Myc.Data.Records;

interface

uses
    System.SysUtils,
    System.TypInfo;

type
    TDataRecord = record
    public
        type
            TFieldType = (dfFloat, dfInteger, dfString, dfTimestamp, dfRecord);

            TField = record
            private
                FFieldType: TFieldType;
                FTypeInfo: PtypeInfo;
                FName: string;
                FOffset: Integer;

                procedure FromType(const [ref] Buffer: TBytes; const Src);
                procedure ToType(const [ref] Buffer: TBytes; var Dst);

                procedure InitField(const [ref] Buffer: TBytes);
                procedure AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
                procedure FinalizeField(const [ref] Buffer: TBytes);

                procedure CopyField(Src, Dst: Pointer);

                property Offset: Integer read FOffset;

                constructor Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);

                procedure Copy(Src, Dst: Pointer);

                function GetSize: Integer; inline;
                function GetAlignedSize: Integer; inline;

            public
                class operator Equal(const A, B: TField): Boolean;
                class operator NotEqual(const A, B: TField): Boolean; inline;

                property FieldType: TFieldType read FFieldType;
                property Name: string read FName;
                property Size: Integer read GetSize;
                property AlignedSize: Integer read GetAlignedSize;
                property TypeInfo: PTypeInfo read FTypeInfo;
            end;

            TFieldDef = record
            public
                Name: String;
                FieldType: TFieldType
            end;

            TLayout = record
            private
                FFields: TArray<TField>;

                constructor Create(const AFields: TArray<TField>);
                function GetSize: Integer;

            public
                class function FromRecord<T>: TLayout; overload; static;
                class function FromRecord(ATypeInfo: PtypeInfo): TLayout; overload; static;

                class operator Equal(const A, B: TLayout): Boolean;
                class operator NotEqual(const A, B: TLayout): Boolean; inline;

                class function Construct(const Def: TArray<TFieldDef>): TLayout; static;

                procedure Copy(Src, Dst: Pointer);

                function IndexOf(const Name: String): Integer;
                property Fields: TArray<TField> read FFields;
                property Size: Integer read GetSize;
            end;

        const
            Align = sizeof(Pointer);

    private
        FLayout: TLayout;
        FBuffer: TBytes;
        function GetRawData: Pointer; inline;

    public
        constructor Create(const ALayout: TLayout); overload;
        constructor Create(const ALayout: TLayout; const ABuffer: TBytes); overload;

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

        class function FromRecord<T>: TDataRecord; overload; static;
        class function FromRecord<T>(const Src: T): TDataRecord; overload; static;

        procedure CopyFrom<T>(const Src: T);

        procedure SetValue<T>(const Name: String; const Value: T); overload;
        procedure SetValue(Idx: Integer; const Value); overload;

        function GetValue<T>(const Name: String): T; overload;
        procedure GetValue(Idx: Integer; out Value); overload;
        function GetValueRef(Idx: Integer): Pointer; overload;

        procedure CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);

        property RawData: Pointer read GetRawData;
        property Layout: TLayout read FLayout;
    end;

implementation

uses
    System.Rtti;

const
    DataSize: array[TDataRecord.TFieldType] of Integer =
        (sizeof(Double), sizeof(Int64), sizeof(String), sizeof(TDateTime), sizeof(TDataRecord));

{ TDataRecord }

constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
begin
    FLayout := ALayout;
    FBuffer := ABuffer;
end;

constructor TDataRecord.Create(const ALayout: TLayout);
begin
    var buf: TBytes;
    SetLength(buf, ALayout.Size);
    Create(ALayout, buf);
end;

procedure TDataRecord.CopyFrom<T>(const Src: T);
begin
    for var i := 0 to High(FLayout.FFields) do
        FLayout.Fields[i].FromType(FBuffer, Src);
end;

procedure TDataRecord.CopyValue(const SrcRec: TDataRecord; SrcIdx, DstIdx: Integer);
begin
    Assert(SrcRec.Layout.Fields[SrcIdx].FieldType = FLayout.Fields[SrcIdx].FieldType);

    var Src := @SrcRec.FBuffer[SrcRec.Layout.Fields[SrcIdx].Offset];
    var Dst := @FBuffer[FLayout.Fields[DstIdx].Offset];

    FLayout.Fields[SrcIdx].CopyField(Src, Dst);
end;

class function TDataRecord.FromRecord<T>: TDataRecord;
begin
    var layout := TLayout.FromRecord<T>;
    var buf: TBytes;

    SetLength(buf, layout.Size);
    for var i := 0 to High(layout.Fields) do
        layout.Fields[i].InitField(buf);

    Result.Create(layout, buf);
end;

class function TDataRecord.FromRecord<T>(const Src: T): TDataRecord;
begin
    Result := FromRecord<T>;
    Result.CopyFrom<T>(Src);
end;

function TDataRecord.GetRawData: Pointer;
begin
    Result := @FBuffer[0];
end;

procedure TDataRecord.GetValue(Idx: Integer; out Value);
begin
    var P := @FBuffer[FLayout.Fields[Idx].Offset];
    case FLayout.Fields[Idx].FieldType of
        dfFloat: Double(Value) := PDouble(P)^;
        dfInteger: Int64(Value) := PInt64(Value)^;
        dfString: String(Value) := PString(Value)^;
        dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
        dfRecord: TDataRecord(Value) := TDataRecord(Value);
    else
        Assert(false);
    end;
end;

procedure TDataRecord.SetValue(Idx: Integer; const Value);
begin
    var P := @FBuffer[FLayout.Fields[Idx].Offset];
    case FLayout.Fields[Idx].FieldType of
        dfFloat: PDouble(P)^ := Double(Value);
        dfInteger: PInt64(P)^ := Int64(Value);
        dfString: PString(P)^ := String(Value);
        dfTimestamp: PDateTime(P)^ := TDateTime(Value);
        dfRecord: TDataRecord(P^) := TDataRecord(Value);
    else
        Assert(false);
    end;
end;

function TDataRecord.GetValue<T>(const Name: String): T;
begin
    var idx := FLayout.IndexOf(Name);
    if (idx >= 0) then
    begin
        Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
        FLayout.Fields[idx].ToType(FBuffer, Result);
    end;
end;

function TDataRecord.GetValueRef(Idx: Integer): Pointer;
begin
    Result := @FBuffer[FLayout.Fields[Idx].Offset];
end;

procedure TDataRecord.SetValue<T>(const Name: String; const Value: T);
begin
    var idx := FLayout.IndexOf(Name);
    if (idx >= 0) then
    begin
        Assert(FLayout.Fields[idx].TypeInfo = TypeInfo(T));
        FLayout.Fields[idx].FromType(FBuffer, Value);
    end;
end;

class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
begin
    if Dest.FLayout.FFields <> Src.FLayout.FFields then
    begin
        Finalize(Dest);
        var buf: TBytes;
        SetLength(buf, Length(Dest.FBuffer));
        Dest.Create(Src.Layout, buf);
    end;

    for var i := 0 to High(Dest.Layout.Fields) do
        Dest.Layout.Fields[i].AssignField(Dest.FBuffer, Src.FBuffer);
end;

class operator TDataRecord.Finalize(var Dest: TDataRecord);
begin
    for var i := High(Dest.FLayout.Fields) downto 0 do
        Dest.Layout.Fields[i].FinalizeField(Dest.FBuffer);
end;

constructor TDataRecord.TField.Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
begin
    FName := AName;
    FFieldType := AFieldType;
    FOffset := AOffset;
    FTypeInfo := ATypeInfo;
end;

procedure TDataRecord.TField.InitField(const [ref] Buffer: TBytes);
begin
    if not (FFieldType in [dfString, dfRecord]) then
        exit;

    Assert(FOffset + Size <= Length(Buffer));

    var P := @Buffer[FOffset];
    case FFieldType of
        dfString: Initialize(PString(P)^);
        dfRecord: Initialize(TDataRecord(P^));
    end;
end;

procedure TDataRecord.TField.FinalizeField(const [ref] Buffer: TBytes);
begin
    if not (FFieldType in [dfString, dfRecord]) then
        exit;

    Assert(FOffset + Size <= Length(Buffer));

    var P := @Buffer[FOffset];
    case FFieldType of
        dfString: Finalize(PString(P)^);
        dfRecord: Finalize(TDataRecord(P^));
    end;
end;

procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; const Src);
begin
    Assert(FOffset + Size <= Length(Buffer));
    Copy(@Src, @Buffer[FOffset]);
end;

function TDataRecord.TField.GetSize: Integer;
begin
    Result := DataSize[FFieldType];
end;

function TDataRecord.TField.GetAlignedSize: Integer;
begin
    Result := (GetSize + (Align - 1)) and not (Align - 1);
end;

procedure TDataRecord.TField.ToType(const [ref] Buffer: TBytes; var Dst);
begin
    var Src := @Buffer[FOffset];
    case FFieldType of
        dfFloat:
        begin
            Assert(FTypeInfo.Kind = tkFloat);
            case GetTypeData(FTypeInfo).FloatType of
                ftSingle: PSingle(@Dst)^ := PSingle(Src)^;
                ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
            else
                Assert(false);
            end;
        end;
        dfInteger:
        begin
            case FTypeInfo.Kind of
                tkInteger: PInteger(@Dst)^ := PInteger(Src)^;
                tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
            else
                Assert(false);
            end;
        end;
        dfString:
        begin
            Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
            PString(@Dst)^ := PString(Src)^;
        end;
        dfTimestamp:
        begin
            Assert(FTypeInfo.Kind = tkFloat);
            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
            PDateTime(@Dst)^ := PDateTime(Src)^;
        end;
        dfRecord:
        begin
            Assert(FTypeInfo = System.TypeInfo(TDataRecord));
            TDataRecord(Dst) := TDataRecord(Src^);
        end;
    else
        Assert(false);
    end;
end;

procedure TDataRecord.TField.AssignField(const [ref] Dest: TBytes; const [ref] Source: TBytes);
begin
    Assert(FOffset + Size <= Length(Dest));

    var Dst := @Dest[FOffset];
    var Src := @Source[FOffset];

    CopyField(Src, Dst);
end;

procedure TDataRecord.TField.CopyField(Src, Dst: Pointer);
begin
    case FFieldType of
        dfFloat: PDouble(Dst)^ := PDouble(Src)^;
        dfInteger: PInt64(Dst)^ := PInt64(Src)^;
        dfString: PString(Dst)^ := PString(Src)^;
        dfTimestamp: PDateTime(Dst)^ := PDateTime(Src)^;
        dfRecord: TDataRecord(Dst^) := TDataRecord(Src^);
    else
        Assert(false);
    end;
end;

procedure TDataRecord.TField.Copy(Src, Dst: Pointer);
begin
    case FFieldType of
        dfFloat:
        begin
            Assert(FTypeInfo.Kind = tkFloat);
            case GetTypeData(FTypeInfo).FloatType of
                ftSingle: PSingle(Dst)^ := PSingle(Src)^;
                ftDouble: PDouble(Dst)^ := PDouble(Src)^;
            else
                Assert(false);
            end;
        end;
        dfInteger:
        begin
            case FTypeInfo.Kind of
                tkInteger: PInteger(Dst)^ := PInteger(Src)^;
                tkInt64: PInt64(Dst)^ := PInt64(Src)^;
            else
                Assert(false);
            end;
        end;
        dfString:
        begin
            Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
            PString(Dst)^ := PString(Src)^;
        end;
        dfTimestamp:
        begin
            Assert(FTypeInfo.Kind = tkFloat);
            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
            PDateTime(Dst)^ := PDateTime(Src)^;
        end;
        dfRecord:
        begin
            Assert(FTypeInfo = System.TypeInfo(TDataRecord));
            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
            TDataRecord(Dst^) := TDataRecord(Src^);
        end;
    else
        Assert(false);
    end;
end;

class operator TDataRecord.TField.Equal(const A, B: TField): Boolean;
begin
    Result := (A.FFieldType = B.FFieldType) and (A.FTypeInfo = B.FTypeInfo) and (A.FOffset = B.FOffset) and (A.FName = B.FName);
end;

class operator TDataRecord.TField.NotEqual(const A, B: TField): Boolean;
begin
    Result := not (A = B);
end;

constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
begin
    FFields := AFields;
end;

class function TDataRecord.TLayout.Construct(const Def: TArray<TFieldDef>): TLayout;
var
    Fields: TArray<TField>;
begin
    SetLength(Fields, Length(Def));
    var ofs := 0;
    for var i := 0 to High(Fields) do
    begin
        var ti: PTypeInfo;
        case Def[i].FieldType of
            dfFloat: ti := TypeInfo(Double);
            dfInteger: ti := TypeInfo(Int64);
            dfString: ti := TypeInfo(String);
            dfTimestamp: ti := TypeInfo(TDateTime);
            dfRecord: ti := TypeInfo(TDataRecord);
        end;

        Fields[i] := TField.Create(Def[i].Name, Def[i].FieldType, ti, ofs);
        inc(ofs, Fields[i].AlignedSize);
    end;

    Result.Create(Fields);
end;

procedure TDataRecord.TLayout.Copy(Src, Dst: Pointer);
begin
    for var i := 0 to High(FFields) do
    begin
        var ofs := FFields[i].Offset;
        var S: PByte := Src;
        inc(S, ofs);
        var D: PByte := Dst;
        inc(D, ofs);
        FFields[i].Copy(S, D);
    end;
end;

{ TLayout }

class function TDataRecord.TLayout.FromRecord(ATypeInfo: PtypeInfo): TLayout;
begin
    var ctx := TRttiContext.Create;
    var rttiType := ctx.GetType(ATypeInfo);
    var rttiFields := rttiType.GetFields;
    var fields: TArray<TField>;

    // Add each field and its value to the builder
    // The internal layout has to be the same as the original record
    SetLength(fields, Length(rttiFields));
    for var i := 0 to High(rttiFields) do
    begin
        var rf := rttiFields[i];
        var ft: TFieldType := Default(TFieldType);
        var supported := true;

        case rf.FieldType.TypeKind of
            tkInt64: ft := dfInteger;
            tkFloat:
                if rf.FieldType.HasName(GetTypeName(TypeInfo(TDateTime))) then
                    ft := dfTimestamp
                else if GetTypeData(rf.FieldType.Handle).FloatType = ftDouble then
                    ft := dfFloat
                else
                    supported := false;
            tkString, tkWString, tkLString, tkUString: ft := dfString;
            tkMRecord:
            begin
                if rf.FieldType.HasName(GetTypeName(TypeInfo(TDataRecord))) then
                    ft := dfRecord
                else
                    supported := false;
            end;
        else
            supported := false;
        end;

        if not supported then
            raise Exception.Create('Type ' + rf.FieldType.Name + ' not supported in data records');

        fields[i] := TField.Create(rf.Name, ft, rf.FieldType.Handle, rf.Offset);
    end;

    Result.Create(fields);
end;

{ TLayout }

class function TDataRecord.TLayout.FromRecord<T>: TLayout;
begin
    Result := FromRecord(TypeInfo(T));
end;

function TDataRecord.TLayout.GetSize: Integer;
begin
    Result := 0;
    if Length(FFields) > 0 then
        with FFields[High(FFields)] do
            Result := Offset + Size;
end;

function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
begin
    for var i := 0 to High(FFields) do
        if (FFields[i].Name = Name) then
            exit(i);
    exit(-1);
end;

class operator TDataRecord.TLayout.Equal(const A, B: TLayout): Boolean;
begin
    if Length(A.FFields) <> Length(B.FFields) then
        exit(false);

    for var i := 0 to High(A.FFields) do
        if A.FFields[i] <> B.FFields[i] then
            exit(false);
    exit(true);
end;

class operator TDataRecord.TLayout.NotEqual(const A, B: TLayout): Boolean;
begin
    Result := not (A = B);
end;

end.