MycLib/Src/Data/Myc.Data.Value.pas

unit Myc.Data.Value;

interface

uses
    System.SysUtils,
    Myc.Data.Scalar,
    Myc.Data.Series;

type
    TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkMethod, vkGeneric);

    TDataValue = record
        type
            TFunc = reference to function(const ArgNodes: TArray<TDataValue>): TDataValue;

    private
        type
            TVal<T> = class(TInterfacedObject)
                Value: T;
{$ifdef DEBUG}
                TypeHandle: Pointer;
{$endif}
                constructor Create(const AValue: T);
            end;

            ILazy = interface
                function GetKind: TDataValueKind;
                function GetValue: TDataValue;
                property Kind: TDataValueKind read GetKind;
                property Value: TDataValue read GetValue;
            end;

            TInternalKind = (vkLazy = Ord(High(TDataValueKind)) + 1);
            TInternalKindOrdinal = 0..Ord(High(TInternalKind));

        var
            FKind: TInternalKindOrdinal;
            FScalar: TScalar;
            FInterface: IInterface;

        function AsLazy: ILazy; inline;
        function GetKind: TDataValueKind; inline;
        function GetIsVoid: Boolean; inline;

    public
        class operator Initialize(out Dest: TDataValue);
        class function Void: TDataValue; inline; static;

        class operator Implicit(const AValue: TScalar): TDataValue; overload; inline;
        class operator Implicit(const AValue: String): TDataValue; overload; inline;
        class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;

        class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
        function AsGeneric<T>: T; inline;

        class function Defer(const Value: TDataValue; const Calc: TFunc): TDataValue; overload; static;

        class function Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; static;

        class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
        class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
        class function FromSeries(const AValue: ISeries): TDataValue; static; inline;

        function AsScalar: TScalar; inline;
        function AsMethod: TFunc; inline;
        function AsText: String; inline;
        function AsRecordSeries: IRecordSeries; inline;
        function AsRecord: TScalarRecord; inline;
        function AsSeries: ISeries; inline;

        function ToString: String;
        property IsVoid: Boolean read GetIsVoid;
        property Kind: TDataValueKind read GetKind;
    end;

    TDataValueKindHelper = record helper for TDataValueKind
    public
        function ToString: string;
    end;

implementation

uses
    TypInfo;

type
    TManagedLazy = class(TInterfacedObject, TDataValue.ILazy)
    private
        FKind: TDataValueKind;
        FVal: IInterface;
        FCalc: TDataValue.TFunc;
        function GetValue: TDataValue;
        function GetKind: TDataValueKind;
    public
        constructor Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc);
    end;

    TScalarLazy = class(TInterfacedObject, TDataValue.ILazy)
    private
        FVal: TScalar;
        FCalc: TDataValue.TFunc;
        function GetKind: TDataValueKind;
        function GetValue: TDataValue;
    public
        constructor Create(const AVal: TScalar; const ACalc: TDataValue.TFunc);
    end;

    TMapSeries = class(TInterfacedObject, ISeries)
    private
        FSourceSeries: ISeries;
        FMapperFunc: TDataValue.TFunc;
        // ISeries
        function GetCount: Int64;
        function GetTotalCount: Int64;
        function GetItems(Idx: Integer): TScalar;
    public
        constructor Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc);
    end;

constructor TManagedLazy.Create(AKind: TDataValueKind; const AVal: IInterface; const ACalc: TDataValue.TFunc);
begin
    inherited Create;
    FKind := AKind;
    Assert(FKind <> vkVoid);
    FVal := AVal;
    FCalc := ACalc;
end;

function TManagedLazy.GetKind: TDataValueKind;
begin
    Result := FKind;
end;

function TManagedLazy.GetValue: TDataValue;
var
    dv: TDataValue;
begin
    dv.FKind := Ord(FKind);
    dv.FInterface := FVal;
    Result := FCalc([dv]);
end;

constructor TScalarLazy.Create(const AVal: TScalar; const ACalc: TDataValue.TFunc);
begin
    inherited Create;
    FVal := AVal;
    FCalc := ACalc;
end;

function TScalarLazy.GetKind: TDataValueKind;
begin
    Result := vkScalar;
end;

function TScalarLazy.GetValue: TDataValue;
begin
    Result := FCalc([FVal]);
