MycLib/Src/Myc.DataRecord.Impl.pas

unit Myc.DataRecord.Impl;

interface

uses
    System.SysUtils,
    System.Rtti,
    System.TypInfo,
    System.Generics.Collections,
    System.Generics.Defaults,
    Myc.DataRecord;

type
    // The builder implementation class, now in the global scope.
    TDataRecordBuilder = class(TInterfacedObject, TDataRecord.TBuilder.IBuilder)
    private
        FStagedValues: TList<TPair<string, TValue>>;
    public
        constructor Create;
        destructor Destroy; override;
        // IBuilder implementation
        procedure AddField(const Name: String; const Value: TValue); overload;
        procedure SetupRecord(out Layout: TArray<TDataRecord.TFieldLayout>; out Buffer: TBytes);
    end;

type
    TField = class(TInterfacedObject, TDataRecord.IField)
    private
        FBuffer: TBytes;
        FFieldLayout: TDataRecord.TFieldLayout;
    protected
        function GetRawRef: Pointer; inline;
    public
        constructor Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
        procedure GetRaw(Dst: Pointer); virtual;
        procedure SetRaw(Src: Pointer); virtual;
        property FieldLayout: TDataRecord.TFieldLayout read FFieldLayout;
    end;

type
    TGenericField<T> = class(TField, TDataRecord.IField<T>)
    public
        function GetValue: T;
        procedure SetValue(const Value: T);
    end;

type
    TIntegerField = class(TGenericField<Integer>)
    public
        procedure GetRaw(Dst: Pointer); override;
        procedure SetRaw(Src: Pointer); override;
    end;

type
    TSingleField = class(TGenericField<Single>)
    public
        procedure GetRaw(Dst: Pointer); override;
        procedure SetRaw(Src: Pointer); override;
    end;

type
    TDoubleField = class(TGenericField<Double>)
    public
        procedure GetRaw(Dst: Pointer); override;
        procedure SetRaw(Src: Pointer); override;
    end;

type
    TInt64Field = class(TGenericField<Int64>)
    public
        procedure GetRaw(Dst: Pointer); override;
        procedure SetRaw(Src: Pointer); override;
    end;

type
    TStringField = class(TGenericField<String>)
    public
        procedure GetRaw(Dst: Pointer); override;
        procedure SetRaw(Src: Pointer); override;
    end;

type
    TFieldLayoutComparer = class(TComparer<TDataRecord.TFieldLayout>)
    strict private
        class var
            FDefaultComparer: IComparer<TDataRecord.TFieldLayout>;
        class constructor CreateClass;
    public
        function Compare(const Left, Right: TDataRecord.TFieldLayout): Integer; override;
        class property DefaultComparer: IComparer<TDataRecord.TFieldLayout> read FDefaultComparer;
    end;

implementation

{ TDataRecordBuilder }

constructor TDataRecordBuilder.Create;
begin
    inherited;
    FStagedValues := TList<TPair<string, TValue>>.Create;
end;

destructor TDataRecordBuilder.Destroy;
begin
    FStagedValues.Free;
    inherited;
end;

procedure TDataRecordBuilder.AddField(const Name: String; const Value: TValue);
begin
    FStagedValues.Add(TPair<string, TValue>.Create(Name, Value));
end;

procedure TDataRecordBuilder.SetupRecord(out Layout: TArray<TDataRecord.TFieldLayout>; out Buffer: TBytes);
var
    layoutList: TList<TDataRecord.TFieldLayout>;
    pair: TPair<string, TValue>;
    field: TDataRecord.TFieldLayout;
begin
    layoutList := TList<TDataRecord.TFieldLayout>.Create;
    try
        layoutList.Capacity := FStagedValues.Count;
        var ofs: NativeUInt := 0;
        for pair in FStagedValues do
        begin
            field.Name := pair.Key;
            field.Size := pair.Value.DataSize;
            ofs := (ofs + 15) and not 15;
            field.Offset := ofs;
            inc(ofs, field.Size);
            field.TypeInfo := pair.Value.TypeInfo;
            layoutList.Add(field);
        end;

        SetLength(Buffer, ofs);

        for var i := 0 to layoutList.Count - 1 do
        begin
            var P: PByte := @Buffer[layoutList[i].Offset];
            FStagedValues[i].Value.ExtractRawData(P);
        end;

        layoutList.Sort(TFieldLayoutComparer.DefaultComparer);
        Layout := layoutList.ToArray;
    finally
        layoutList.Free;
    end;
    FStagedValues.Clear;
end;

{ TField and descendants... }
constructor TField.Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
begin
    inherited Create;
    FBuffer := ABuffer;
    FFieldLayout := AField;
end;

procedure TField.GetRaw(Dst: Pointer);
var
    Val: TValue;
begin
    TValue.MakeWithoutCopy(GetRawRef, FFieldLayout.TypeInfo, val, true);
    val.ExtractRawData(Dst);
end;

function TField.GetRawRef: Pointer;
begin
    Result := @FBuffer[FFieldLayout.Offset];
end;

procedure TField.SetRaw(Src: Pointer);
var
    Val: TValue;
begin
    TValue.MakeWithoutCopy(Src, FFieldLayout.TypeInfo, val, true);
    val.ExtractRawData(GetRawRef);
end;

{ TGenericField<T> }

function TGenericField<T>.GetValue: T;
type
    PT = ^T;
begin
    Result := PT(@FBuffer[FFieldLayout.Offset])^;
end;

procedure TGenericField<T>.SetValue(const Value: T);
type
    PT = ^T;
begin
    PT(@FBuffer[FFieldLayout.Offset])^ := Value;
end;

procedure TIntegerField.GetRaw(Dst: Pointer);
begin
    PInteger(Dst)^ := PInteger(GetRawRef)^;
end;

procedure TIntegerField.SetRaw(Src: Pointer);
begin
    PInteger(GetRawRef)^ := PInteger(Src)^;
end;

procedure TSingleField.GetRaw(Dst: Pointer);
begin
    PSingle(Dst)^ := PSingle(GetRawRef)^;
end;

procedure TSingleField.SetRaw(Src: Pointer);
begin
    PSingle(GetRawRef)^ := PSingle(Src)^;
end;

procedure TDoubleField.GetRaw(Dst: Pointer);
begin
    PDouble(Dst)^ := PDouble(GetRawRef)^;
end;

procedure TDoubleField.SetRaw(Src: Pointer);
begin
    PDouble(GetRawRef)^ := PDouble(Src)^;
end;

procedure TInt64Field.GetRaw(Dst: Pointer);
begin
    PInt64(Dst)^ := PInt64(GetRawRef)^;
end;

procedure TInt64Field.SetRaw(Src: Pointer);
begin
    PInt64(GetRawRef)^ := PInt64(Src)^;
end;

procedure TStringField.GetRaw(Dst: Pointer);
begin
    PString(Dst)^ := PString(GetRawRef)^;
end;

procedure TStringField.SetRaw(Src: Pointer);
begin
    PString(GetRawRef)^ := PString(Src)^;
end;

{ TFieldLayoutComparer }

class constructor TFieldLayoutComparer.CreateClass;
begin
    FDefaultComparer := TFieldLayoutComparer.Create;
end;

function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TFieldLayout): Integer;
begin
    Result := TComparer<string>.Default.Compare(Left.Name, Right.Name);
end;

end.