Visitor Pattern

[hansmaad]

Wie es scheint, kommt man um hässliche Typecasts nicht herum. Ich hab mir noch eine Lösung geschrieben, die diese Typunterscheidung wenigstens an einer Stelle kapselt und ein normales Visitor 'faked':

Delphi-Quellcode:

unit UBase;
interface

type
    BaseVisitor = class;

    Base = class
    public
      procedure Accept(v : BaseVisitor);virtual;abstract;
    end;

    BaseVisitor = class
    public
        procedure Visit(b : Base); virtual; abstract;
    end;
implementation
end.

Delphi-Quellcode:

unit UnitA;
interface
uses
    UBase;

type
    A = class(Base)
        Socke_ : Integer;
    public
        procedure Accept(v : BaseVisitor);override;
        property Socke : Integer read Socke_;
    end;

implementation

{ A }
procedure A.Accept(v: BaseVisitor);
begin
    v.Visit(Self);
end;

end.

Delphi-Quellcode:

unit UnitB;
interface
uses
    UBase;
type
    B = class(Base)
    private
        Schnitzel_ :String;
    public
        procedure Accept(v : BaseVisitor);override;
        property Schnitzel : String read Schnitzel_;
    end;

implementation

{ B }
procedure B.Accept(v: BaseVisitor);
begin
    v.Visit(Self);
end;

end.

Delphi-Quellcode:

unit UVisitor;

interface
uses
    UBase,
    UConcreteVisitor;
type
    Visitor = class(BaseVisitor)
    private
        V_ :  ConcreteVisitor;
    public
        constructor Create(v : ConcreteVisitor);overload;
        destructor Destroy();override;
        procedure Visit(el : Base); override;
    end;

implementation
uses
    SysUtils,
    UnitA,
    UnitB;

{ Visitor }

constructor Visitor.Create(v: ConcreteVisitor);
begin
  inherited Create;
  V_ := v;
end;

destructor Visitor.Destroy;
begin
  V_.Free;
  inherited;
end;

procedure Visitor.Visit(el: Base);
begin
    // Die gekapselte Ekelstelle:
    if el is A then
        V_.Visit(A(el))
    else if el is B then
        V_.Visit(B(el))
    else
        Raise Exception.Create('Unknown Element!');
end;

end.

Delphi-Quellcode:

unit UConcreteVisitor;

interface

uses
    UnitA,UnitB;
type

    ConcreteVisitor = class
    public
        procedure Visit(x : A);overload;virtual;abstract;
        procedure Visit(x : B);overload;virtual;abstract;
    end;

implementation
end.

Delphi-Quellcode:

unit UWriteVisitor;

interface
uses
    UConcreteVisitor,
    UnitA,
    UnitB;
type
    WriteVisitor = class(ConcreteVisitor)
    public
        procedure Visit(x : A);overload;override;
        procedure Visit(x : B);overload;override;
    end;
implementation
uses
    SysUtils;

{ WriterVisitor }

procedure WriteVisitor.Visit(x: A);
begin
    WriteLn('Ein A! mit ' + IntToStr(x.Socke))
end;

procedure WriteVisitor.Visit(x: B);
begin
    WriteLn('BeeeeH! :>>> ' + x.Schnitzel)
end;

end.

Delphi-Quellcode:

program visit;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Generics.Collections,
  UBase in 'UBase.pas',
  UVisitor in 'UVisitor.pas',
  UConcreteVisitor in 'UConcreteVisitor.pas',
  UnitA in 'UnitA.pas',
  UnitB in 'UnitB.pas',
  UWriteVisitor in 'UWriteVisitor.pas';

var
    list : TList<Base>;
    v : BaseVisitor;
    x : Base;
begin
    list := TList<Base>.Create;
    list.Add(A.Create);
    list.Add(B.Create);

    v := Visitor.Create(WriteVisitor.Create);

    for x in list do
        x.Accept(v);

    list.Free;
    v.Free;

    ReadLn;
end.

Neue Visitor erben von ConcreteVisitor und können wie 'normale' Visitor geschrieben werden.