Example PurchaseProcess added

.gitignore

@@ -56,3 +56,4 @@ __history/
 # Castalia statistics file
 *.stat
 dunitx-results.xml
+*.res

Examples/PurchaseProcess/PurchaseProcess.Bus.pas

@@ -0,0 +1,122 @@
+unit PurchaseProcess.Bus;
+
+interface
+
+uses
+  System.Classes,
+  System.Generics.Collections,
+  System.SysUtils,
+  PurchaseProcess.Types;
+
+type
+  TBus = class( TInterfacedPersistent, IBus, IOrderChannel )
+  private
+    FMachines : TObjectDictionary<TOrderId, TOrderSM>;
+    FOrders   : TObjectDictionary<TOrderId, TOrderMessage>;
+    FResources: TDictionary<TOrderResourceType, TResource>;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure RegisterResource( const AResource: TResource );
+    procedure Dispatch(
+      const ATransition: TOrderSM.TTransition;
+      const AOrderId   : TOrderId );
+    procedure SendMessage(
+      const AOrderMessage: TOrderMessage;
+      const AOrderEvent  : TOrderEvent );
+  end;
+
+implementation
+
+uses
+  Stateless.Utils,
+  PurchaseProcess.MachineFactory;
+
+{ TBus }
+
+constructor TBus.Create;
+begin
+  inherited;
+  FMachines  := TObjectDictionary<TOrderId, TOrderSM>.Create( [ doOwnsValues ] );
+  FOrders    := TObjectDictionary<TOrderId, TOrderMessage>.Create( [ doOwnsValues ] );
+  FResources := TDictionary<TOrderResourceType, TResource>.Create;
+end;
+
+destructor TBus.Destroy;
+begin
+  FResources.Free;
+  FOrders.Free;
+  FMachines.Free;
+  inherited;
+end;
+
+procedure TBus.Dispatch(
+  const ATransition: TOrderSM.TTransition;
+  const AOrderId   : TOrderId );
+begin
+{$IFDEF DEBUG}Writeln( 'LOG Dispatch( ', ATransition.ToString, ', ', AOrderId, ' )' ); {$ENDIF}
+  case ATransition.Destination of
+    osNoOrder:
+      begin
+        FMachines.Remove( AOrderId );
+        FOrders.Remove( AOrderId );
+      end;
+    osEmpty:
+      begin
+        if not FResources.ContainsKey( ortShop )
+        then
+          raise EInvalidOpException.Create( 'does not contain shop' );
+        FResources[ ortShop ].ReceiveMessage( FOrders[ AOrderId ] );
+      end;
+    osFilled:
+      begin
+        if not FResources.ContainsKey( ortSeller )
+        then
+          raise EInvalidOpException.Create( 'does not contain seller' );
+        FResources[ ortSeller ].ReceiveMessage( FOrders[ AOrderId ] );
+      end;
+    osPaid:
+      begin
+        if not FResources.ContainsKey( ortSender )
+        then
+          raise EInvalidOpException.Create( 'does not contain sender' );
+        FResources[ ortSender ].ReceiveMessage( FOrders[ AOrderId ] );
+      end;
+  else
+    raise ENotImplemented.CreateFmt( 'Dispatch for "%s" not implemented', [ TEnum.AsString( ATransition.Destination ) ] );
+  end;
+end;
+
+procedure TBus.RegisterResource( const AResource: TResource );
+begin
+  FResources.Add( AResource.ResourceType, AResource );
+end;
+
+procedure TBus.SendMessage(
+  const AOrderMessage: TOrderMessage;
+  const AOrderEvent  : TOrderEvent );
+begin
+{$IFDEF DEBUG}Writeln( 'LOG SendMessage( ', AOrderMessage.OrderId, ', ', TEnum.AsString( AOrderEvent ), ' )' ); {$ENDIF}
+  if AOrderEvent = oeAccess
+  then
+    begin
+      FMachines.Add( AOrderMessage.OrderId, MachineFactory.CreateInstance( Self, AOrderMessage.OrderId ) );
+      FOrders.Add( AOrderMessage.OrderId, AOrderMessage );
+    end
+  else
+    begin
+      if FOrders[ AOrderMessage.OrderId ] <> AOrderMessage
+      then
+        FOrders[ AOrderMessage.OrderId ] := AOrderMessage;
+    end;
+
+  if FMachines[ AOrderMessage.OrderId ].CanFire( AOrderEvent )
+  then
+    FMachines[ AOrderMessage.OrderId ].Fire( AOrderEvent )
+  else
+    raise EInvalidOperation.CreateFmt( 'Trigger "%s" is not valid in "%s" order state',
+      [ TEnum.AsString( AOrderEvent ), TEnum.AsString( FMachines[ AOrderMessage.OrderId ].State ) ] );
+end;
+
+end.

