Stateless - StateMachine für Delphi

[Sir Rufo]

Hattest du an so etwas gedacht? (Ist jetzt nicht unbedingt state-of-the-art aber funktioniert).

Im Anhang das komplette Projekt (Source + EXE)

Delphi-Quellcode:

unit DataFetcher.DataContainer;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Threading,
  stateless;

type
{$SCOPEDENUMS ON}
  TDataState   = ( Empty, Busy, Fetching, Cancelling, Refetching, Fetched, HasData, HasError );
  TDataTrigger = ( Fetch, Cancel, Data, Error, Clear );
{$SCOPEDENUMS OFF}
  TDataSM = TStateMachine<TDataState, TDataTrigger>;

type
  TDataContainer<TSource, TResult> = class
  private
    FDataAccessor: TFunc<TSource, TResult>;
    FState       : TDataSM;
    FDataTask    : ITask;
    FValue       : TResult;
    FSource      : TSource;
    procedure ConfigureSM;
    function GetValue: TResult;
    function GetHasValue: Boolean;
    procedure SetSource( const Value: TSource );
    function GetIsBusy: Boolean;
  protected
    procedure FetchData;
    procedure CancelFetch;
  public
    constructor Create( DataAccessor: TFunc<TSource, TResult> );
    destructor Destroy; override;

    procedure Clear;

    function ToString: string; override;

    property HasValue: Boolean read GetHasValue;
    property IsBusy: Boolean read GetIsBusy;
    property Source: TSource read FSource write SetSource;
    property Value: TResult read GetValue;
  end;

implementation

{ TDataContainer }

procedure TDataContainer<TSource, TResult>.CancelFetch;
var
  lTask: ITask;
begin
  lTask := FDataTask;
  if Assigned( lTask )
  then
    lTask.Cancel;
end;

procedure TDataContainer<TSource, TResult>.Clear;
begin
  FState.Fire( TDataTrigger.Clear );
  FSource := default ( TSource );
end;

procedure TDataContainer<TSource, TResult>.ConfigureSM;
begin
  FState := TDataSM.Create( TDataState.Empty );

  FState.Configure( TDataState.Empty )
  {} .Ignore( TDataTrigger.Clear )
  {} .Permit( TDataTrigger.Fetch, TDataState.Fetching );

  FState.Configure( TDataState.Fetching )
  {} .SubstateOf( TDataState.Busy )
  {} .OnEntry( FetchData )
  {} .Permit( TDataTrigger.Clear, TDataState.Cancelling )
  {} .Permit( TDataTrigger.Cancel, TDataState.Cancelling )
  {} .Permit( TDataTrigger.Fetch, TDataState.Refetching )
  {} .Permit( TDataTrigger.Data, TDataState.HasData )
  {} .Permit( TDataTrigger.Error, TDataState.HasError );

  FState.Configure( TDataState.Cancelling )
  {} .SubstateOf( TDataState.Busy )
  {} .OnEntry( CancelFetch )
  {} .Ignore( TDataTrigger.Cancel )
  {} .Ignore( TDataTrigger.Clear )
  {} .Permit( TDataTrigger.Fetch, TDataState.Refetching )
  {} .Permit( TDataTrigger.Data, TDataState.Empty )
  {} .Permit( TDataTrigger.Error, TDataState.Empty );

  FState.Configure( TDataState.Refetching )
  {} .SubstateOf( TDataState.Busy )
  {} .OnEntry( CancelFetch )
  {} .Ignore( TDataTrigger.Fetch )
  {} .Permit( TDataTrigger.Cancel, TDataState.Cancelling )
  {} .Permit( TDataTrigger.Clear, TDataState.Cancelling )
  {} .Permit( TDataTrigger.Data, TDataState.Fetching )
  {} .Permit( TDataTrigger.Error, TDataState.Fetching );

  FState.Configure( TDataState.Fetched )
  {} .Permit( TDataTrigger.Fetch, TDataState.Fetching )
  {} .Permit( TDataTrigger.Clear, TDataState.Empty );

  FState.Configure( TDataState.HasData )
  {} .SubstateOf( TDataState.Fetched );

  FState.Configure( TDataState.HasError )
  {} .SubstateOf( TDataState.Fetched );
end;

constructor TDataContainer<TSource, TResult>.Create( DataAccessor: TFunc<TSource, TResult> );
begin
  inherited Create;
  FDataAccessor := DataAccessor;
  ConfigureSM;
end;

destructor TDataContainer<TSource, TResult>.Destroy;
begin
  FState.Free;
  inherited;
end;

procedure TDataContainer<TSource, TResult>.FetchData;
var
  lSource: TSource;
begin
  lSource   := FSource;
  FDataTask := TTask.Run(
    procedure
    var
      lValue: TResult;
      lTrigger: TDataTrigger;
    begin
      try
        lValue := FDataAccessor( lSource );
        FValue := lValue;
        lTrigger := TDataTrigger.Data;
      except
        lTrigger := TDataTrigger.Error;
      end;

      TMonitor.Enter( FState );
      try
        FState.Fire( lTrigger );
        FDataTask := nil;
      finally
        TMonitor.Exit( FState );
      end;
    end );
end;

function TDataContainer<TSource, TResult>.GetHasValue: Boolean;
begin
  Result := FState.IsInState( TDataState.HasData );
end;

function TDataContainer<TSource, TResult>.GetIsBusy: Boolean;
begin
  TMonitor.Enter( FState );
  try
    Result := FState.IsInState( TDataState.Busy );
  finally
    TMonitor.Exit( FState );
  end;
end;

function TDataContainer<TSource, TResult>.GetValue: TResult;
begin
  TMonitor.Enter( FState );
  try
    if not HasValue
    then
      raise EInvalidOperation.Create( 'Fehlermeldung' );
  finally
    TMonitor.Exit( FState );
  end;
  Result := FValue
end;

procedure TDataContainer<TSource, TResult>.SetSource( const Value: TSource );
begin
  FSource := Value;
  TMonitor.Enter( FState );
  try
    FState.Fire( TDataTrigger.Fetch );
  finally
    TMonitor.Exit( FState );
  end;
end;

function TDataContainer<TSource, TResult>.ToString: string;
begin
  TMonitor.Enter( FState );
  try
    Result := FState.ToString;
  finally
    TMonitor.Exit( FState );
  end;
end;

end.