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

unit Myc.Data.Value;

interface

uses
    System.SysUtils,
    System.SyncObjs,
    System.Generics.Collections,
    Myc.Utils,
    Myc.Data.Scalar,
    Myc.Data.Series,
    Myc.Data.Keyword,
    Myc.Trade.DataFeed;

type
    TDataValueKind = (
        vkVoid,
        vkScalar,
        vkText,
        vkSeries,
        vkRecordSeries,
        vkScalarRecord,
        vkGenericRecord,
        vkManagedObject,
        vkMethod,
        vkInterface,
        vkPointer,
        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;

            TObjVal = class(TVal<TObject>)
                destructor Destroy; override;
            end;

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

        function GetIsVoid: Boolean; inline;

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

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

        class function FromIntf<T: IInterface>(const AValue: T): TDataValue; static;
        function AsIntf<T: IInterface>: T; inline;

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

        class function FromPtr(const AValue: Pointer): TDataValue; static; inline;
        function AsPtr: Pointer; inline;

        // This take ownership of the object!
        procedure FromObj(const AValue: TObject); inline;

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

        class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
        class function FromScalarRecord(const AValue: IScalarRecord): TDataValue; static; inline;
        class function FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): 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 AsScalarRecord: IScalarRecord; inline;
        function AsGenericRecord: IKeywordMapping<TDataValue>; inline;
        function AsSeries: ISeries; inline;
        function AsObject: TObject; overload; inline;

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

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

implementation

uses
    System.TypInfo;

type
    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;

{ TDataValue.TVal<T> }

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

{ TDataValue }

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

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

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

function TDataValue.AsGeneric<T>: T;
begin
    if FKind <> vkGeneric then
        raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
    if PTypeInfo(TypeInfo(T)).Kind <> tkInterface then
    begin
{$ifdef DEBUG}
        var val := TVal<T>(FInterface);
        if val.TypeHandle <> TypeInfo(T) then
            raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
{$endif}
        Result := TVal<T>(FInterface).Value;
    end
    else
        IInterface(Pointer(@Result)^) := FInterface
end;

function TDataValue.AsIntf<T>: T;
begin
    if FKind <> vkInterface then
        raise EInvalidCast.Create('Cannot read value as interface.');
    Result := T(FInterface);
end;

function TDataValue.AsObject: TObject;
begin
    if (FKind <> vkManagedObject) then
        raise EInvalidCast.Create('Cannot read value as object.');
    Result := (FInterface as TObjVal).Value;
end;

function TDataValue.AsPtr: Pointer;
begin
    if (FKind <> vkPointer) then
        raise EInvalidCast.Create('Cannot read value as pointer.');
    Result := Pointer(FScalar.Value.AsInt64);
end;

function TDataValue.AsScalarRecord: IScalarRecord;
begin
    if (FKind <> vkScalarRecord) then
        raise EInvalidCast.Create('Cannot read value as Record.');
    Result := IScalarRecord(FInterface);
end;

function TDataValue.AsGenericRecord: IKeywordMapping<TDataValue>;
begin
    if (FKind <> vkGenericRecord) then
        raise EInvalidCast.Create('Cannot read value as GenericRecord.');
    Result := IKeywordMapping<TDataValue>(FInterface);
end;

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

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

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

class function TDataValue.FromIntf<T>(const AValue: T): TDataValue;
begin
    Result.FKind := vkInterface;
    Result.FInterface := IInterface(AValue);
end;

class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
    Result.FKind := vkGeneric;
    if PTypeInfo(TypeInfo(T)).Kind = tkInterface then
        Result.FInterface := IInterface(Pointer(@AValue)^)
    else
        Result.FInterface := TVal<T>.Create(AValue);
end;

class function TDataValue.FromPtr(const AValue: Pointer): TDataValue;
begin
    Assert(sizeof(Pointer) <= sizeof(Int64));
    Result.FKind := vkPointer;
    Result.FScalar.FromInt64(Int64(AValue));
end;

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

class function TDataValue.FromScalarRecord(const AValue: IScalarRecord): TDataValue;
begin
    Result.FKind := vkScalarRecord;
    Result.FInterface := AValue;
end;

class function TDataValue.FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue;
begin
    Result.FKind := vkGenericRecord;
    Result.FInterface := AValue;
end;

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

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

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

function TDataValue.GetIsVoid: Boolean;
begin
    Result := FKind = vkVoid;
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;
    genField: TPair<IKeyword, TDataValue>;
    first: Boolean;
    i: Integer;
begin
    case FKind of
        vkScalar: Result := FScalar.ToString;
        vkText: Result := '"' + AsText + '"';
        vkSeries:
        begin
            var series := AsSeries;
            // Add type and count for series
            Result := Format('<series[%d]>', [series.Count]);
        end;
        vkRecordSeries:
        begin
            var series := AsRecordSeries;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for i := 0 to series.Def.Count - 1 do
                begin
                    if not first then
                        sb.Append(',');
                    field := series.Def[i];
                    sb.Append(field.Key.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;
        vkScalarRecord:
        begin
            var rec := AsScalarRecord;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for i := 0 to rec.Count - 1 do
                begin
                    if not first then
                        sb.Append(',');
                    sb.Append(rec[i].Key.Name);
                    first := False;
                end;
                sb.Append('}');
                // Add field names for records
                Result := Format('<scalar_record%s>', [sb.ToString]);
            finally
                sb.Free;
            end;
        end;

        vkGenericRecord:
        begin
            var rec := AsGenericRecord;
            sb := TStringBuilder.Create;
            try
                sb.Append('{');
                first := True;
                for i := 0 to rec.Count - 1 do
                begin
                    if not first then
                        sb.Append(',');
                    genField := rec[i];
                    sb.Append(genField.Key.Name);
                    first := False;
                end;
                sb.Append('}');
                Result := Format('<generic_record%s>', [sb.ToString]);
            finally
                sb.Free;
            end;
        end;
        vkVoid: Result := '<void>';
        vkMethod: Result := '<method>';
        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>';
    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 := vkMethod;
    TFunc(Result.FInterface) := AValue;
end;

procedure TDataValue.FromObj(const AValue: TObject);
begin
    FKind := vkManagedObject;
    FInterface := TObjVal.Create(AValue);
end;

class operator TDataValue.Implicit(const AValue: TDataValue): TScalar;
begin
    Result := AValue.AsScalar;
end;

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

class operator TDataValue.Implicit(const AValue: Double): TDataValue;
begin
    Result.FKind := vkScalar;
    Result.FScalar := TScalar.FromDouble(AValue);
    Result.FInterface := nil;
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';
        vkScalarRecord: Result := 'ScalarRecord';
        vkGenericRecord: Result := 'GenericRecord';
        vkMethod: Result := 'Method';
        vkInterface: Result := 'Interface';
        vkPointer: Result := 'Pointer';
        vkGeneric: Result := 'Generic';
        vkManagedObject: Result := 'ManagedObject';
    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;

destructor TDataValue.TObjVal.Destroy;
begin
    Value.Free;
    inherited;
end;

end.