Delphi Enterprise: how can I apply the Visitor Pattern without circular references?
I use the following scheme to implement a flexible visitor pattern:
Declaration of base visitor types
unit uVisitorTypes;
type
IVisited = interface
{ GUID }
procedure Accept(Visitor: IInterface);
end;
IVisitor = interface
{ GUID }
procedure Visit(Instance: IInterface);
end;
TVisitor = class(..., IVisitor)
procedure Visit(Instance: IInterface);
end;
procedure TVisitor.Visit(Instance: IInterface);
var
visited: IVisited;
begin
if Supports(Instance, IVisited, visited) then
visited.Accept(Self)
else
// raise exception or handle error elsewise
end;
The unit for of the element class
unit uElement;
type
TElement = class(..., IVisited)
procedure Accept(Visitor: IInterface);
end;
// declare the visitor interface next to the class-to-be-visited declaration
IElementVisitor = interface
{ GUID }
procedure VisitElement(Instance: TElement);
end;
procedure TElement.Accept(Visitor: IInterface);
var
elementVisitor: IElementVisitor;
begin
if Supports(Visitor, IElementVisitor, elementVisitor) then
elementVisitor.VisitElement(Self)
else
// if override call inherited, handle error or simply ignore
end;
The actual visitor implementation
unit MyVisitorImpl;
uses
uVisitorTypes, uElement;
type
TMyVisitor = class(TVisitor, IElementVisitor)
procedure VisitElement(Instance: TElement);
end;
procedure TMyVisitor.VisitElement(Instance: TElement);
begin
// Do whatever you want with Instance
end;
Calling the visitor
uses
uElement, uMyElementVisitor;
var
visitor: TMyVisitor;
element: TElement;
begin
// get hands on some element
visitor := TMyVisitor.Create;
try
visitor.Visit(element);
finally
visitor.Free;
end;
end;
Why not define IVisitor
IVisitor = interface
procedure VisitElement(AElement :IElement);
end;
then TConcreteElement in its own unit :
unit ConcreteElementUnit;
interface
uses
VisitorUnit;
type
TConcreteElement = class(TInterfacedObject, IElement)
public
procedure Accept(AVisitor :IVisitor); virtual;
end;
Class1 = class(TConcreteElement)
public
procedure Accept(AVisitor :IVisitor);
end;
implementation
{ Class1 }
procedure Class1.Accept(AVisitor: IVisitor);
begin
AVisitor.VisitElement(Self);
end;
end.
That way you are not mixing class and interface references (always a bad idea)
The following implementation using generic type on Visitor interface to solve the circular reference issue of Visitor
pattern:
Visitor.Intf.pas
:
unit Visitor.Intf;
interface
type
IVisitor<T> = interface
procedure Visit_Element(o: T);
end;
implementation
end.
Element.pas
:
unit Element;
interface
uses Visitor.Intf;
type
TElement = class
procedure Accept(const V: IVisitor<TElement>);
end;
implementation
procedure TElement.Accept(const V: IVisitor<TElement>);
begin
V.Visit_Element(Self);
end;
end.
Visitor.Concrete.pas
:
unit Visitor.Concrete;
interface
uses Element, Visitor.Intf;
type
TConcreteVisitor = class(TInterfacedObject, IVisitor<TElement>)
protected
procedure Visit_Element(o: TElement);
end;
implementation
procedure TConcreteVisitor.Visit_Element(o: TElement);
begin
// write implementation here
end;
end.
Using the TElement and TConcreteVisitor class:
var E: TElement;
begin
E := TElement.Create;
E.Accept(TConcreteVisitor.Create as IVisitor<TElement>);
E.Free;
end;