unit XData.Web.Dataset;

interface

uses
  Classes, DB, SysUtils, Types,
  XData.Web.Client,
  XData.Web.Connection,
  XData.Web.DatasetCommon,
  XData.Web.JsonDataset,
  XData.Model.Classes, JS;

type
  TServerRecordCountMode = (smNone, smInlineCount);
  TProc = reference to procedure;

  TXDataWebDataSet = class(TXDataJsonDataset)
  private
    FEntitySetName: string;
    FConnection: TXDataWebConnection;
    FSubpropsDepth: Integer;
    FQueryString: string;
    FServerRecordCountMode: TServerRecordCountMode;
    FQuerySkip: Integer;
    FQueryTop: Integer;
    FServerRecordCount: Integer;
    FDesignLoad: Boolean;
    FEnumAsInteger: Boolean;
    procedure SetConnection(const Value: TXDataWebConnection);
    procedure CheckConnected;
    procedure CheckConnection;
    procedure CheckEntitySetName;
    procedure EnsureConnected(Proc: TProc);
    procedure SetEntitySetName(const Value: string);
    procedure SetSubpropsDepth(const Value: Integer);
    procedure SetDesignLoad(const Value: Boolean);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure InternalInitFieldDefs; override;
    procedure InitializeFieldDefinitions;
    function GetCurrentData: JSValue; virtual;
    procedure InternalClose; override;
  protected
    function DataPacketReceived(ARequest: TDataRequest): Boolean; override;
    function DoGetDataProxy: TDataProxy; override;
  public
    procedure Load; reintroduce;
    property CurrentData: JSValue read GetCurrentData;
    property ServerRecordCount: Integer read FServerRecordCount;
  published
    property DesignLoad: Boolean read FDesignLoad write SetDesignLoad;
    property EntitySetName: string read FEntitySetName write SetEntitySetName;
    property Connection: TXDataWebConnection read FConnection write SetConnection;
    property SubpropsDepth: Integer read FSubpropsDepth write SetSubpropsDepth default 0;
    property QueryString: string read FQueryString write FQueryString;
    property QueryTop: Integer read FQueryTop write FQueryTop default 0;
    property QuerySkip: Integer read FQuerySkip write FQuerySkip default 0;
    property ServerRecordCountMode: TServerRecordCountMode read FServerRecordCountMode write FServerRecordCountMode default smNone;
    property EnumAsInteger: Boolean read FEnumAsInteger write FEnumAsInteger default false;
  end;

  TXDataDataProxy = class(TDataProxy)
  private
    FDataset: TXDataWebDataSet;
    function GetConnection: TXDataWebConnection;
    procedure CheckBatchComplete(ABatch: TRecordUpdateBatch);
    function QueryToObject(const Query: string): TJSObject;
    function ObjectToQuery(Obj: TJSObject): string;
    function BuildQueryString: string;
  protected
    function GetUpdateDescriptorClass: TRecordUpdateDescriptorClass; override;
    function ProcessUpdateBatch(ABatch: TRecordUpdateBatch): Boolean; override;
  protected
    Function DoGetData(ARequest: TDataRequest): Boolean; override;
    Function GetDataRequest(aOptions: TLoadOptions;
      aAfterRequest: TDataRequestEvent; aAfterLoad: TDatasetLoadEvent)
      : TDataRequest; override;
  Public
    Constructor Create(AOwner: TComponent); override;
    Property Dataset: TXDataWebDataSet Read FDataset;
    property Connection: TXDataWebConnection read GetConnection;
  end;

  TXDataDataRequest = Class(TDataRequest)
  protected
    procedure OnSuccess(Resp: TXDataClientResponse); virtual;
  end;

  TXDataUpdateDescriptor = Class(TRecordUpdateDescriptor)
  Private
    FBatch: TRecordUpdateBatch;
    FApplying: Boolean;
  protected
    procedure OnLoad(Response: TXDataClientResponse); virtual;
    procedure OnError(Error: TXDataClientError); virtual;
  end;

implementation

{ TXDataDBRequest }

procedure TXDataDataRequest.OnSuccess(Resp: TXDataClientResponse);
begin
  if (Resp.StatusCode = 200) then
  begin
    TXDataDataProxy(DataProxy).FDataset.FServerRecordCount := Resp.Count;
    Data := Resp.Result;
    if isArray(Data) then
    begin
      if (TJSArray(Data).Length = 0) then
        Success := rrEOF
      else
        Success := rrOK;
    end
    else
    begin
      Success := rrFail;
      ErrorMsg := 'Result is not an array';
    end;
  end
  else
  begin
    TXDataDataProxy(DataProxy).FDataset.FServerRecordCount := 0;
    Data := nil;
    Success := rrFail;
    ErrorMsg := Resp.Response.StatusReason;
  end;
  DoAfterRequest;
