unit Myc.Data.Types.Records;

interface

uses
    System.Generics.Collections,
    System.SysUtils,
    System.Generics.Defaults,
    System.Hash,
    Myc.Data.Types;

type
    // Custom comparer for TArray<TRecordField> to be used as a dictionary key.
    TDataRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TDataRecordField>>)
    public
        function Equals(const Left, Right: TArray<TDataRecordField>): Boolean; reintroduce;
        function GetHashCode(const Value: TArray<TDataRecordField>): Integer; reintroduce;
    end;

    // Implements the record data type.
    TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
    strict private
        // Class-level registry to cache and reuse record type definitions.
        class var
            FRecordTypeRegistry: TDictionary<TArray<TDataRecordField>, IDataRecordType>;
    private
        FFields: TArray<TDataRecordField>;
        FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
        FEmptyValue: IDataRecordValue; // Cached instance for zero-field records
        function GetName: String;
        function GetKind: TDataKind;
        function GetFieldCount: Integer;
        function GetField(Idx: Integer): TDataRecordField;
        function IndexOf(const AName: string): Integer;
    public
        constructor Create(const AFields: array of TDataRecordField);
        destructor Destroy; override;

        class constructor CreateClass;
        class destructor DestroyClass;

        class function GetInstance(const AFields: array of TDataRecordField): IDataRecordType; overload; static;

        // TODO Create a record ba analyzing the RTTI of T
        class function GetInstance<T>: IDataRecordType; overload; static;

        function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
    end;

implementation

uses
    System.SyncObjs,
    System.Rtti,
    Myc.Data.Types.RTTI;

type
    // Implements the record data value.
    TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
    private
        FDataType: IDataRecordType;
        FItems: TArray<IDataValue>;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a record with 0 fields.
    TImplDataRecordValue0 = class(TInterfacedObject, IDataValue, IDataRecordValue)
    strict private
        class constructor CreateClass;
    private
        FDataType: IDataRecordType;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataRecordType);
    end;

    // Optimized implementation for a record with 1 field.
    TImplDataRecordValue1 = class(TInterfacedObject, IDataValue, IDataRecordValue)
    private
        FDataType: IDataRecordType;
        FItem0: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
    end;

    // Optimized implementation for a record with 2 fields.
    TImplDataRecordValue2 = class(TInterfacedObject, IDataValue, IDataRecordValue)
    private
        FDataType: IDataRecordType;
        FItem0, FItem1: IDataValue;
        function GetDataType: IDataType;
        function GetAsString: string;
        function GetItem(Idx: Integer): IDataValue;
    public
        constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
    end;

{ TDataRecordFieldComparer }

function TDataRecordFieldComparer.Equals(const Left, Right: TArray<TDataRecordField>): Boolean;
var
    i: Integer;
begin
    if (Length(Left) <> Length(Right)) then
        exit(False);

    for i := 0 to High(Left) do
    begin
        if (CompareStr(Left[i].Name, Right[i].Name) <> 0) or (Left[i].DataType <> Right[i].DataType) then
            exit(False);
    end;
    Result := True;
end;

function TDataRecordFieldComparer.GetHashCode(const Value: TArray<TDataRecordField>): Integer;
var
    field: TDataRecordField;
begin
    Result := 0;
    for field in Value do
    begin
        Result := THashBobJenkins.GetHashValue(field.Name) xor THashFNV1a32.GetHashValue(field.DataType, SizeOf(IDataType)) xor Result;
    end;
end;

{ TImplDataRecordValue (generic implementation for N > 2 fields) }

constructor TImplDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
var
    i: Integer;
begin
    inherited Create;
    FDataType := ADataType;
    SetLength(FItems, Length(AItems));
    for i := 0 to High(AItems) do
        FItems[i] := AItems[i];
end;

function TImplDataRecordValue.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataRecordValue.GetAsString: string;
var
    sb: TStringBuilder;
    i: Integer;
    recordType: IDataRecordType;
begin
    recordType := FDataType;
    sb := TStringBuilder.Create;
    try
        sb.Append('<');
        for i := 0 to High(FItems) do
        begin
            sb.Append(recordType.Fields[i].Name);
            sb.Append(': ');
            sb.Append(FItems[i].AsString);
            if (i < High(FItems)) then
                sb.Append(', ');
        end;
        sb.Append('>');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataRecordValue.GetItem(Idx: Integer): IDataValue;
begin
    Result := FItems[Idx];
end;

{ TImplDataRecordValue0 }

class constructor TImplDataRecordValue0.CreateClass;
begin
end;

constructor TImplDataRecordValue0.Create(const ADataType: IDataRecordType);
begin
    inherited Create;
    FDataType := ADataType;
end;

function TImplDataRecordValue0.GetAsString: string;
begin
    Result := '<>';
end;

function TImplDataRecordValue0.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataRecordValue0.GetItem(Idx: Integer): IDataValue;
begin
    raise EArgumentException.Create('Index out of bounds');
end;

{ TImplDataRecordValue1 }

constructor TImplDataRecordValue1.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
end;

function TImplDataRecordValue1.GetAsString: string;
var
    recordType: IDataRecordType;
begin
    recordType := FDataType;
    Result := Format('<%s: %s>', [recordType.Fields[0].Name, FItem0.AsString]);
end;

function TImplDataRecordValue1.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataRecordValue1.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

{ TImplDataRecordValue2 }