end;

{ TDataValue.TVal<T> }

constructor TDataValue.TVal<T>.Create(const AValue: T);
begin
    inherited Create;
    Value := AValue;
{$ifdef DEBUG}
    TypeHandle := TypeInfo(T);
{$endif}
end;

function TDataValue.AsLazy: ILazy;
begin
    Assert(FKind = Ord(vkLazy));
    Result := ILazy(FInterface);
end;

{ TDataValue }

class operator TDataValue.Initialize(out Dest: TDataValue);
begin
    Dest.FKind := Ord(vkVoid);
    Dest.FInterface := nil;
end;

function TDataValue.AsSeries: ISeries;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsSeries);
    if (FKind <> Ord(vkSeries)) then
        raise EInvalidCast.Create('Cannot read value as MemberSeries.');
    Result := ISeries(FInterface);
end;

function TDataValue.AsMethod: TFunc;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsMethod);
    if (FKind <> Ord(vkMethod)) then
        raise EInvalidCast.Create('Cannot read value as a method.');
    Result := TFunc(FInterface);
end;

function TDataValue.AsGeneric<T>: T;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsGeneric<T>);
    if FKind <> Ord(vkGeneric) then
        raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$ifdef DEBUG}
    if TVal<T>(FInterface).TypeHandle <> TypeInfo(T) then
        raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$endif}
    Result := TVal<T>(FInterface).Value;
end;

function TDataValue.AsRecord: TScalarRecord;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsRecord);
    if (FKind <> Ord(vkRecord)) then
        raise EInvalidCast.Create('Cannot read value as Record.');
    Result := (FInterface as TVal<TScalarRecord>).Value;
end;

function TDataValue.AsRecordSeries: IRecordSeries;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsRecordSeries);
    if (FKind <> Ord(vkRecordSeries)) then
        raise EInvalidCast.Create('Cannot read value as RecordSeries.');
    Result := IRecordSeries(FInterface);
end;

function TDataValue.AsScalar: TScalar;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsScalar);
    if (FKind <> Ord(vkScalar)) then
        raise EInvalidCast.Create('Cannot read value as a Scalar.');
    Result := FScalar;
end;

function TDataValue.AsText: String;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Value.AsText);
    if (FKind <> Ord(vkText)) then
        raise EInvalidCast.Create('Cannot read value as Text.');
    Result := (FInterface as TVal<String>).Value;
end;

class function TDataValue.Defer(const Value: TDataValue; const Calc: TFunc): TDataValue;
begin
    Result.FKind := Ord(vkLazy);
    case Value.FKind of
        Ord(vkScalar): Result.FInterface := TScalarLazy.Create(Value.AsScalar, Calc);
        Ord(vkLazy):
        begin
            // Create a new lazy object that wraps the existing one, passing the original
            // kind and the inner lazy interface.
            var cCalc: TFunc := Calc;
            Result.FInterface :=
                TManagedLazy.Create(
                    Value.AsLazy.Kind,
                    Value.FInterface,
                    function(const ArgNodes: TArray<TDataValue>): TDataValue
                    begin
                        // Chain lazy computations. The new calculation function will first evaluate
                        // the inner lazy value and then pass the result to the new calculation.
                        // The reconstructed TDataValue in ArgNodes[0] contains the inner ILazy interface.
                        Assert(Length(ArgNodes) = 1, 'Expected 1 argument in lazy computation chain');
                        Result := cCalc([ILazy(ArgNodes[0].FInterface).Value]);
                    end
                );
        end;
    else
        Result.FInterface := TManagedLazy.Create(Value.Kind, Value.FInterface, Calc);
    end;
end;

class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
    Result.FKind := Ord(vkGeneric);
    Result.FInterface := TVal<T>.Create(AValue);
end;

class function TDataValue.FromSeries(const AValue: ISeries): TDataValue;
begin
    Result.FKind := Ord(vkSeries);
    Result.FInterface := AValue;
end;

class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
begin
    Result.FKind := Ord(vkRecord);
    Result.FInterface := TVal<TScalarRecord>.Create(AValue);
end;

class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue;
begin
    Result.FKind := Ord(vkRecordSeries);
    Result.FInterface := AValue;