end;

{ TXDataWebDataSet }

procedure TXDataWebDataSet.CheckConnected;
begin
  CheckConnection;
  if not Connection.Connected then
    DatabaseError('Connection not active');
end;

procedure TXDataWebDataSet.CheckConnection;
begin
  if Connection = nil then
    DatabaseError('Connection not assigned');
end;

procedure TXDataWebDataSet.CheckEntitySetName;
begin
  if EntitySetName = '' then
    DatabaseError('EntitySetName not specified.');
end;

function TXDataWebDataSet.DataPacketReceived(ARequest: TDataRequest): Boolean;
var
  A: TJSArray;
begin
  Result := False;
  If isNull(ARequest.Data) then
    exit;

  if isArray(ARequest.Data) then
    A := TJSArray(ARequest.Data)
  else
    DatabaseError('Cannot handle data packet');

  Result := A.Length > 0;
  AddToRows(A);
end;

function TXDataWebDataSet.DoGetDataProxy: TDataProxy;
begin
  Result := TXDataDataProxy.Create(Self);
end;

procedure TXDataWebDataSet.EnsureConnected(Proc: TProc);

  procedure Success;
  begin
    Proc();
  end;

begin
  CheckConnection;
  if Connection.Connected then
    Proc()
  else
    Connection.Open(@Success);
end;

function TXDataWebDataSet.GetCurrentData: JSValue;
begin
  Result := ActiveBuffer.Data;
end;

procedure TXDataWebDataSet.InitializeFieldDefinitions;
begin
  CheckConnected;
  CheckEntitySetName;
  InitFieldDefsFromEntityType(Self, Connection.Model.GetEntitySet(EntitySetName).EntityType,
    SubPropsDepth, not EnumAsInteger);
end;

procedure TXDataWebDataSet.InternalClose;
begin
  FServerRecordCount := 0;
  inherited;
end;

procedure TXDataWebDataSet.InternalInitFieldDefs;
begin
  FieldDefs.Clear;
  if not(csDesigning in ComponentState) and (FieldCount > 0) then
  begin
    InitFieldDefsFromFields;
    exit;
  end;

  InitializeFieldDefinitions;
end;

procedure TXDataWebDataSet.Load;

  procedure LocalExecute;
  begin
    inherited Load([], nil);
  end;

begin
  EnsureConnected(@LocalExecute);
end;

procedure TXDataWebDataSet.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FConnection) then
    Connection := nil;
end;

procedure TXDataWebDataSet.SetConnection(const Value: TXDataWebConnection);
begin
  if Value <> FConnection then
  begin
    Active := False;
    if FConnection <> nil then
      FConnection.RemoveFreeNotification(Self);
    FConnection := Value;
    if FConnection <> nil then
      FConnection.FreeNotification(Self);
    FieldDefs.Updated := False;
  end;
end;

procedure TXDataWebDataSet.SetDesignLoad(const Value: Boolean);
begin
  if Value <> FDesignLoad then
  begin
    FDesignLoad := Value;
    if Value then
      Load
    else
      Close;
  end;
end;

procedure TXDataWebDataSet.SetEntitySetName(const Value: string);
begin
  if FEntitySetName <> Value then
  begin
    FEntitySetName := Value;
    FieldDefs.Updated := False;
  end;
end;

procedure TXDataWebDataSet.SetSubpropsDepth(const Value: Integer);
begin
  if FSubpropsDepth <> Value then
  begin
    FSubpropsDepth := Value;
    FieldDefs.Updated := False;
  end;
end;

{ TXDataDatasetProxy }

function TXDataDataProxy.BuildQueryString: string;
var
  Query: TJSObject;
begin
  Query := QueryToObject(Self.FDataset.QueryString);
  if Self.FDataset.QueryTop <> 0 then
    Query['$top'] := IntToStr(Self.FDataset.QueryTop);
  if Self.FDataset.QuerySkip <> 0 then
    Query['$skip'] := IntToStr(Self.FDataset.QuerySkip);
  if Self.FDataset.ServerRecordCountMode = smInlineCount then
    Query['$inlinecount'] := 'allpages';
  Result := ObjectToQuery(Query);
