MycLib/Src/Myc.Trade.Indicators_v2.pas

unit Myc.Trade.Indicators_V2;

interface

{$M+}

uses
    System.TypInfo,
    System.Rtti,
    Myc.Data.Pipeline,
    Myc.Data.Types,
    Myc.Data.Types.RTTI,
    System.Classes;

type
    TIndicatorFactoryProc<TParams, TArgs, TResult> = reference to function(const Params: TParams): TConvertFunc<TArgs, TResult>;

    (*
    Sample definition of an indicator template:

    type
        [IndicatorName('HMA', 'Hull Moving Average')]
        [IndicatorHint('A fast, smooth moving average that minimizes lag.')]
        THMA = class
            type
                TParams = record
                    Period: Integer;
                end;

                TArgs = record
                    Value: Double;
                end;

                TResult = record
                    HMA: Double;
                end;

            [IndicatorFactory]
            class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;

            // Hard coded version:
            class function CreateHMA( Period: Integer ): TConvertFunc<Double, Double>; static;
        end;
    *)

    IndicatorFactoryAttribute = class(TCustomAttribute);

    // Attribute to provide a short and a long name for an indicator.
    IndicatorNameAttribute = class(TCustomAttribute)
    private
        FName: string;
        FShortName: string;
    public
        constructor Create(const AShortName, AName: string);
        property ShortName: string read FShortName;
        property Name: string read FName;
    end;

    // Attribute to provide a descriptive hint for an indicator.
    IndicatorHintAttribute = class(TCustomAttribute)
    private
        FHint: string;
    public
        constructor Create(const AHint: string);
        property Hint: string read FHint;
    end;

    TFieldDef = record
    public
        Identifier: String;
        // Use the custom type system instead of PTypeInfo.
        DataType: TDataType;
    end;

    TFieldLayout = TArray<TFieldDef>;

    // Interface for creating an indicator instance. Only contains functional aspects.
    IIndicatorFactory = interface
        function GetParamType: TDataType;
        function GetArgType: TDataType;
        function GetResultType: TDataType;

        function CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>;

        // Provides direct access to the type information of parameters, arguments, and results.
        property ParamType: TDataType read GetParamType;
        property ArgType: TDataType read GetArgType;
        property ResultType: TDataType read GetResultType;
    end;

    TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
    private
        FFactoryProc: TIndicatorFactoryProc<TDataType.TValue, TDataType.TValue, TDataType.TValue>;
        FName: String;
        FShortName: String;
        FHint: String;
        FParamType: TDataType;
        FArgType: TDataType;
        FResultType: TDataType;

    public
        constructor Create(
            const AFactoryProc: TIndicatorFactoryProc<TDataType.TValue, TDataType.TValue, TDataType.TValue>;
            const AShortName, AName, AHint: String;
            const AParamType, AArgType, AResultType: TDataType
        );

        // IIndicatorFactory
        function GetParamType: TDataType;
        function GetArgType: TDataType;
        function GetResultType: TDataType;
        function CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>; overload;

        class function CreateFromTemplate<T>: TGenericIndicatorFactory;

        function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;

        property Name: String read FName;
        property ShortName: String read FShortName;
        property Hint: String read FHint;
    end;

    TIndicatorRegistry = class
    public
        // Represents a registered indicator, combining the factory with its metadata.
        type
            TItem = class
            private
                FFactory: IIndicatorFactory;
                FName: string;
                FShortName: string;
                FHint: string;
            public
                constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
                function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; overload;
                property Factory: IIndicatorFactory read FFactory;
                property Name: string read FName;
                property ShortName: string read FShortName;
                property Hint: string read FHint;
            end;
    private
        FItems: TArray<TItem>;

    public
        constructor Create;
        destructor Destroy; override;

        // Writes the contents of the registry (just like the log)
        procedure LogRegistry(const Log: TStrings);

        // Register indicator from a template class
        procedure RegisterTemplate<TIndicatorTemplate>;

        // Register a pre-built indicator factory
        procedure RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);

        // Find a registered factory by its short name
        function Find(const ShortName: string): TItem;

        // Provides read-only access to the list of all registered indicator items
        property Items: TArray<TItem> read FItems;
    end;

