unit ThreadingEx;

interface

uses
  SysUtils,
  Threading;

type
  TAction<T> = reference to procedure(const arg: T);
  TAction2<T> = reference to procedure(const taskStatus:TTaskStatus; const arg: T);

  TTaskContinuationOptions = (
    NotOnCompleted,
    NotOnFaulted,
    NotOnCanceled,
    OnlyOnCompleted,
    OnlyOnFaulted,
    OnlyOnCanceled
  );

  TTaskContinuationOptionsSet = set of TTaskContinuationOptions;

  ITaskEx = interface(ITask)
    ['{3AE1A614-27AA-4B5A-BC50-42483650E20D}']
    function GetExceptObj: Exception;
    function GetStatus: TTaskStatus;
    function ContinueWith(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;
    function ContinueWithGui(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;
    function ContinueWithGui2(continuationOptions: TTaskContinuationOptionsSet;
    const continuationAction: TAction2<ITaskEx>): ITaskEx;
    property ExceptObj: Exception read GetExceptObj;
    property Status: TTaskStatus read GetStatus;
  end;

  TTaskEx = class(TTask, ITaskEx)
  private
    fExceptObj: Exception;
    function GetExceptObj: Exception;
    function InternalContinueWith(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions;
      invokeInMainThread: Boolean): ITaskEx;
    function InternalContinueWith2(continuationOptions: TTaskContinuationOptionsSet; const continuationAction: TAction2<ITaskEx>;
      invokeInMainThread: Boolean): ITaskEx;

  protected
    function ContinueWith(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;
    function ContinueWithGui(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;
    function ContinueWithGui2(continuationOptions: TTaskContinuationOptionsSet;
      const continuationAction: TAction2<ITaskEx>): ITaskEx;
  public
    destructor Destroy; override;
    class function Run(const action: TProc): ITaskEx; static;
  end;

implementation

uses
  Classes;

{ TTaskEx }

function TTaskEx.ContinueWith(const continuationAction: TAction<ITaskEx>;
  continuationOptions: TTaskContinuationOptions): ITaskEx;
begin
  Result := InternalContinueWith(continuationAction, continuationOptions, False);
end;

function TTaskEx.ContinueWithGui(const continuationAction: TAction<ITaskEx>;
  continuationOptions: TTaskContinuationOptions): ITaskEx;
begin
  Result := InternalContinueWith(continuationAction, continuationOptions, True);
end;

function TTaskEx.ContinueWithGui2(
  continuationOptions: TTaskContinuationOptionsSet;
  const continuationAction: TAction2<ITaskEx>): ITaskEx;
begin
  Result := InternalContinueWith2(continuationOptions, continuationAction, True);
end;

destructor TTaskEx.Destroy;
begin
  fExceptObj.Free;
  inherited;
end;

function TTaskEx.GetExceptObj: Exception;
begin
  if (fExceptObj is EAggregateException)
    and (EAggregateException(fExceptObj).Count = 1) then
    Result := EAggregateException(fExceptObj)[0]
  else
    Result := fExceptObj;
end;

function TTaskEx.InternalContinueWith(
  const continuationAction: TAction<ITaskEx>;
  continuationOptions: TTaskContinuationOptions;
  invokeInMainThread: Boolean): ITaskEx;
begin
  Result := TTaskEx.Run(
    procedure
    var
      task: ITaskEx;
      doContinue: Boolean;
    begin
      task := Self;
      if not IsComplete then
        DoneEvent.WaitFor;
      fExceptObj := GetExceptionObject;
      case continuationOptions of
        NotOnCompleted:  doContinue := GetStatus <> TTaskStatus.Completed;
        NotOnFaulted:    doContinue := GetStatus <> TTaskStatus.Exception;
        NotOnCanceled:   doContinue := GetStatus <> TTaskStatus.Canceled;
        OnlyOnCompleted: doContinue := GetStatus = TTaskStatus.Completed;
        OnlyOnFaulted:   doContinue := GetStatus = TTaskStatus.Exception;
        OnlyOnCanceled:  doContinue := GetStatus = TTaskStatus.Canceled;
      else
        doContinue := False;
      end;
      if doContinue then
        if invokeInMainThread then
          TThread.Queue(nil,
            procedure
            begin
              continuationAction(task);
            end)
        else
          continuationAction(task);
    end);
end;

function TTaskEx.InternalContinueWith2(
  continuationOptions: TTaskContinuationOptionsSet;
  const continuationAction: TAction2<ITaskEx>;
  invokeInMainThread: Boolean): ITaskEx;
begin
  Result := TTaskEx.Run(
  procedure
  var
    task: ITaskEx;
    doContinue: Boolean;
  begin
    task := Self;
    if not IsComplete then
      DoneEvent.WaitFor;
    fExceptObj := GetExceptionObject;
    doContinue := ((NotOnCompleted in continuationOptions) and (GetStatus <> TTaskStatus.Completed)) or
                  ((NotOnFaulted in continuationOptions) and (GetStatus <> TTaskStatus.Exception)) or
                  ((NotOnCanceled in continuationOptions) and (GetStatus <> TTaskStatus.Canceled)) or
                  ((OnlyOnCompleted in continuationOptions) and (GetStatus = TTaskStatus.Completed)) or
                  ((OnlyOnFaulted in continuationOptions) and (GetStatus = TTaskStatus.Exception)) or
                  ((OnlyOnCanceled in continuationOptions) and (GetStatus = TTaskStatus.Canceled));
    if doContinue then
      if invokeInMainThread then
        TThread.Queue(nil,
          procedure
          begin
            continuationAction(GetStatus, task);
          end)
      else
        continuationAction(GetStatus, task);
  end);
end;

class function TTaskEx.Run(const action: TProc): ITaskEx;
var
  task: TTaskEx;
begin
  task := TTaskEx.Create(nil, TNotifyEvent(nil), action, TThreadPool.Default, nil);
  Result := task.Start as ITaskEx;
end;


end.