MycLib/Src/Data/Myc.Data.Types.pas

unit Myc.Data.Types;

interface

uses
    System.Generics.Collections,
    System.SysUtils,
    System.RTTI;

type
    TDataKind = (dkOrdinal, dkFloat, dkText, dkTimestamp, dkRecord, dkTuple, dkArray, dkEnum, dkMethod);

    IDataType = interface
        function GetName: String;
        function GetKind: TDataKind;
        property Name: String read GetName;
        property Kind: TDataKind read GetKind;
    end;

    IDataValue = interface
        function GetDataType: IDataType;
        function GetAsString: string;
        function AsTValue: TValue;
        property DataType: IDataType read GetDataType;
        property AsString: string read GetAsString;
    end;

    IDataOrdinalValue = interface(IDataValue)
        function GetValue: Int64;
        property Value: Int64 read GetValue;
    end;

    IDataOrdinalType = interface(IDataType)
        function CreateValue(Init: Int64): IDataOrdinalValue;
    end;

    IDataFloatValue = interface(IDataValue)
        function GetValue: Double;
        property Value: Double read GetValue;
    end;

    IDataFloatType = interface(IDataType)
        function CreateValue(Init: Double): IDataFloatValue;
    end;

    IDataTextValue = interface(IDataValue)
        function GetValue: string;
        property Value: string read GetValue;
    end;

    IDataTextType = interface(IDataType)
        function CreateValue(const AValue: string): IDataTextValue;
    end;

    IDataTimestampValue = interface(IDataValue)
        function GetValue: TDateTime;
        property Value: TDateTime read GetValue;
    end;

    IDataTimestampType = interface(IDataType)
        function CreateValue(const AValue: TDateTime): IDataTimestampValue;
    end;

    IDataEnumValue = interface(IDataValue)
        function GetValue: Integer;
        property Value: Integer read GetValue;
    end;

    IDataEnumType = interface(IDataType)
        function GetIdentifier(Idx: Integer): string;
        function GetIdentifierCount: Integer;
        function IndexOf(const AIdentifier: string): Integer;
        function CreateValue(const AValue: Integer): IDataEnumValue; overload;
        function CreateValue(const AIdentifier: string): IDataEnumValue; overload;
        property IdentifierCount: Integer read GetIdentifierCount;
        property Identifiers[Idx: Integer]: string read GetIdentifier; default;
    end;

    // A method that transforms one data value into another.
    TMethodProc = reference to function(const AValue: IDataValue): IDataValue;

    // Represents an executable method data value.
    IDataMethodValue = interface(IDataValue)
        {$region 'private'}
        function GetValue: TMethodProc;
        {$endregion}
        property Value: TMethodProc read GetValue;
    end;

    // Represents the type of a method data value, including its signature.
    IDataMethodType = interface(IDataType)
        {$region 'private'}
        function GetArgType: IDataType;
        function GetResultType: IDataType;
        {$endregion}
        property ArgType: IDataType read GetArgType;
        property ResultType: IDataType read GetResultType;
        function CreateValue(const AValue: TMethodProc): IDataMethodValue;
    end;

    IDataRecordValue = interface(IDataValue)
        function GetItem(Idx: Integer): IDataValue;
        property Items[Idx: Integer]: IDataValue read GetItem; default;
    end;

    TRecordField = record
        Name: string;
        DataType: IDataType;
        constructor Create(const AName: string; const ADataType: IDataType);
    end;

    IDataRecordType = interface(IDataType)
        function GetFieldCount: Integer;
        function GetField(Idx: Integer): TRecordField;
        function IndexOf(const AName: string): Integer;
        function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
        property FieldCount: Integer read GetFieldCount;
        property Fields[Idx: Integer]: TRecordField read GetField; default;
    end;

    IDataTupleValue = interface(IDataValue)
        function GetItemCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
        property ItemCount: Integer read GetItemCount;
        property Items[Idx: Integer]: IDataValue read GetItem; default;
    end;

    IDataTupleType = interface(IDataType)
        function CreateValue(const AItems: array of IDataValue): IDataTupleValue;
    end;

    IDataArrayValue = interface(IDataValue)
        function GetElementCount: Integer;
        function GetItem(Idx: Integer): IDataValue;
        property ElementCount: Integer read GetElementCount;
        property Items[Idx: Integer]: IDataValue read GetItem; default;
    end;

    IDataArrayType = interface(IDataType)
        function GetElementType: IDataType;
        function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
        property ElementType: IDataType read GetElementType;
    end;

    TDataType = record
    strict private
        FDataType: IDataType;
        function GetName: String; inline;
        function GetKind: TDataKind; inline;
        class var
            FArrayTypeRegistry: TDictionary<IDataType, IDataArrayType>;
            FRecordTypeRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
            FMethodTypeRegistry: TDictionary<TPair<IDataType, IDataType>, IDataMethodType>;
        class constructor CreateClass;
        class destructor DestroyClass;
    public
        constructor Create(const ADataType: IDataType);

        class operator Implicit(const A: IDataType): TDataType; overload;
        class operator Implicit(const A: TDataType): IDataType; overload;

        // Type factories
        class function Ordinal: IDataOrdinalType; static;
        class function Float: IDataFloatType; static;
        class function Text: IDataTextType; static;
        class function Timestamp: IDataTimestampType; static;
        class function Tuple: IDataTupleType; static;
        class function MethodOf(const AArgType, AResultType: IDataType): IDataMethodType; static;
        class function ArrayOf(const AElementType: IDataType): IDataArrayType; static;
        class function RecordOf(const Fields: TArray<TRecordField>): IDataRecordType; overload; static;
        class function RecordOf(const Fields: array of TRecordField): IDataRecordType; overload; static;
        class function EnumOf(const AName: string; const AIdentifiers: array of string): IDataEnumType; static;

        // Casting
        function AsOrdinal: IDataOrdinalType;
        function AsFloat: IDataFloatType;
        function AsText: IDataTextType;
        function AsTimestamp: IDataTimestampType;
        function AsRecord: IDataRecordType;
        function AsTuple: IDataTupleType;
        function AsArray: IDataArrayType;
        function AsEnum: IDataEnumType;
        function AsMethod: IDataMethodType;

        property DataType: IDataType read FDataType;
        property Name: String read GetName;
        property Kind: TDataKind read GetKind;
    end;

    TDataValue = record
    private
        FDataValue: IDataValue;
        function GetDataType: IDataType; inline;
    public
        constructor Create(const ADataValue: IDataValue);

        // Casting
        function AsOrdinal: IDataOrdinalValue;
        function AsFloat: IDataFloatValue;
        function AsText: IDataTextValue;
        function AsTimestamp: IDataTimestampValue;
        function AsRecord: IDataRecordValue;
        function AsTuple: IDataTupleValue;
        function AsArray: IDataArrayValue;
        function AsEnum: IDataEnumValue;
        function AsMethod: IDataMethodValue;

        class operator Implicit(const A: IDataValue): TDataValue; overload;
        class operator Implicit(const A: TDataValue): IDataValue; overload;

        // Value factories
        class function FromOrdinal(const AValue: Int64): IDataOrdinalValue; static;
        class function FromFloat(const AValue: Double): IDataFloatValue; static;
        class function FromText(const AValue: string): IDataTextValue; static;
        class function FromTimestamp(const AValue: TDateTime): IDataTimestampValue; static;
        class function FromTuple(const AItems: array of IDataValue): IDataTupleValue; static;
        class function FromMethod(const AMethodType: IDataMethodType; const AValue: TMethodProc): IDataMethodValue; static;

        property DataValue: IDataValue read FDataValue;
        property DataType: IDataType read GetDataType;
    end;