Examples/PurchaseProcess/PurchaseProcess.MachineFactory.pas

@@ -0,0 +1,63 @@
+unit PurchaseProcess.MachineFactory;
+
+interface
+
+uses
+  PurchaseProcess.Types;
+
+type
+  MachineFactory = class abstract
+  public
+    class function CreateInstance( const AChannel: IOrderChannel; const Id: TOrderId ): TOrderSM;
+  end;
+
+implementation
+
+{ MachineFactory }
+
+class function MachineFactory.CreateInstance(
+  const AChannel: IOrderChannel;
+  const Id      : TOrderId ): TOrderSM;
+var
+  LId : TOrderId;
+begin
+  LId := Id;
+
+  Result := TOrderSM.Create( osNone );
+
+  Result.Configure( osNone )
+  {} .Permit( oeAccess, osEmpty )
+  {} .OnEntry(
+    procedure( const t: TOrderSM.TTransition )
+    begin
+      AChannel.Dispatch( t, LId );
+    end );
+
+  Result.Configure( osEmpty )
+  {} .Permit( oeOrder, osFilled )
+  {} .Permit( oeExit, osNoOrder )
+  {} .OnEntry(
+    procedure( const t: TOrderSM.TTransition )
+    begin
+      AChannel.Dispatch( t, LId );
+    end );
+
+  Result.Configure( osFilled )
+  {} .Permit( oePay, osPaid )
+  {} .Permit( oeModify, osEmpty )
+  {} .OnEntry(
+    procedure( const t: TOrderSM.TTransition )
+    begin
+      AChannel.Dispatch( t, LId );
+    end );
+
+  Result.Configure( osPaid )
+  {} .Permit( oeExit, osNoOrder )
+  {} .OnEntry(
+    procedure( const t: TOrderSM.TTransition )
+    begin
+      AChannel.Dispatch( t, LId );
+    end );
+end;
+
+end.

Examples/PurchaseProcess/PurchaseProcess.Resources.pas

