unit XData.Web.JsonDataset;

interface

uses
  JS, DB, Classes, SysUtils, JsonDataset;

type
  TJSONFieldMapper = JsonDataset.TJSONFieldMapper;
//  TJSONObjectFieldMapper = JsonDataset.TJSONObjectFieldMapper;

  TXDataObjectFieldMapper = class(TJSONObjectFieldMapper)
  private
    function GetPropValue(APropName: string; Obj: TJSObject): JSValue;
  public
    procedure SetJSONDataForField(const FieldName: string; FieldIndex: Integer; Row, Data: JSValue); override;
    function GetJSONDataForField(const FieldName: string; FieldIndex: Integer; Row: JSValue): JSValue; override;
  end;

  TXDataWebEntityField = class(TVariantField)
  protected
    function GetAsString: string; override;
//    procedure SetAsString(const aValue: string); override;
//  protected
//    function GetAsVariant: Variant; override;
//    procedure SetVarValue(const Value: Variant); override;
//  public
//    property AsObject: TObject read GetAsObject write SetAsObject;
//    function AsEntity<T: class>: T;
  end;

  TXDataWebDatasetField = class(TVariantField)
  protected
    function GetAsString: string; override;
  end;

  TXDataWebCurrencyField = class(TFloatField)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Currency default True;
  end;

//  TXDataWebGuidField = class(TStringField)
//  end;

  EXDataDatasetException = class(Exception)
  end;

  TXDataJsonDataset = Class(TBaseJSONDataset)
  protected
    procedure MetaDataToFieldDefs; override;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
    function CreateFieldMapper: TJSONFieldMapper; override;
  public
    procedure SetJsonData(Data: JSValue);
    function ConvertToDateTime(AField: TField; AValue: JSValue; ARaiseException: Boolean): TDateTime; override;
    function ConvertDateTimeToNative(AField: TField; AValue: TDateTime): JSValue; override;
    property Indexes;
    property ActiveIndex;
  published
    // redeclared data set properties
//    property Active;
    property AfterApplyUpdates;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
  end;

implementation

uses
  DBConst,
  Bcl.Utils;

{ TXDataWebEntityField }

function TXDataWebEntityField.GetAsString: string;
var
  V: JSValue;
begin
  V := GetData;
  if IsObject(V) then
    Result := '[object]'
  else
  if JS.IsNull(V) or JS.IsUndefined(V) then
    Result := 'null'
  else
    Result := inherited GetAsString;
end;

{ TXDataObjectFieldMapper }

function TXDataObjectFieldMapper.GetJSONDataForField(const FieldName: string;
  FieldIndex: Integer; Row: JSValue): JSValue;
begin
  Result := GetPropValue(FieldName, TJSObject(Row));
//  Result:=TJSObject(Row).Properties[FieldName];
end;

procedure SplitProp(const AText: string; var AProp, ASubProp: string);
var
  p: integer;
begin
  p := Pos('.', AText);
  if p = 0 then
  begin
    AProp := AText;
    ASubProp := '';
  end else
  begin
    AProp := Copy(AText, 1, p - 1);
    ASubProp := Copy(AText, p + 1, MaxInt);
  end;
end;

function TXDataObjectFieldMapper.GetPropValue(APropName: string;
  Obj: TJSObject): JSValue;
var
  Value: JSValue;
  Prop, SubProp: string;
begin
  if Obj = nil then Exit(Null);
  SplitProp(APropName, Prop, SubProp);

//  // Special treatment for TCriteriaResult objects
//  if Obj is TCriteriaResult then
//  begin
//    CriteriaResult := TCriteriaResult(Obj);
//    if CriteriaResult.HasProp(Prop) and (SubProp = '') then
//      Exit(CriteriaResult.Values[Prop])
//    else
//      Exit(Null);
//  end;

  Value := Obj.Properties[Prop];
  if IsObject(Value) then
  begin
    if SubProp = '' then
      Result := Value
    else
      Result := GetPropValue(SubProp, TJSObject(Value));
  end
  else
  begin
    if SubProp = '' then
      Result := Value
    else
//      if IsEnumeration(Value.TypeInfo) and SameText(SubProp, EnumNameSufix) then
//        Result := GetEnumName(Value.TypeInfo, Value.AsOrdinal)
//      else
        Result := Null;
  end;
end;

procedure TXDataObjectFieldMapper.SetJSONDataForField(const FieldName: string;
  FieldIndex: Integer; Row, Data: JSValue);
begin
  inherited;

end;

{ TXDataJsonDataset }

function TXDataJsonDataset.ConvertDateTimeToNative(AField: TField; AValue: TDateTime): JSValue;
begin
  Result := TBclUtils.DateTimeToIso(AValue, False);
end;

function TXDataJsonDataset.ConvertToDateTime(AField: TField; AValue: JSValue;
  ARaiseException: Boolean): TDateTime;
begin
  Result := 0;
  if JS.IsString(AValue) then
  begin
    if not TBclUtils.TryIsoToDateTime(string(AValue), Result) and ARaiseException then
      Raise EConvertError.CreateFmt(SErrInvalidDateTime,[String(aValue)])
  end
  else
  if JS.IsNumber(AValue) then
    Result := TDateTime(AValue);
end;

function TXDataJsonDataset.CreateFieldMapper: TJSONFieldMapper;
begin
  Result := TXDataObjectFieldMapper.Create;
end;

function TXDataJsonDataset.GetFieldClass(FieldType: TFieldType): TFieldClass;
begin
  case FieldType of
    ftVariant: Result := TXDataWebEntityField;
    ftDataset: Result := TXDataWebDatasetField;
//    ftCurrency: Result := TXDataWebCurrencyField;
//    ftGuid: Result := TXDataWebGuidField;
  else
    result := inherited GetFieldClass(FieldType);
  end;
end;

procedure TXDataJsonDataset.MetaDataToFieldDefs;
begin
end;

procedure TXDataJsonDataset.SetJsonData(Data: JSValue);
var
  ArrayData: TJSArray;
begin
  if IsArray(Data) then
    ArrayData := TJSArray(Data)
  else
    ArrayData := TJSArray.new(Data);
  Rows := ArrayData;
end;

{ TXDataWebDatasetField }

function TXDataWebDatasetField.GetAsString: string;
var
  V: JSValue;
begin
  V := GetData;
  if IsArray(V) then
    Result := '[dataset]'
  else
  if JS.IsNull(V) or JS.IsUndefined(V) then
    Result := 'null'
  else
    Result := inherited GetAsString;
end;

{ TXDataWebCurrencyField }

constructor TXDataWebCurrencyField.Create(AOwner: TComponent);
begin
  inherited;
  Currency := True;
end;

end.