var
    IndicatorRegistry: TIndicatorRegistry;

function DataValueFromTValue(const aValue: TValue): TDataType.TValue;
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;

implementation

uses
    System.SysUtils;

// =================================================================================================
// == Helper functions for type conversion
// =================================================================================================

// Converts an RTTI type object into an IDataType from the custom type system.
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
begin
    if not Assigned(rttiType) then
    begin
        Result := TDataType.Void;
        exit;
    end;

    case rttiType.TypeKind of
        tkInteger, tkInt64, tkEnumeration: Result := TDataType.Ordinal;
        tkFloat: Result := TDataType.Float;
        tkString, tkUString: Result := TDataType.Text;
        tkRecord:
        begin
            var rttiRecord := rttiType as TRttiRecordType;
            var recordFields := TArray<TDataRecordField>.Create();
            for var rttiField in rttiRecord.GetFields do
            begin
                var fieldType := DataTypeFromRttiType(Ctx, rttiField.FieldType);
                recordFields := recordFields + [TDataRecordField.Create(rttiField.Name, fieldType)];
            end;
            Result := TDataType.RecordOf(recordFields);
        end;
    else
        raise ENotSupportedException.CreateFmt(
            'Unsupported RTTI TypeKind "%s" for indicator templates.',
            [GetEnumName(TypeInfo(TTypeKind), Ord(rttiType.TypeKind))]);
    end;
end;

// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
function DataValueFromTValue(const aValue: TValue): TDataType.TValue;
var
    ctx: TRttiContext;
begin
    if aValue.IsEmpty then
    begin
        Result := TDataType.TValue.Create(nil);
        exit;
    end;

    case aValue.Kind of
        tkInteger, tkInt64, tkEnumeration: Result := TDataType.Ordinal.CreateValue(aValue.AsInt64);
        tkFloat: Result := TDataType.Float.CreateValue(aValue.AsExtended);
        tkString, tkUString: Result := TDataType.Text.CreateValue(aValue.AsString);
        tkRecord:
        begin
            ctx := TRttiContext.Create;
            var rttiRecordType := ctx.GetType(aValue.TypeInfo) as TRttiRecordType;
            var recordDataType := DataTypeFromRttiType(ctx, rttiRecordType);

            var items: TArray<IDataValue>;
            var fields := rttiRecordType.GetFields;
            SetLength(items, Length(fields));
            var dataPtr := aValue.GetReferenceToRawData;

            for var i := 0 to High(fields) do
                items[i] := DataValueFromTValue(fields[i].GetValue(dataPtr));

            Result := recordDataType.AsRecord.CreateValue(items);
        end;
    else
        raise ENotSupportedException
            .CreateFmt('Unsupported TValue Kind "%s" for indicator templates.', [GetEnumName(TypeInfo(TTypeKind), Ord(aValue.Kind))]);
    end;
end;

constructor IndicatorNameAttribute.Create(const AShortName, AName: string);
begin
    inherited Create;
    FShortName := AShortName;
    FName := AName;
end;

constructor IndicatorHintAttribute.Create(const AHint: string);
begin
    inherited Create;
    FHint := AHint;
end;

{ TGenericIndicatorFactory }

constructor TGenericIndicatorFactory.Create(
    const AFactoryProc: TIndicatorFactoryProc<TDataType.TValue, TDataType.TValue, TDataType.TValue>;
    const AShortName, AName, AHint: String;
    const AParamType, AArgType, AResultType: TDataType
);
begin
    inherited Create;
    FFactoryProc := AFactoryProc;
    FShortName := AShortName;
    FName := AName;
    FHint := AHint;
    FParamType := AParamType;
    FArgType := AArgType;
    FResultType := AResultType;
end;

class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
var
    Ctx: TRttiContext;
    rttiType: TRttiType;
    paramsDataType, argsDataType, resultDataType: TDataType;
    templateFactoryMethod: TRttiMethod;
    factoryProc: TIndicatorFactoryProc<TDataType.TValue, TDataType.TValue, TDataType.TValue>;
    shortName, name, hint: string;