@@ -0,0 +1,182 @@
+unit PurchaseProcess.Resources;
+
+interface
+
+uses
+  System.SysUtils,
+  PurchaseProcess.Types;
+
+type
+  TSeller = class( TResource )
+  protected
+    function GetResourceType: TOrderResourceType; override;
+  public
+    procedure ReceiveMessage( const AMessage: TOrderMessage ); override;
+  end;
+
+  TSender = class( TResource )
+  protected
+    function GetResourceType: TOrderResourceType; override;
+  public
+    procedure ReceiveMessage( const AMessage: TOrderMessage ); override;
+  end;
+
+  TShop = class( TResource )
+  protected
+    function GetResourceType: TOrderResourceType; override;
+  public
+    procedure ReceiveMessage( const AMessage: TOrderMessage ); override;
+  end;
+
+  TSite = class( TResource )
+  protected
+    function GetResourceType: TOrderResourceType; override;
+  public
+    procedure ReceiveMessage( const AMessage: TOrderMessage ); override;
+    procedure EnterNewOrder( );
+  end;
+
+implementation
+
+{ TSeller }
+
+function TSeller.GetResourceType: TOrderResourceType;
+begin
+  Result := ortSeller;
+end;
+
+procedure TSeller.ReceiveMessage( const AMessage: TOrderMessage );
+var
+  LKey: Char;
+begin
+  inherited;
+  WriteLn( 'Total to pay: ', CurrToStr( AMessage.Total ) );
+  while True do
+    begin
+      write( 'Enter P to pay or M to modify the product quantity ' );
+      ReadLn( LKey );
+      case LKey of
+        'p', 'P':
+          begin
+            FBus.SendMessage( AMessage, oePay );
+            Break;
+          end;
+        'm', 'M':
+          begin
+            FBus.SendMessage( AMessage, oeModify );
+            Break;
+          end;
+      else
+        WriteLn( 'Input not valid' );
+      end;
+    end;
+end;
+
+{ TSender }
+
+function TSender.GetResourceType: TOrderResourceType;
+begin
+  Result := ortSender;
+end;
+
+procedure TSender.ReceiveMessage( const AMessage: TOrderMessage );
+var
+  LKey: Char;
+begin
+  inherited;
+  WriteLn( 'You have bought a quantity of ', AMessage.Quantity, ' and paid ', CurrToStr( AMessage.Total ) );
+  WriteLn( 'The products will be shipped soon' );
+  WriteLn( 'Thank you for your purchase' );
+  while True do
+    begin
+      write( 'Enter O to place a new order or E to exit ' );
+      ReadLn( LKey );
+      case LKey of
+        'e', 'E':
+          begin
+            FBus.SendMessage( AMessage, oeExit );
+            WriteLn( 'Bye!' );
+            ReadLn;
+            Break;
+          end;
+        'o', 'O':
+          begin
+            WriteLn( '-----------------------------------------------' );
+            WriteLn;
+            FBus.SendMessage( TOrderMessage.Create, oeAccess );
+            Break;
+          end;
+      else
+        WriteLn( 'Input not valid' );
+      end;
+    end;
+end;
+
+{ TShop }
+
+function TShop.GetResourceType: TOrderResourceType;
+begin
+  Result := ortShop;
+end;
+
+procedure TShop.ReceiveMessage( const AMessage: TOrderMessage );
+var
+  LInput    : string;
+  LQuantity : Integer;
+  LProvisory: TMutableOrder;
+begin
+  inherited;
+  WriteLn( 'Welcome to the shop' );
+  WriteLn( 'The unit price is 34' );
+  WriteLn( 'You have ', AMessage.Quantity, ' products in your basket' );
+  while True do
+    begin
+      WriteLn( 'Enter product quantity to order or E to exit' );
+      ReadLn( LInput );
+      if LInput.Trim.ToUpper = 'E'
+      then
+        begin
+          FBus.SendMessage( AMessage, oeExit );
+          WriteLn( 'You have exited without buying' );
+          ReadLn;
+          Break;
+        end
+      else if TryStrToInt( LInput, LQuantity )
+      then
+        begin
+          LProvisory := AMessage.CreateOrder;
+          try
+            LProvisory.Quantity := LQuantity;
+            LProvisory.Total    := LQuantity * 34;
+            FBus.SendMessage( LProvisory.CreateOrderMessage, oeOrder );
+          finally
+            LProvisory.Free;
+          end;
+          Break;
+        end
+      else
+        begin
+          WriteLn( 'Input not valid' );
+        end;
+    end;
+end;
+
+{ TSite }
+
+procedure TSite.EnterNewOrder;
+begin
+  FBus.SendMessage( TOrderMessage.Create, oeAccess );
+end;
+
+function TSite.GetResourceType: TOrderResourceType;
+begin
+  Result := ortSite;
+end;
+
+procedure TSite.ReceiveMessage( const AMessage: TOrderMessage );
+begin
+  inherited;
+  raise ENotImplemented.CreateFmt( '%s.ReceiveMessage', [ Self.ClassName ] );
+end;
+
+end.