constructor TImplDataRecordValue2.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
begin
    inherited Create;
    FDataType := ADataType;
    FItem0 := AItems[0];
    FItem1 := AItems[1];
end;

function TImplDataRecordValue2.GetAsString: string;
var
    recordType: IDataRecordType;
    sb: TStringBuilder;
begin
    recordType := FDataType;
    sb := TStringBuilder.Create;
    try
        sb.Append('<');
        sb.Append(recordType.Fields[0].Name);
        sb.Append(': ');
        sb.Append(FItem0.AsString);
        sb.Append(', ');
        sb.Append(recordType.Fields[1].Name);
        sb.Append(': ');
        sb.Append(FItem1.AsString);
        sb.Append('>');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataRecordValue2.GetDataType: IDataType;
begin
    Result := FDataType;
end;

function TImplDataRecordValue2.GetItem(Idx: Integer): IDataValue;
begin
    case Idx of
        0: Result := FItem0;
        1: Result := FItem1;
    else
        raise EArgumentException.Create('Index out of bounds');
    end;
end;

{ TImplDataRecordType }

class constructor TImplDataRecordType.CreateClass;
begin
    // Initialize the global registry for record types.
    FRecordTypeRegistry := TDictionary<TArray<TDataRecordField>, IDataRecordType>.Create(TDataRecordFieldComparer.Create);
end;

class destructor TImplDataRecordType.DestroyClass;
begin
    FRecordTypeRegistry.Free;
    FRecordTypeRegistry := nil;
end;

class function TImplDataRecordType.GetInstance(const AFields: array of TDataRecordField): IDataRecordType;
var
    tFields: TArray<TDataRecordField>;
    i: Integer;
    res: IDataRecordType;
begin
    SetLength(tFields, Length(AFields));
    for i := 0 to High(AFields) do
        tFields[i] := AFields[i];

    TMonitor.Enter(FRecordTypeRegistry);
    try
        if not FRecordTypeRegistry.TryGetValue(tFields, res) then
        begin
            res := TImplDataRecordType.Create(tFields);
            FRecordTypeRegistry.Add(tFields, res);
        end;
    finally
        TMonitor.Exit(FRecordTypeRegistry);
    end;
    Result := res;
end;

class function TImplDataRecordType.GetInstance<T>: IDataRecordType;
var
    ctx: TRttiContext;
    rttiType: TRttiType;
begin
    // Create an RTTI context to introspect the type T.
    ctx := TRttiContext.Create;
    rttiType := ctx.GetType(TypeInfo(T));

    // The generic parameter T must be a record.
    if not (rttiType is TRttiRecordType) then
        raise EArgumentException.Create('Generic parameter T must be a record type.');

    // Delegate the conversion from RTTI type to IDataType to the helper function.
    Result := RttiTypeToDataType(rttiType).AsRecord;
end;

constructor TImplDataRecordType.Create(const AFields: array of TDataRecordField);
var
    i: Integer;
    field: TDataRecordField;
begin
    inherited Create;
    FFieldMap := TDictionary<string, Integer>.Create;
    SetLength(FFields, Length(AFields));
    for i := 0 to High(AFields) do
    begin
        field := AFields[i];
        if FFieldMap.ContainsKey(field.Name) then
            raise EArgumentException.CreateFmt('Duplicate field name: %s', [field.Name]);
        FFields[i] := field;
        FFieldMap.Add(field.Name, i);
    end;

    // Pre-create the singleton value instance if this is a zero-field record.
    if (Length(FFields) = 0) then
        FEmptyValue := TImplDataRecordValue0.Create(Self);
end;

destructor TImplDataRecordType.Destroy;
begin
    FFieldMap.Free;
    inherited;
end;

function TImplDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
var
    i: Integer;
begin
    if (Length(AItems) <> Length(FFields)) then
        raise EArgumentException
            .CreateFmt('Invalid number of items for this record type. Expected %d, but got %d.', [Length(FFields), Length(AItems)]);

    for i := 0 to High(AItems) do
        if (AItems[i].DataType <> FFields[i].DataType) then
            raise EArgumentException.CreateFmt(
                'Invalid data type for field %s at index %d. Expected %s',
                [FFields[i].Name, i, FFields[i].DataType.Name, AItems[i].DataType.Name]);

    // Use optimized implementations for records with 0, 1, or 2 fields.
    case Length(FFields) of
        0: Result := FEmptyValue; // Return the pre-cached instance.
        1: Result := TImplDataRecordValue1.Create(Self, AItems);
        2: Result := TImplDataRecordValue2.Create(Self, AItems);
    else
        // Use the generic implementation for records with more than 2 fields.
        Result := TImplDataRecordValue.Create(Self, AItems);
    end;
end;

function TImplDataRecordType.GetField(Idx: Integer): TDataRecordField;
begin
    Result := FFields[Idx];
end;

function TImplDataRecordType.GetFieldCount: Integer;
begin
    Result := Length(FFields);
end;

function TImplDataRecordType.GetName: String;
var
    i: Integer;
    sb: TStringBuilder;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('Record<');
        for i := 0 to High(FFields) do
        begin
            sb.Append(FFields[i].Name);
            sb.Append(': ');
            sb.Append(FFields[i].DataType.Name);
            if (i < High(FFields)) then
                sb.Append(', ');
        end;
        sb.Append('>');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

function TImplDataRecordType.GetKind: TDataKind;
begin
    Result := dkRecord;
end;

function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin
    if not FFieldMap.TryGetValue(AName, Result) then
        Result := -1;
end;

end.