begin
    // This function creates a generic factory from a template class.
    // It uses RTTI to find the necessary types by inspecting the factory method signature,
    // and then constructs a set of wrappers to adapt the specific types of the template
    // to the generic IDataValue used by this factory.
    Ctx := TRttiContext.Create;
    rttiType := Ctx.GetType(TypeInfo(T));

    // Find the static factory method marked with the [IndicatorFactory] attribute.
    templateFactoryMethod := nil;
    for var method in rttiType.GetMethods do
    begin
        if method.HasAttribute<IndicatorFactoryAttribute> then
        begin
            templateFactoryMethod := method;
            break;
        end;
    end;
    if not Assigned(templateFactoryMethod) then
        raise EArgumentException.CreateFmt('[IndicatorFactory] attribute not found on any method in "%s"', [rttiType.Name]);

    // Ensure the found method has the expected signature of a TIndicatorFactoryProc<>.
    // If any part of the signature check fails, raise an exception.
    var returnType := templateFactoryMethod.ReturnType;
    var rttiFactoryProcType, rttiIndicatorProcType: TRttiInterfaceType;
    var factoryInvoke, indicatorInvoke: TRttiMethod;

    try
        // Level 1: Factory method signature
        if not ((templateFactoryMethod.MethodKind in [mkFunction, mkClassFunction])
            and (Length(templateFactoryMethod.GetParameters) = 0)
            and Assigned(returnType)
            and (returnType.TypeKind = tkInterface)) then
            raise EArgumentException.Create('factory creator');

        // Level 2: Factory procedure signature
        rttiFactoryProcType := returnType as TRttiInterfaceType;
        factoryInvoke := rttiFactoryProcType.GetMethod('Invoke');
        if not (Assigned(factoryInvoke)
            and (Length(factoryInvoke.GetParameters) = 1)
            and (pfConst in factoryInvoke.GetParameters[0].Flags)
            and (factoryInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
            and Assigned(factoryInvoke.ReturnType)
            and (factoryInvoke.ReturnType.TypeKind = tkInterface)) then
            raise EArgumentException.Create('factory');

        // Level 3: Indicator procedure signature
        rttiIndicatorProcType := factoryInvoke.ReturnType as TRttiInterfaceType;
        indicatorInvoke := rttiIndicatorProcType.GetMethod('Invoke');
        if not (Assigned(indicatorInvoke)
            and (Length(indicatorInvoke.GetParameters) = 1)
            and (pfConst in indicatorInvoke.GetParameters[0].Flags)
            and (indicatorInvoke.GetParameters[0].ParamType.TypeKind = tkRecord)
            and Assigned(indicatorInvoke.ReturnType)
            and (indicatorInvoke.ReturnType.TypeKind = tkRecord)) then
            raise EArgumentException.Create('indicator');
    except
        on E: EArgumentException do
            raise EArgumentException.CreateFmt(
                'Method "%s" marked with [IndicatorFactory] has an invalid %s signature. It has to match TIndicatorFactoryProc<>.',
                [templateFactoryMethod.ToString, E.Message]);
    end;

    // Convert RTTI types to TDataType from our custom type system.
    paramsDataType := DataTypeFromRttiType(Ctx, factoryInvoke.GetParameters[0].ParamType);
    argsDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.GetParameters[0].ParamType);
    resultDataType := DataTypeFromRttiType(Ctx, indicatorInvoke.ReturnType);

    // Extract metadata from attributes on the template type T.
    shortName := '';
    name := '';
    hint := '';
    for var attr in rttiType.GetAttributes do
    begin
        if attr is IndicatorNameAttribute then
        begin
            // Read properties from IndicatorNameAttribute.
            var nameAttr := attr as IndicatorNameAttribute;
            shortName := nameAttr.ShortName;
            name := nameAttr.Name;
        end
        else if attr is IndicatorHintAttribute then
        begin
            // Read property from IndicatorHintAttribute.
            var hintAttr := attr as IndicatorHintAttribute;
            hint := hintAttr.Hint;
        end;
    end;

    // Apply default value for ShortName if it wasn't provided via attribute.
    if shortName.IsEmpty then
    begin
        shortName := rttiType.Name;
    end;

    // Create the main factory procedure. This is a double-nested anonymous method
    // that wraps the template's specific factory and worker functions.
    factoryProc :=
        function(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>
        begin
            // Outer anonymous method: This is the factory proc.
            // It gets called with an IDataValue wrapping the parameters record.

            // 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
            var factoryProcVal := templateFactoryMethod.Invoke(TValue.Empty, []);

            // 2. Invoke the factory proc itself to get the actual worker proc.
            var rttiFactoryProc := Ctx.GetType(factoryProcVal.TypeInfo) as TRttiInterfaceType;
            var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke');

            // The parameter for this 'Invoke' call is the TParams record.
            // Convert incoming IDataValue 'Params' into a TValue for the call.
            var paramsAsTValue := Params.AsTValue;

            // This call returns the worker proc (e.g., a TConvertFunc<TArgs, TResult>) as a TValue.
            var workerProcVal := currentFactoryInvoke.Invoke(factoryProcVal, [paramsAsTValue]);

            // 3. Return a new anonymous method that wraps the worker proc.
            // This wrapper conforms to the generic TConvertFunc<IDataValue, IDataValue> signature.
            var rttiWorkerProc := Ctx.GetType(workerProcVal.TypeInfo);
            var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');

            Result :=
                function(const Args: TDataType.TValue): TDataType.TValue
                begin
                    // Inner anonymous method: This is the actual indicator proc wrapper.
                    // Convert input from IDataValue to TValue.
                    var argsAsTValue := Args.AsTValue;

                    // Invoke the actual indicator proc.
                    var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcVal, [argsAsTValue]);

                    // Convert result from TValue back to IDataValue.
                    Result := DataValueFromTValue(resultAsTValue);
                end;
        end;

    // Create the final factory instance with all type handles and extracted metadata.
    Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsDataType, argsDataType, resultDataType);