implementation

uses
    System.SyncObjs,
    System.Generics.Defaults,
    Myc.Data.Types.Ordinal,
    Myc.Data.Types.Float,
    Myc.Data.Types.Text,
    Myc.Data.Types.Timestamp,
    Myc.Data.Types.Arrays,
    Myc.Data.Types.Records,
    Myc.Data.Types.Tuple,
    Myc.Data.Types.Enum,
    Myc.Data.Types.Method;

{ TRecordField }

constructor TRecordField.Create(const AName: string; const ADataType: IDataType);
begin
    Name := AName;
    DataType := ADataType;
end;

{ TDataType }

constructor TDataType.Create(const ADataType: IDataType);
begin
    FDataType := ADataType;
end;

class constructor TDataType.CreateClass;
begin
    FArrayTypeRegistry := TDictionary<IDataType, IDataArrayType>.Create;
    FRecordTypeRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
    FMethodTypeRegistry :=
        TDictionary<TPair<IDataType, IDataType>, IDataMethodType>.Create(
            TEqualityComparer<TPair<IDataType, IDataType>>.Construct(
                function(const Left, Right: TPair<IDataType, IDataType>): Boolean
                begin
                    Result := (Left.Key = Right.Key) and (Left.Value = Right.Value);
                end,
                function(const Value: TPair<IDataType, IDataType>): Integer
                var
                    hash1, hash2: NativeInt;
                begin
                    hash1 := NativeInt(Value.Key);
                    hash2 := NativeInt(Value.Value);
                    // Simple XOR combination for pointer hashes
                    Result := Integer(hash1 xor hash2);
                end
            )
        );
