组合根

uses System.SysUtils, System.Generics.Collections;

type
  TItem = TPair<string, Integer>;

  //entity
  TOrder = record
    Id, Total: Integer;
    function Payable: Integer;
  end;

  //gateway
  ICatalog = interface
    function TryPrice(const Sku: string;
      out Price: Integer): Boolean;
  end;

  //repository
  IOrders = interface
    procedure Save(const Order: TOrder);
    function Count: Integer;
  end;

  //output port
  IReport = interface
    procedure Say(const Text: string);
  end;

  //input port
  IPlaceOrder = interface
    procedure Place(const Items: array of TItem);
  end;

  //use case: asks for its parts, never builds them
  TPlaceOrder = class(TInterfacedObject, IPlaceOrder)
  private
    FCatalog: ICatalog;
    FOrders: IOrders;
    FReport: IReport;
  public
    constructor Create(const Catalog: ICatalog;
      const Orders: IOrders; const Report: IReport);
    procedure Place(const Items: array of TItem);
  end;

  //adapters
  TPriceList = class(TInterfacedObject, ICatalog)
    function TryPrice(const Sku: string;
      out Price: Integer): Boolean;
  end;

  TMemoryOrders = class(TInterfacedObject, IOrders)
  private
    FRows: TArray<TOrder>;
  public
    procedure Save(const Order: TOrder);
    function Count: Integer;
  end;

  TConsoleReport = class(TInterfacedObject, IReport)
    procedure Say(const Text: string);
  end;

  TSilentReport = class(TInterfacedObject, IReport)
    procedure Say(const Text: string);
  end;

  //composition root: the only place that sees every layer
  //at once, and the only place where an adapter is built;
  //a record of interfaces, so reference counting frees
  //every part it built and nobody calls Free
  TShopApp = record
    UseCase: IPlaceOrder;
    Orders: IOrders;
    class function Loud: TShopApp; static;
    class function Quiet: TShopApp; static;
  end;

function TOrder.Payable: Integer;
begin
  Result := Total;
  if Total >= 200 then
    Dec(Result, Total div 10);
end;

constructor TPlaceOrder.Create(const Catalog: ICatalog;
  const Orders: IOrders; const Report: IReport);
begin
  FCatalog := Catalog;
  FOrders := Orders;
  FReport := Report;
end;

procedure TPlaceOrder.Place(const Items: array of TItem);
var
  Order: TOrder;
  Item: TItem;
  Price: Integer;
begin
  Order := Default(TOrder);
  for Item in Items do
    if FCatalog.TryPrice(Item.Key, Price) then
      Inc(Order.Total, Price * Item.Value)
    else
    begin
      FReport.Say('no ' + Item.Key);
      Exit;
    end;
  //the repository numbers the orders by its rows
  Order.Id := 1001 + FOrders.Count;
  FOrders.Save(Order);
  FReport.Say(Format('order %d for %d',
    [Order.Id, Order.Payable]));
end;

function TPriceList.TryPrice(const Sku: string;
  out Price: Integer): Boolean;
begin
  Price := 0;
  if Sku = 'pen' then
    Price := 30
  else if Sku = 'lamp' then
    Price := 190;
  Result := Price > 0;
end;

procedure TMemoryOrders.Save(const Order: TOrder);
begin
  FRows := FRows + [Order];
end;

function TMemoryOrders.Count: Integer;
begin
  Result := Length(FRows);
end;

procedure TConsoleReport.Say(const Text: string);
begin
  WriteLn(Text);
end;

procedure TSilentReport.Say(const Text: string);
begin
end;

class function TShopApp.Loud: TShopApp;
begin
  Result.Orders := TMemoryOrders.Create;
  Result.UseCase := TPlaceOrder.Create(TPriceList.Create,
    Result.Orders, TConsoleReport.Create);
end;

class function TShopApp.Quiet: TShopApp;
begin
  Result.Orders := TMemoryOrders.Create;
  Result.UseCase := TPlaceOrder.Create(TPriceList.Create,
    Result.Orders, TSilentReport.Create);
end;

//client code
var
  App: TShopApp;
begin
  App := TShopApp.Loud;
  App.UseCase.Place([TItem.Create('pen', 2),
    TItem.Create('lamp', 1)]);
  App.UseCase.Place([TItem.Create('chair', 1)]);

  //a second root builds the same use case differently;
  //the first one and all its parts are freed right here
  App := TShopApp.Quiet;
  App.UseCase.Place([TItem.Create('lamp', 1)]);
  WriteLn('saved ', App.Orders.Count);
  //printed: order 1001 for 225
  //         no chair
  //         saved 1
end.