end;

function TGenericIndicatorFactory.GetParamType: TDataType;
begin
    Result := FParamType;
end;

function TGenericIndicatorFactory.GetArgType: TDataType;
begin
    Result := FArgType;
end;

function TGenericIndicatorFactory.GetResultType: TDataType;
begin
    Result := FResultType;
end;

function TGenericIndicatorFactory.CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>;
var
    internalProc: TConvertFunc<TDataType.TValue, TDataType.TValue>;
begin
    internalProc := FFactoryProc(Params);
    Result := function(const Args: TDataType.TValue): TDataType.TValue begin Result := internalProc(Args); end;
end;

function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
    var paramsAsTValue := TValue.From<TParams>(Params);
    var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
    var cIndicator := FFactoryProc(paramsAsDataValue);

    Result :=
        function(const Args: TArgs): TResult
        begin
            var argsAsTValue := TValue.From<TArgs>(Args);
            var argsAsDataValue := DataValueFromTValue(argsAsTValue);
            var resultAsDataValue := cIndicator(argsAsDataValue);
            var resultAsTValue := resultAsDataValue.AsTValue;
            Result := resultAsTValue.AsType<TResult>;
        end;
end;

{ TIndicatorRegistry.TItem }

constructor TIndicatorRegistry.TItem.Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string);
begin
    inherited Create;
    FFactory := AFactory;
    FShortName := AShortName;
    FName := AName;
    FHint := AHint;
end;

function TIndicatorRegistry.TItem.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
    // Convert typed params to IDataValue for the factory call.
    var paramsAsTValue := TValue.From<TParams>(Params);
    var paramsAsDataValue := DataValueFromTValue(paramsAsTValue);
    var cIndicator := FFactory.CreateIndicator(paramsAsDataValue);

    // Return a wrapper that handles the conversion for args and result.
    Result :=
        function(const Args: TArgs): TResult
        begin
            var argsAsTValue := TValue.From<TArgs>(Args);
            var argsAsDataValue := DataValueFromTValue(argsAsTValue);
            var resultAsDataValue := cIndicator(argsAsDataValue);
            var resultAsTValue := resultAsDataValue.AsTValue;
            Result := resultAsTValue.AsType<TResult>;
        end;
