(Code below)

I'm writing a Event Bus with Delphi and the Spring4d Library.

I was inspired by the samples of the Spring4d library (Event Based Architecture)

Basically, the event bus

1. Allows to add subscribers to it
2. Allows to dispatch events to subscribers

I'm interested here in the subscribe method

TEventBus.subscribe(aHandler : TInterfacedObject; aEvtGuid : TGUID);

I'm having problem finding if the given aHandler supports or not the IEventHandler interface :

TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>) // ...
TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>) // ...

aEvtBus.subscribe(aMyClass, IMyEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyOtherEvent) // ok
aEvtBus.subscribe(aMyOtherClass, IMyEvent) // should fail
aEvtBus.subscribe(aMyClass, IMyOtherEvent) // should fail

I'm trying to check if aHandler supports the IEventHandler<aEvtGUid> interface when it tries to subscribe to this event.

What I did for now is to find the RttiInterfaceType corresponding to IEventHandler.

lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');
lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);

Then, I thought about using

SysUtils.Supports(aHandler, lRttiHandlerIntfType.GUID);

The problem is that the RttiInterfaceType.GUID always points to

{97797738-9DB8-4748-92AA-355031294954}

This GUID corresponds to the generic IEventHandler<T : IEvent> interface (See below). So it always returns true as soon as the aHandler implements any IEventHandler<T : IEvent> interface.

How can I find if the handler supports the IEventHandler<aEvtGUid> when aEvtGuid is a GUID obtained from a RttiInterfaceType of a generic interface ?

Edit 1

I also tried

  lValue := TValue.From<TInterfacedObject>(aListener);
  lValue.TryCast( lRttiHandlerIntfType.Handle, lValueCast );

Which always returns true as well.

Code

unit Unit1;


interface


uses
  Spring.Collections,
  Spring.Collections.Lists;


type

  { Event Definitions }

  IEvent = interface(IInterface)
    ['{45434EEC-6125-4349-A673-5077DE6F54C9}']
  End;

  IMyEvent = interface(IEvent)
    ['{C5B07E59-4459-46CF-91CC-4F9706255FCC}']
  end;

  IMyOtherEvent = interface(IEvent)
    ['{8C31AF25-711C-403E-B424-8193696DDE46}']
  end;

  TEvent = class(TInterfacedObject, IEvent);

  TMyEvent = class(TEvent, IMyEvent);

  TMyOtherEvent = class(TEvent, IMyOtherEvent);

  { Event handlers }

  IEventHandler<T: IEvent> = interface(IInterface)
    ['{97797738-9DB8-4748-92AA-355031294954}']
    procedure Handle(aEvent: T);
  end;

  IEventHandler = interface(IEventHandler<IEvent>)
    ['{C3699410-A64A-4C9F-8D87-D95841AD044C}']
  end;

  { Classes that handle events }

  TMyClass = class(TInterfacedObject, IEventHandler<IMyEvent>)
    procedure Handle(aEvent: IMyEvent);
  end;

  TMyOtherClass = class(TInterfacedObject, IEventHandler<IMyOtherEvent>)
    procedure Handle(aEvent: IMyOtherEvent);
  end;

  { Event Bus }

  TEventBus = class
  private
    fSuscribers: IDictionary<TGUID, IList<TObject>>;

  public
    constructor Create;
    procedure Suscribe(
      aListener : TInterfacedObject;
      aEventType: TGUID);
    procedure Dispatch<T: IEvent>(aEvent: T);
    procedure Test;
  end;


implementation


uses
  VCL.Dialogs,
  Rtti,
  Spring.Reflection,
  SysUtils;

procedure TMyClass.Handle(aEvent: IMyEvent);
begin
  ShowMessage('MyClass handle IMyEvent');
end;

{ TMyOtherClass }

procedure TMyOtherClass.Handle(aEvent: IMyOtherEvent);
begin
  ShowMessage('MyOtherClass handle IMyOtherEvent');
end;

constructor TEventBus.Create;
begin
  inherited;
  fSuscribers := TCollections.CreateDictionary<TGUID, IList<TObject>>;;
end;

procedure TEventBus.Dispatch<T>(aEvent: T);
begin
  //
end;

procedure TEventBus.Suscribe(aListener : TInterfacedObject; aEventType: TGUID);
var
  lRttiContext                            : TRttiContext;
  lRttiHandlerType                        : TRttiType;
  lEventHandlerIntfName                   : string;
  lRttiEventIntfType, lRttiHandlerIntfType: TRttiInterfaceType;
  aSuscriberList                          : IList<TObject>;
begin

  if not TType.TryGetInterfaceType(aEventType, lRttiEventIntfType) then
    raise Exception.Create('Impossible to find event type');

  lRttiHandlerType := TType.FindType('IEventHandler<' + lRttiEventIntfType.QualifiedName + '>');

  if lRttiHandlerType = nil then
    raise Exception.Create('Impossible to find handler type');

  if not (lRttiHandlerType.TypeKind = TTypeKind.tkInterface) then
    raise Exception.Create('Handler type is not interface');

  lRttiHandlerIntfType := TRttiInterfaceType(lRttiHandlerType);

  if not Supports(aListener, lRttiHandlerIntfType.GUID) then
    raise Exception.CreateFmt('Subscriber does not support interface %s with guid %s', [lRttiHandlerIntfType.QualifiedName, GUIDToString(lRttiHandlerIntfType.GUID)]);
    
  if not fSuscribers.ContainsKey(aEventType) then
    fSuscribers.Add(aEventType, TCollections.CreateList<TObject>);

  aSuscriberList := fSuscribers.Items[aEventType];

  if not aSuscriberList.Contains(aListener) then
    aSuscriberList.Add(aListener);


end;


procedure TEventBus.Test;
var
  aObj1 : TMyClass;
  aObj2 : TMyOtherClass;
begin

  aObj1 := TMyClass.Create;
  aObj2 := TMyOtherClass.Create;

  Suscribe(aObj1, IMyEvent);
  Suscribe(aObj2, IMyOtherEvent);

  try
    Suscribe(aObj1, IMyOtherEvent);
    raise Exception.Create('Should not be there');
  except on E: Exception do
    ShowMessage(E.Message);
  end;
  
  

end;

end.