end;

class operator TDataValue.Implicit(const AValue: TScalar): TDataValue;
begin
    Result.FKind := Ord(vkScalar);
    Result.FScalar := AValue;
    Result.FInterface := nil;
end;

class operator TDataValue.Implicit(const AValue: String): TDataValue;
begin
    Result.FKind := Ord(vkText);
    Result.FInterface := TVal<String>.Create(AValue);
end;

function TDataValue.GetIsVoid: Boolean;
begin
    Result := FKind = Ord(vkVoid);
end;

function TDataValue.GetKind: TDataValueKind;
begin
    if FKind = Ord(vkLazy) then
        exit(AsLazy.Kind);
    Result := TDataValueKind(FKind);
end;

class function TDataValue.Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries;
begin
    Result := TMapSeries.Create(SourceSeries, MapperFunc);
end;

function TDataValue.ToString: String;
var
    sb: TStringBuilder;
    field: TScalarRecordField;
    first: Boolean;
begin
    case FKind of
        Ord(vkScalar): Result := FScalar.ToString;
        Ord(vkText): Result := '"' + AsText + '"';
        Ord(vkSeries):
        begin
            var series := AsSeries;
            // Add type and count for series
            Result := Format('<series[%d]>', [series.Count]);
        end;
        Ord(vkRecordSeries):
        begin
            var series := AsRecordSeries;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for field in series.Def.Fields do
                begin
                    if not first then
                        sb.Append(',');
                    sb.Append(field.Name);
                    first := False;
                end;
                sb.Append('}');
                // Add field names and count for record series
                Result := Format('<record_series%s[%d]>', [sb.ToString, series.Count]);
            finally
                sb.Free;
            end;
        end;
        Ord(vkRecord):
        begin
            var rec := AsRecord;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for field in rec.Def.Fields do
                begin
                    if not first then
                        sb.Append(',');
                    sb.Append(field.Name);
                    first := False;
                end;
                sb.Append('}');
                // Add field names for records
                Result := Format('<record%s>', [sb.ToString]);
            finally
                sb.Free;
            end;
        end;
        Ord(vkVoid): Result := '<void>';
        Ord(vkMethod): Result := '<method>';
        Ord(vkGeneric):
            // Getting meaningful type information for vkGeneric is not easily possible
            // without storing additional RTTI, as the specific type of T in TVal<T> is lost.
            Result := '<generic>';
        Ord(vkLazy): Result := Format('<lazy[%s]>', [AsLazy.Kind.ToString]);
    else
        Result := '[Unknown DataValue]';
    end;
end;

class function TDataValue.Void: TDataValue;
begin
    Result := Default(TDataValue);
end;

class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue;
begin
    Result.FKind := Ord(vkMethod);
    TFunc(Result.FInterface) := AValue;
end;

{ TDataValueKindHelper }

function TDataValueKindHelper.ToString: string;
begin
    case Self of
        vkVoid: Result := 'Void';
        vkScalar: Result := 'Scalar';
        vkText: Result := 'Text';
        vkSeries: Result := 'Series';
        vkRecordSeries: Result := 'RecordSeries';
        vkRecord: Result := 'Record';
        vkMethod: Result := 'Method';
    else
        Result := 'unknown';
    end;
end;

{ TMapSeries }

constructor TMapSeries.Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc);
begin
    inherited Create;
    FSourceSeries := ASourceSeries;
    FMapperFunc := AMapperFunc;
end;

function TMapSeries.GetCount: Int64;
begin
    Result := FSourceSeries.Count;
end;

function TMapSeries.GetTotalCount: Int64;
begin
    Result := FSourceSeries.TotalCount;
end;

function TMapSeries.GetItems(Idx: Integer): TScalar;
var
    sourceValue: TScalar;
    argArray: TArray<TDataValue>;
    mappedValue: TDataValue;
begin
    // Get the original item, apply the mapper function, and return the result.
    sourceValue := FSourceSeries.Items[Idx];
    argArray := [TDataValue(sourceValue)];
    mappedValue := FMapperFunc(argArray);

    if mappedValue.Kind <> vkScalar then
        raise EInvalidCast.Create('Map function did not return a scalar value.');

    Result := mappedValue.AsScalar;
end;

end.