end;

class destructor TDataType.DestroyClass;
begin
    FArrayTypeRegistry.Free;
    FRecordTypeRegistry.Free;
    FMethodTypeRegistry.Free;
end;

class function TDataType.ArrayOf(const AElementType: IDataType): IDataArrayType;
begin
    if not Assigned(AElementType) then
        raise EArgumentException.Create('Cannot create an array type with a nil element type.');

    TMonitor.Enter(FArrayTypeRegistry);
    try
        if not FArrayTypeRegistry.TryGetValue(AElementType, Result) then
        begin
            Result := TDataArrayType.Create(AElementType);
            FArrayTypeRegistry.Add(AElementType, Result);
        end;
    finally
        TMonitor.Exit(FArrayTypeRegistry);
    end;
end;

// Implemented missing caster functions
function TDataType.AsArray: IDataArrayType;
begin
    if (FDataType.Kind <> dkArray) then
        raise EInvalidCast.Create('Array expected');
    Result := IDataArrayType(FDataType);
end;

function TDataType.AsEnum: IDataEnumType;
begin
    if (FDataType.Kind <> dkEnum) then
        raise EInvalidCast.Create('Enum expected');
    Result := IDataEnumType(FDataType);
end;

function TDataType.AsFloat: IDataFloatType;
begin
    if (FDataType.Kind <> dkFloat) then
        raise EInvalidCast.Create('Float expected');
    Result := IDataFloatType(FDataType);
end;

function TDataType.AsMethod: IDataMethodType;
begin
    if (FDataType.Kind <> dkMethod) then
        raise EInvalidCast.Create('Method expected');
    Result := IDataMethodType(FDataType);
end;

function TDataType.AsOrdinal: IDataOrdinalType;
begin
    if (FDataType.Kind <> dkOrdinal) then
        raise EInvalidCast.Create('Ordinal expected');
    Result := IDataOrdinalType(FDataType);
end;

function TDataType.AsRecord: IDataRecordType;
begin
    if (FDataType.Kind <> dkRecord) then
        raise EInvalidCast.Create('Record expected');
    Result := IDataRecordType(FDataType);
end;

function TDataType.AsText: IDataTextType;
begin
    if (FDataType.Kind <> dkText) then
        raise EInvalidCast.Create('Text expected');
    Result := IDataTextType(FDataType);
end;

function TDataType.AsTimestamp: IDataTimestampType;
begin
    if (FDataType.Kind <> dkTimestamp) then
        raise EInvalidCast.Create('Timestamp expected');
    Result := IDataTimestampType(FDataType);
end;

function TDataType.AsTuple: IDataTupleType;
begin
    if (FDataType.Kind <> dkTuple) then
        raise EInvalidCast.Create('Tuple expected');
    Result := IDataTupleType(FDataType);
end;

class function TDataType.Float: IDataFloatType;
begin
    Result := TDataFloatType.Singleton;
end;

function TDataType.GetName: String;
begin
    if Assigned(FDataType) then
        Result := FDataType.Name
    else
        Result := '';
end;

class function TDataType.MethodOf(const AArgType, AResultType: IDataType): IDataMethodType;
var
    key: TPair<IDataType, IDataType>;
begin
    key := TPair<IDataType, IDataType>.Create(AArgType, AResultType);
    TMonitor.Enter(FMethodTypeRegistry);
    try
        if not FMethodTypeRegistry.TryGetValue(key, Result) then
        begin
            Result := TDataMethodType.Create(AArgType, AResultType);
            FMethodTypeRegistry.Add(key, Result);
        end;
    finally
        TMonitor.Exit(FMethodTypeRegistry);
    end;
end;

class function TDataType.Ordinal: IDataOrdinalType;
begin
    Result := TDataOrdinalType.Singleton;
end;

class function TDataType.RecordOf(const Fields: TArray<TRecordField>): IDataRecordType;
begin
    TMonitor.Enter(FRecordTypeRegistry);
    try
        if not FRecordTypeRegistry.TryGetValue(Fields, Result) then
        begin
            Result := TDataRecordType.Create(Fields);
            FRecordTypeRegistry.Add(Fields, Result);
        end;
    finally
        TMonitor.Exit(FRecordTypeRegistry);
    end;
end;

class function TDataType.RecordOf(const Fields: array of TRecordField): IDataRecordType;
var
    tFields: TArray<TRecordField>;
    i: Integer;
begin
    SetLength(tFields, Length(Fields));
    for i := 0 to High(Fields) do
        tFields[i] := Fields[i];
    Result := RecordOf(tFields);
end;

