unit XData.Dataset.Source;

interface

uses
  Generics.Collections, SysUtils,
  Bcl.Collections,
  Aurelius.Bind.BaseDataset,
  XData.Query,
  XData.Client;

type
  TObjectProc = reference to procedure(Obj: TObject);
  TFetchPageProc = reference to procedure(Top, Skip: Integer; Proc: TObjectProc);
  TFetchCountProc = reference to function: Integer;

  TGenericObjectSource = class(TObjectSource)
  strict private
    FClass: TClass;
    FRemainingRows: integer;
    FCurrentFirstRow: integer;
    FPageSize: integer;
    FEOF: Boolean;
    FFetchPage: TFetchPageProc;
    FFetchCount: TFetchCountProc;
  public
    constructor Create(AClass: TClass; AFetchPage: TFetchPageProc; APageSize: Integer = 0); overload;
    constructor Create(AClass: TClass; AFetchPage: TFetchPageProc;
      AFetchCount: TFetchCountProc; APageSize: Integer = 0); overload;
  public
    function FetchMore(AList: IObjectList): Boolean; override;
    function Fetching: Boolean; override;
    function ObjectClass: TClass; override;
    function CanRetrieveRecordCount: Boolean; override;
    function RetrieveRecordCount: Integer; override;
  end;

  TXDataObjectSource = class(TObjectSource)
  strict private
    FClient: TXDataClient;
    FClass: TClass;
    FBaseQuery: string;
    FEOF: Boolean;
  strict private
    FRemainingRows: integer;
    FCurrentFirstRow: integer;
    FPageSize: integer;
    procedure AddQueryParam(var S: string; const Param: string; Value: Integer);
  public
    constructor Create(AClient: TXDataClient; AClass: TClass; const AQuery: string = '';
      APageSize: Integer = 0);
    destructor Destroy; override;
  public
    function FetchMore(AList: IObjectList): Boolean; override;
    function Fetching: Boolean; override;
    function ObjectClass: TClass; override;
    function CanRetrieveRecordCount: Boolean; override;
    function RetrieveRecordCount: Integer; override;
  end;

implementation

{ TXDataObjectSource }

procedure TXDataObjectSource.AddQueryParam(var S: string; const Param: string;
  Value: Integer);
begin
  if S > '' then
    S := S + '&';
  S := S + Param + '=' + IntToStr(Value);
end;

function TXDataObjectSource.CanRetrieveRecordCount: Boolean;
begin
  Result := True;
end;

constructor TXDataObjectSource.Create(AClient: TXDataClient; AClass: TClass;
  const AQuery: string; APageSize: Integer);
begin
  inherited Create;
  FClient := AClient;
  FClass := AClass;
  FBaseQuery := AQuery;
  if FRemainingRows <= 0 then
    FRemainingRows := MaxInt;

  FCurrentFirstRow := 0;
  FPageSize := APageSize;
end;

destructor TXDataObjectSource.Destroy;
begin
  inherited;
end;

function TXDataObjectSource.Fetching: Boolean;
begin
  Result := not FEOF;
end;

function TXDataObjectSource.FetchMore(AList: IObjectList): Boolean;
var
  Results: TList<TObject>;
  RowsToRead: integer;
  RowsRetrieved: integer;
  LocalQuery: string;
  Obj: TObject;
begin
  Result := False;
  LocalQuery := Self.FBaseQuery;

  // Fetch using paging
  if FCurrentFirstRow > 0 then
    AddQueryParam(LocalQuery, '$skip', FCurrentFirstRow);
  RowsToRead := MaxInt;
  if FPageSize > 0 then // if pagesize not specified, then retrieve all records
  begin
    if FPageSize > FRemainingRows then
      RowsToRead := FRemainingRows
    else
      RowsToRead := FPageSize;
    AddQueryParam(LocalQuery, '$top', RowsToRead);
  end;

  RowsRetrieved := 0;
  Results := FClient.List(FClass, LocalQuery);
  try
    for Obj in Results do
    begin
      AList.Add(Obj);
      Result := True;
      Dec(FRemainingRows);
      Inc(FCurrentFirstRow);
      Inc(RowsRetrieved);
    end;
  finally
    Results.Free;
  end;

  // Whenever we don't need more records, destroy the source criteria so we disable fetching records
  if (not Result) or (FPageSize <= 0) or (FRemainingRows = 0) or (RowsRetrieved < RowsToRead) then
  begin
    FEOF := True;
    Result := False;
  end;
end;

function TXDataObjectSource.ObjectClass: TClass;
begin
  Result := Self.FClass;
end;

function TXDataObjectSource.RetrieveRecordCount: Integer;
begin
  Result := FClient.Count(FClass, FBaseQuery);
end;

{ TGenericObjectSource }

function TGenericObjectSource.CanRetrieveRecordCount: Boolean;
begin
  Result := Assigned(FFetchCount);
end;

constructor TGenericObjectSource.Create(AClass: TClass; AFetchPage: TFetchPageProc; AFetchCount: TFetchCountProc;
  APageSize: Integer);
begin
  inherited Create;
  FClass := AClass;
  if FRemainingRows <= 0 then
    FRemainingRows := MaxInt;
  FCurrentFirstRow := 0;
  FPageSize := APageSize;
  FFetchPage := AFetchPage;
  FFetchCount := AFetchCount;
end;

constructor TGenericObjectSource.Create(AClass: TClass; AFetchPage: TFetchPageProc; APageSize: Integer);
begin
  Create(AClass, AFetchPage, nil, APageSize);
end;

function TGenericObjectSource.Fetching: Boolean;
begin
  Result := not FEOF;
end;

function TGenericObjectSource.FetchMore(AList: IObjectList): Boolean;
var
  RowsToRead: integer;
  RowsRetrieved: integer;
  Proc: TObjectProc;
  Skip, Top: Integer;
  HasObject: Boolean;
begin
  // define paging values
  Skip := 0;
  Top := 0;
  RowsToRead := MaxInt;
  if FPageSize > 0 then // if pagesize not specified, then retrieve all records
  begin
    if FPageSize > FRemainingRows then
      RowsToRead := FRemainingRows
    else
      RowsToRead := FPageSize;
    Top := RowsToRead;
    Skip := FCurrentFirstRow;
  end;

  // retrieve data and update paging
  HasObject := False;
  Proc := procedure(Obj: TObject)
    begin
      AList.Add(Obj);
      HasObject := True;
      Dec(FRemainingRows);
      Inc(FCurrentFirstRow);
      Inc(RowsRetrieved);
    end;

  RowsRetrieved := 0;
  FFetchPage(Top, Skip, Proc);
  Result := HasObject;

  // Whenever we don't need more records, destroy the source criteria so we disable fetching records
  if (not Result) or (FPageSize <= 0) or (FRemainingRows = 0) or (RowsRetrieved < RowsToRead) then
  begin
    FEOF := True;
    Result := False;
  end;
end;

function TGenericObjectSource.ObjectClass: TClass;
begin
  Result := Self.FClass;
end;

function TGenericObjectSource.RetrieveRecordCount: Integer;
begin
  Result := FFetchCount();
end;

end.
