MycLib/Src/Myc.Trade.Indicators.pas

unit Myc.Trade.Indicators;

interface

{$M+}

uses
    Myc.Data.Pipeline,
    Myc.Data.Records;

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;

    // Interface for creating an indicator instance. Only contains functional aspects.
    IIndicatorFactory = interface
        {$region 'private'}
        function GetArgumentLayout: TDataRecord.TLayout;
        function GetParameterLayout: TDataRecord.TLayout;
        function GetResultLayout: TDataRecord.TLayout;
        {$endregion}

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

        property ParameterLayout: TDataRecord.TLayout read GetParameterLayout;
        property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout;
        property ResultLayout: TDataRecord.TLayout read GetResultLayout;
    end;

    TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory)
    private
        FParameterLayout: TDataRecord.TLayout;
        FFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
        FName: String;
        FArgumentLayout: TDataRecord.TLayout;
        FResultLayout: TDataRecord.TLayout;
        FShortName: String;
        FHint: String;
        function GetArgumentLayout: TDataRecord.TLayout;
        function GetParameterLayout: TDataRecord.TLayout;
        function GetResultLayout: TDataRecord.TLayout;
    public
        constructor Create(
            const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout;
            const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
            const AShortName, AName, AHint: String
        );

        class function CreateFromTemplate<T>: TGenericIndicatorFactory;

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

        property ParameterLayout: TDataRecord.TLayout read GetParameterLayout;
        property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout;
        property ResultLayout: TDataRecord.TLayout read GetResultLayout;

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

        // 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,
    System.Rtti;

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 AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout;
    const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
    const AShortName, AName, AHint: String
);
begin
    inherited Create;
    FParameterLayout := AParameterLayout;
    FArgumentLayout := AArgumentLayout;
    FResultLayout := AResultLayout;
    FFactoryProc := AFactoryProc;
    FShortName := AShortName;
    FName := AName;
    FHint := AHint;
end;

class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
var
    Ctx: TRttiContext;
    rttiType: TRttiType;
    paramsType, argsType, resultType: TRttiType;
    templateFactoryMethod: TRttiMethod;
    parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout;
    factoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
    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 TDataRecord 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);

    // Create the layouts for parameters, arguments, and results.
    parameterLayout := TDataRecord.TLayout.FromRecord(paramsType.Handle);
    argumentLayout := TDataRecord.TLayout.FromRecord(argsType.Handle);
    resultLayout := TDataRecord.TLayout.FromRecord(resultType.Handle);

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

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

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

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

            var factoryArg: array[0..0] of TValue;
            TValue.Make(Params.RawData, factoryParamTypeInfo, factoryArg[0]);

            // This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
            var workerProcAsValue := currentFactoryInvoke.Invoke(factoryProcAsValue, factoryArg);

            // 3. Return a new anonymous method that wraps the worker proc.
            // This wrapper conforms to the generic TIndicatorProc<TDataRecord, TDataRecord> signature.
            var rttiWorkerProc := Ctx.GetType(workerProcAsValue.TypeInfo);
            var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke');
            var indicatorParamTypeInfo := currentIndicatorInvoke.GetParameters[0].ParamType.Handle;

            Result :=
                function(const Args: TDataRecord): TDataRecord
                begin
                    // Sadly, it's not possible to inject a buffer into a TValue. So we need to copy both Args and Result.

                    // Inner anonymous method: This is the actual indicator proc wrapper.
                    // The layouts are captured from the outer scope.
                    Assert(Args.Layout = argumentLayout);

                    // Prepare argument for the indicator proc invocation.
                    // TValue just carries the data, ownership is held by the caller.
                    var argVal: array[0..0] of TValue;
                    TValue.MakeWithoutCopy(Args.RawData, indicatorParamTypeInfo, argVal[0], true);

                    // Invoke the actual indicator proc.
                    var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcAsValue, argVal);

                    // The result is a TValue containing the result record.
                    // Raw copy and erase all data from the TValue, leaving it as an empty capsule. Ownership is taken
                    // over to the resulting TDataRecord. This works because the memory layouts are exactly the same.
                    Assert(TDataRecord.TLayout.FromRecord(resultAsTValue.TypeInfo) = resultLayout);

                    var buf: TBytes;
                    var resultSize := resultLayout.Size;
                    SetLength(buf, resultSize);

                    var src := resultAsTValue.GetReferenceToRawData;
                    Move(src^, buf[0], resultSize);
                    FillChar(src^, resultSize, 0);

                    Result.Create(resultLayout, buf);
                end;
        end;

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

function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TConvertFunc<TDataRecord, TDataRecord>;
begin
    Assert(
        (not Assigned(FParameterLayout.Fields)) or (Params.Layout = FParameterLayout),
        'Invalid parameter layout for indicator creation'
    );
    Result := FFactoryProc(Params);
end;

function TGenericIndicatorFactory.GetArgumentLayout: TDataRecord.TLayout;
begin
    Result := FArgumentLayout;
end;

function TGenericIndicatorFactory.GetParameterLayout: TDataRecord.TLayout;
begin
    Result := FParameterLayout;
end;

function TGenericIndicatorFactory.GetResultLayout: TDataRecord.TLayout;
begin
    Result := FResultLayout;
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;

{ 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.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String);
var
    item: TItem;
begin
    if not Assigned(Factory) then
        raise EArgumentException.Create('Factory');

    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.