end;

procedure TXDataDataProxy.CheckBatchComplete(ABatch: TRecordUpdateBatch);
Var
  BatchOK: Boolean;
  I: Integer;
begin
  BatchOK := True;
  I := ABatch.List.Count - 1;
  While BatchOK and (I >= 0) do
  begin
    BatchOK := ABatch.List[I].ResolveStatus in [rsResolved, rsResolveFailed];
    Dec(I);
  end;
  if BatchOK and Assigned(ABatch.OnResolve) then
    ABatch.OnResolve(Self, ABatch);
end;

constructor TXDataDataProxy.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);
  if AOwner is TXDataWebDataSet then
    FDataset := AOwner as TXDataWebDataSet
  else
    raise EXDataDatasetException.Create('Proxy created with invalid dataset');
end;

function TXDataDataProxy.DoGetData(ARequest: TDataRequest): Boolean;
var
  XClient: TXDataWebClient;
begin
  if not (loAtEof in ARequest.LoadOptions) then
  begin
    XClient := TXDataWebClient.Create(nil);
    XClient.Connection := Self.FDataset.Connection;
    XClient.List(Self.FDataset.EntitySetName, BuildQueryString,
      @TXDataDataRequest(ARequest).OnSuccess);
  end;

  Result := True; // not used by TDataset for now
end;

function TXDataDataProxy.GetConnection: TXDataWebConnection;
begin
  Result := FDataset.Connection;
end;

function TXDataDataProxy.GetDataRequest(aOptions: TLoadOptions;
  aAfterRequest: TDataRequestEvent; aAfterLoad: TDatasetLoadEvent)
  : TDataRequest;
begin
  Result := TXDataDataRequest.Create(Self, aOptions, aAfterRequest, aAfterLoad);
end;

function TXDataDataProxy.GetUpdateDescriptorClass: TRecordUpdateDescriptorClass;
begin
  Result := TXDataUpdateDescriptor;
end;

function TXDataDataProxy.ObjectToQuery(Obj: TJSObject): string;
var
  Key: string;
begin
  Result := '';
  for Key in TJSObject.keys(Obj) do
  begin
    if Result <> '' then
      Result := Result + '&';
    Result := Result + key + '=' + JS.ToString(Obj[key]);
  end;
end;

function TXDataDataProxy.ProcessUpdateBatch(ABatch: TRecordUpdateBatch): Boolean;
var
  R: TXDataUpdateDescriptor;
  I: Integer;
  XClient: TXDataWebClient;
  Entity: TJSObject;
begin
  I := 0;
  while I <= ABatch.List.Count - 1 do
  begin
    R := ABatch.List[I] as TXDataUpdateDescriptor;
    if R.FApplying then 
      ABatch.List.Delete(I)
    else
    begin
      Inc(I);
      R.FBatch := ABatch;
      R.FApplying := True;

      XClient := TXDataWebClient.Create(nil);
      XClient.Connection := Self.Connection;
      XClient.OnLoad := @R.OnLoad;
      XClient.OnError := @R.OnError;
      Entity := TJSObject(R.Data);
      Case R.Status of
        usInserted:
            XClient.Post(Dataset.EntitySetName, Entity);
        usModified:
            XClient.Put(Dataset.EntitySetName, Entity);
        usDeleted:
            XClient.Delete(Dataset.EntitySetName, Entity);
      end;
    end;
  end;
  Result := True;
end;

function TXDataDataProxy.QueryToObject(const Query: string): TJSObject;
var
  Params: TStringDynArray;
  P: Integer;
  I: Integer;
begin
  Result := TJSObject.new;
  Params := TJSString(Query).split('&');
  for I := 0 to Length(Params) - 1 do
  begin
    P := Pos('=', Params[I]);
    if P > 1 then
      Result[Copy(Params[I], 1, P - 1)] := Copy(Params[I], P + 1, MaxInt);
  end;
end;

{ TXDataUpdateRequest }

procedure TXDataUpdateDescriptor.OnError(Error: TXDataClientError);
begin
  ResolveFailed(Error.ErrorMessage);
  FApplying := False;
  (Proxy as TXDataDataProxy).CheckBatchComplete(FBatch);
end;

procedure TXDataUpdateDescriptor.onLoad(Response: TXDataClientResponse);
begin
  Resolve(Response.Result);
  FApplying := False;
  (Proxy as TXDataDataProxy).CheckBatchComplete(FBatch);
end;

end.