class function TDataType.EnumOf(const AName: string; const AIdentifiers: array of string): IDataEnumType;
begin
    Result := TDataEnumType.Create(AName, AIdentifiers);
end;

function TDataType.GetKind: TDataKind;
begin
    Result := FDataType.Kind;
end;

class function TDataType.Text: IDataTextType;
begin
    Result := TDataTextType.Singleton;
end;

class function TDataType.Timestamp: IDataTimestampType;
begin
    Result := TDataTimestampType.Singleton;
end;

class function TDataType.Tuple: IDataTupleType;
begin
    Result := TDataTupleType.Singleton;
end;

class operator TDataType.Implicit(const A: TDataType): IDataType;
begin
    Result := A.FDataType;
end;

class operator TDataType.Implicit(const A: IDataType): TDataType;
begin
    Result.FDataType := A;
end;

{ TDataValue }

constructor TDataValue.Create(const ADataValue: IDataValue);
begin
    FDataValue := ADataValue;
end;

function TDataValue.AsArray: IDataArrayValue;
begin
    if FDataValue.DataType.Kind <> dkArray then
        raise EInvalidCast.Create('Array expected');
    Result := IDataArrayValue(FDataValue);
end;

function TDataValue.AsFloat: IDataFloatValue;
begin
    if FDataValue.DataType.Kind <> dkFloat then
        raise EInvalidCast.Create('Float expected');
    Result := IDataFloatValue(FDataValue);
end;

function TDataValue.AsMethod: IDataMethodValue;
begin
    if FDataValue.DataType.Kind <> dkMethod then
        raise EInvalidCast.Create('Method expected');
    Result := IDataMethodValue(FDataValue);
end;

function TDataValue.AsText: IDataTextValue;
begin
    if FDataValue.DataType.Kind <> dkText then
        raise EInvalidCast.Create('Text expected');
    Result := IDataTextValue(FDataValue);
end;

function TDataValue.AsTimestamp: IDataTimestampValue;
begin
    if FDataValue.DataType.Kind <> dkTimestamp then
        raise EInvalidCast.Create('Timestamp expected');
    Result := IDataTimestampValue(FDataValue);
end;

function TDataValue.AsOrdinal: IDataOrdinalValue;
begin
    if FDataValue.DataType.Kind <> dkOrdinal then
        raise EInvalidCast.Create('Ordinal expected');
    Result := IDataOrdinalValue(FDataValue);
end;

function TDataValue.AsRecord: IDataRecordValue;
begin
    if FDataValue.DataType.Kind <> dkRecord then
        raise EInvalidCast.Create('Record expected');
    Result := IDataRecordValue(FDataValue);
end;

function TDataValue.AsTuple: IDataTupleValue;
begin
    if FDataValue.DataType.Kind <> dkTuple then
        raise EInvalidCast.Create('Tuple expected');
    Result := IDataTupleValue(FDataValue);
end;

function TDataValue.AsEnum: IDataEnumValue;
begin
    if FDataValue.DataType.Kind <> dkEnum then
        raise EInvalidCast.Create('Enum expected');
    Result := IDataEnumValue(FDataValue);
end;

class function TDataValue.FromOrdinal(const AValue: Int64): IDataOrdinalValue;
begin
    Result := TDataOrdinalType.Singleton.CreateValue(AValue);
end;

class function TDataValue.FromFloat(const AValue: Double): IDataFloatValue;
begin
    Result := TDataFloatType.Singleton.CreateValue(AValue);
end;

class function TDataValue.FromMethod(const AMethodType: IDataMethodType; const AValue: TMethodProc): IDataMethodValue;
begin
    if not Assigned(AMethodType) then
        raise EArgumentException.Create('AMethodType');
    Result := AMethodType.CreateValue(AValue);
end;

class function TDataValue.FromText(const AValue: string): IDataTextValue;
begin
    Result := TDataTextType.Singleton.CreateValue(AValue);
end;

class function TDataValue.FromTimestamp(const AValue: TDateTime): IDataTimestampValue;
begin
    Result := TDataTimestampType.Singleton.CreateValue(AValue);
end;

class function TDataValue.FromTuple(const AItems: array of IDataValue): IDataTupleValue;
begin
    Result := TDataTupleType.Singleton.CreateValue(AItems);
end;

function TDataValue.GetDataType: IDataType;
begin
    if Assigned(FDataValue) then
        Result := FDataValue.DataType
    else
        Result := nil;
end;

class operator TDataValue.Implicit(const A: TDataValue): IDataValue;
begin
    Result := A.FDataValue;
end;

class operator TDataValue.Implicit(const A: IDataValue): TDataValue;
begin
    Result.FDataValue := A;
end;

end.