MycLib/Src/Myc.Trade.Indicators.pas

unit Myc.Trade.Indicators;

interface

{$M+}

uses
    System.Rtti,
    Myc.Data.Pipeline,
    System.Classes;

type
    TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TConvertFunc<TValue, 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;
        TypeName: String;
    end;

    TFieldLayout = TArray<TFieldDef>;

    // Interface for creating an indicator instance. Only contains functional aspects.
    IIndicatorFactory = interface
        function GetParams: TFieldLayout;
        function GetArgs: TFieldLayout;
        function GetResults: TFieldLayout;

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

        // Provides the layout for the indicator's parameters, arguments, and results.
        property Params: TFieldLayout read GetParams;
        property Args: TFieldLayout read GetArgs;
        property Results: TFieldLayout read GetResults;
    end;

    TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
    private
        FFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
        FName: String;
        FShortName: String;
        FHint: String;
        FParams: TFieldLayout;
        FArgs: TFieldLayout;
        FResults: TFieldLayout;

        class function LayoutFromRecordType(RecordType: TRttiType): TFieldLayout; static;

    public
        constructor Create(
            const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
            const AShortName, AName, AHint: String;
            const AParams, AArgs, AResults: TFieldLayout
        );

        // IIndicatorFactory
        function GetParams: TFieldLayout;
        function GetArgs: TFieldLayout;
        function GetResults: TFieldLayout;
        function CreateIndicator(const Params: TValue): TConvertFunc<TValue, 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;

implementation

uses
    System.SysUtils,
    System.TypInfo;

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<TValue, TValue, TValue>;
    const AShortName, AName, AHint: String;
    const AParams, AArgs, AResults: TFieldLayout
);
begin
    inherited Create;
    FFactoryProc := AFactoryProc;
    FShortName := AShortName;
    FName := AName;
    FHint := AHint;
    FParams := AParams;
    FArgs := AArgs;
    FResults := AResults;
end;

class function TGenericIndicatorFactory.LayoutFromRecordType(RecordType: TRttiType): TFieldLayout;
var
    rttiRecordType: TRttiRecordType;
    field: TRttiField;
    i: Integer;
begin
    if not RecordType.IsRecord then
        raise EArgumentException.CreateFmt('Record type expected, but got %s', [RecordType.Name]);

    rttiRecordType := RecordType as TRttiRecordType;
    var fields := rttiRecordType.GetFields;
    SetLength(Result, Length(fields));
    i := 0;
    for field in fields do
    begin
        Result[i].Identifier := field.Name;
        Result[i].TypeName := field.FieldType.Name;
        Inc(i);
    end;
end;

class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
var
    Ctx: TRttiContext;
    rttiType: TRttiType;
    paramsType, argsType, resultType: TRttiType;
    templateFactoryMethod: TRttiMethod;
    factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
    shortName, name, hint: string;
    paramsLayout, argsLayout, resultsLayout: TFieldLayout;
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 TValue 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;

    // Get types from the now-validated factory method declaration.
    paramsType := factoryInvoke.GetParameters[0].ParamType;
    argsType := indicatorInvoke.GetParameters[0].ParamType;
    resultType := indicatorInvoke.ReturnType;
    Assert(paramsType.TypeKind = tkRecord);
    Assert(argsType.TypeKind = tkRecord);
    Assert(resultType.TypeKind = tkRecord);

    // Generate layouts from RTTI types.
    paramsLayout := LayoutFromRecordType(paramsType);
    argsLayout := LayoutFromRecordType(argsType);
    resultsLayout := LayoutFromRecordType(resultType);

    // 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: TValue): TConvertFunc<TValue, TValue>
        begin
            // Outer anonymous method: This is the factory proc.
            // It gets called with a TValue wrapping the parameters record.

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

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

            // The parameter for this 'Invoke' call is the TParams record.
            // Wrap the incoming TValue 'Params' into a TValue for the call.
            var factoryParamTypeInfo := currentFactoryInvoke.GetParameters[0].ParamType.Handle;
            Assert(factoryParamTypeInfo = paramsType.Handle);

            // This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
            var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]);

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

            Result :=
                function(const Args: TValue): TValue
                begin
                    // Inner anonymous method: This is the actual indicator proc wrapper.
                    // Invoke the actual indicator proc.
                    Result := currentIndicatorInvoke.Invoke(workerProc, [Args]);
                end;
        end;

    // Create the final factory instance with all layouts and extracted metadata.
    Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsLayout, argsLayout, resultsLayout);
end;

function TGenericIndicatorFactory.GetParams: TFieldLayout;
begin
    Result := FParams;
end;

function TGenericIndicatorFactory.GetArgs: TFieldLayout;
begin
    Result := FArgs;
end;

function TGenericIndicatorFactory.GetResults: TFieldLayout;
begin
    Result := FResults;
end;

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

function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
    var cIndicator := FFactoryProc(TValue.From<TParams>(Params));
    Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).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
    var cIndicator := FFactory.CreateIndicator(TValue.From<TParams>(Params));
    Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).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;

    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.TypeName]));
        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]));

        LogLayout('Params', item.Factory.Params);
        LogLayout('Args', item.Factory.Args);
        LogLayout('Result', item.Factory.Results);
        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.