end;

{ TIndicatorRegistry }

constructor TIndicatorRegistry.Create;
begin
    inherited;
    FItems := nil;
end;

destructor TIndicatorRegistry.Destroy;
var
    item: TItem;
begin
    for item in FItems do
        item.Free;
    FItems := nil;
    inherited;
end;

function TIndicatorRegistry.Find(const ShortName: string): TIndicatorRegistry.TItem;
begin
    for var item in FItems do
    begin
        if SameText(item.ShortName, ShortName) then
        begin
            Result := item;
            exit;
        end;
    end;
    Result := nil;
end;

procedure TIndicatorRegistry.LogRegistry(const Log: TStrings);
var
    item: TItem;

    // Generates a field layout from a data type.
    function LayoutFromDataType(DataType: TDataType): TFieldLayout;
    var
        recordType: TDataType.TRecord;
    begin
        if DataType.Kind <> TDataKind.dkRecord then
        begin
            SetLength(Result, 0);
            exit;
        end;

        recordType := DataType.AsRecord;
        SetLength(Result, recordType.FieldCount);
        for var i := 0 to recordType.FieldCount - 1 do
        begin
            Result[i].Identifier := recordType[i].Name;
            Result[i].DataType := recordType[i].DataType;
        end;
    end;

    procedure DoLog(const Txt: String);
    begin
        Log.Add(Txt);
    end;

    procedure LogLayout(const LayoutName: string; const Layout: TFieldLayout);
    var
        field: TFieldDef;
    begin
        DoLog(Format('  %s:', [LayoutName]));
        if Length(Layout) = 0 then
        begin
            DoLog('    (none)');
        end
        else
        begin
            for field in Layout do
                DoLog(Format('    - %s: %s', [field.Identifier, field.DataType.Name]));
        end;
    end;

begin
    if not Assigned(Log) then
        exit;

    Log.Clear;
    DoLog(Format('Indicator Registry Content (%d items)', [Length(FItems)]));
    DoLog('==========================================');
    DoLog('');

    if Length(FItems) = 0 then
    begin
        DoLog('(Registry is empty)');
        exit;
    end;

    for item in FItems do
    begin
        DoLog(Format('Indicator "%s" (%s)', [item.Name, item.ShortName]));
        if not item.Hint.IsEmpty then
            DoLog(Format('  Hint: %s', [item.Hint]));

        // Generate layouts on-the-fly from the factory's type info.
        LogLayout('Params', LayoutFromDataType(item.Factory.ParamType));
        LogLayout('Args', LayoutFromDataType(item.Factory.ArgType));
        LogLayout('Result', LayoutFromDataType(item.Factory.ResultType));
        DoLog('');
    end;
end;

procedure TIndicatorRegistry.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
var
    item: TItem;
begin
    if Assigned(Find(ShortName)) then
        raise EArgumentException.CreateFmt('Indicator with ShortName "%s" is already registered.', [ShortName]);

    // Create the registry item and add it to the list.
    item := TItem.Create(Factory, ShortName, Name, Hint);
    var i := Length(FItems);
    SetLength(FItems, i + 1);
    FItems[i] := item;
end;

procedure TIndicatorRegistry.RegisterTemplate<TIndicatorTemplate>;
begin
    // Create the factory object, which holds both the factory interface and the metadata properties.
    var factory := TGenericIndicatorFactory.CreateFromTemplate<TIndicatorTemplate>;
    // Pass the factory interface and the metadata properties to the core registration method.
    RegisterIndicator(factory, factory.ShortName, factory.Name, factory.Hint);
end;

initialization
    IndicatorRegistry := TIndicatorRegistry.Create;

finalization
    IndicatorRegistry.Free;

end.