unit Bcl.Json.Classes;

{$I bcl.inc}

interface

uses
  Generics.Collections, SysUtils, TypInfo, Types,
  {$IFDEF DELPHIXE6_LVL}System.Json,{$ENDIF}
  Rtti;


type
  TJArray = class;
  TJObject = class;
  TJPrimitive = class;
  TJNull = class;

  TJElement = class
  public
    function IsArray: Boolean;
    function IsObject: Boolean;
    function IsPrimitive: Boolean;
    function IsNull: Boolean;

    function AsArray: TJArray;
    function AsObject: TJObject;
    function AsPrimitive: TJPrimitive;
    function AsNull: TJNull;

    function AsBoolean: Boolean; virtual;
    function AsString: string; virtual;
    function AsDouble: Double; virtual;
    function AsInteger: Integer; virtual;
    function AsInt64: Int64; virtual;

    function IsBoolean: Boolean; virtual;
    function IsString: Boolean; virtual;
    function IsDouble: Boolean; virtual;
    function IsInteger: Boolean; virtual;
    function IsInt64: Boolean; virtual;
  public
    {$IFDEF DELPHIXE6_LVL}
    function ToJSONValue: TJSONValue;
    class function FromJSONValue(Value: TJSONValue): TJElement;
    {$ENDIF}
  end;

  TJArray = class(TJElement)
  strict private
    FItems: TList<TJElement>;
    procedure SetItem(const Index: Integer; Value: TJElement);
    function GetItem(const Index: Integer): TJElement;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  public
    procedure Add(Value: TJElement); overload;
    procedure Add(const Value: string); overload;
    procedure Add(const Value: Integer); overload;
    procedure Add(const Value: Int64); overload;
    procedure Add(const Value: Double); overload;
    procedure Add(const Value: Boolean); overload;
    procedure Delete(Index: Integer);
    function GetEnumerator: TEnumerator<TJElement>;
    property Count: Integer read GetCount;
    property Items[const Index: Integer]: TJElement read GetItem write SetItem; default;
  public
    { JavaScript compatibility methods}
    property Length: Integer read GetCount;
  end;

  TJMember = class
  private
    FName: string;
    FValue: TJElement;
  public
    constructor Create(const AName: string; AValue: TJElement);
    destructor Destroy; override;
    property Name: string read FName;
    property Value: TJElement read FValue;
  end;

  TJMemberList = class(TObjectList<TJMember>)
//  protected
//    procedure Notify(const Item: TJMember; Action: TCollectionNotification); override;
  end;

  TJObject = class(TJElement)
  strict private
    function IndexOf(const Name: string): Integer;
  private
    FMembers: TJMemberList;
  public
    constructor Create;
    destructor Destroy; override;
  public
    procedure Add(const Name: string; Value: TJElement); overload;
    procedure Add(const Name: string; const Value: string); overload;
    procedure Add(const Name: string; const Value: Integer); overload;
    procedure Add(const Name: string; const Value: Int64); overload;
    procedure Add(const Name: string; const Value: Double); overload;
    procedure Add(const Name: string; const Value: Boolean); overload;
    procedure Remove(const Name: string);
    function Get(const Name: string): TJElement;
    function Contains(const Name: string): Boolean;
    function GetEnumerator: TEnumerator<TJMember>;
    property Members[const Name: string]: TJElement read Get write Add; default;
  public
    { JavaScript compatibility methods}
    function hasOwnProperty(const Name: string): Boolean;
    class function keys(const obj: TJObject): TStringDynArray;
  end;

  TJPrimitive = class(TJElement)
  strict private
    FValue: TValue;
    procedure SetValue(const Value: TValue);
  public
    constructor Create(const Value: Boolean); overload;
    constructor Create(const Value: Double); overload;
    constructor Create(const Value: Integer); overload;
    constructor Create(const Value: Int64); overload;
    constructor Create(const Value: string); overload;
  public
    function AsBoolean: Boolean; override;
    function AsString: string; override;
    function AsDouble: Double; override;
    function AsInteger: Integer; override;
    function AsInt64: Int64; override;

    function IsBoolean: Boolean; override;
    function IsString: Boolean; override;
    function IsDouble: Boolean; override;
    function IsInteger: Boolean; override;
    function IsInt64: Boolean; override;
  end;

  TJNull = class(TJElement)
  end;

  EInvalidJsonCast = class(Exception)
  public
    constructor Create(AElement: TJElement; ATypeInfo: PTypeInfo);
  end;

implementation

{$IFDEF DELPHIXE6_LVL}
function TJElement.ToJSONValue: TJSONValue;
var
  Item: TJElement;
  Member: TJMember;
begin
  if IsArray then
  begin
    Result := TJSONArray.Create;
    for Item in AsArray do
      TJSONArray(Result).AddElement(Item.ToJSONValue);
  end
  else
  if IsObject then
  begin
    Result := TJSONObject.Create;
    for Member in AsObject do
      TJSONObject(Result).AddPair(Member.Name, Member.Value.ToJSONValue);
  end
  else
  if IsNull then
    Result := TJSONNull.Create
  else
  if IsBoolean then
  begin
    if AsBoolean then
      Result := TJSONTrue.Create
    else
      Result := TJSONFalse.Create;
  end
  else
  if IsDouble then
    Result := TJSONNumber.Create(AsDouble)
  else
  if IsInteger then
    Result := TJSONNumber.Create(AsInteger)
  else
  if IsInt64 then
    Result := TJSONNumber.Create(AsInt64)
  else
    Result := TJSONString.Create(AsString);
end;
{$ENDIF}

{$IFDEF DELPHIXE6_LVL}
class function TJElement.FromJSONValue(Value: TJSONValue): TJElement;
var
  JSONNumber: TJSONNumber;
  I: Integer;
begin
  if (Value = nil) or (Value is TJSONNull) then
    Result := TJNull.Create
  else
  if Value is TJSONNumber then
  begin
    JSONNumber := TJSONNumber(Value);
    if Pos('.', JSONNumber.ToString) > 0 then
      Result := TJPrimitive.Create(JSONNumber.AsDouble)
    else
      Result := TJPrimitive.Create(JSONNumber.AsInt64);
  end
  else
  if Value is TJSONString then
    Result := TJPrimitive.Create(TJSONString(Value).Value)
  else
  if Value is TJSONTrue then
    Result := TJPrimitive.Create(True)
  else
  if Value is TJSONFalse then
    Result := TJPrimitive.Create(False)
  else
  if Value is TJSONArray then
  begin
    Result := TJArray.Create;
    for I := 0 to TJSONArray(Value).Count - 1 do
      Result.AsArray.Add(TJElement.FromJSONValue(TJSONArray(Value).Items[I]));
  end
  else
  if Value is TJSONObject then
  begin
    Result := TJObject.Create;
    for I := 0 to TJSONObject(Value).Count - 1 do
      Result.AsObject.Add(
        TJSONObject(Value).Pairs[I].JsonString.Value,
        TJElement.FromJSONValue(TJSONObject(Value).Pairs[I].JsonValue)
      );
  end
  else
    Result := nil;
end;
{$ENDIF}

{ TJElement }

function TJElement.AsBoolean: Boolean;
begin
  raise EInvalidJsonCast.Create(Self, TypeInfo(Boolean));
end;

function TJElement.AsDouble: Double;
begin
  raise EInvalidJsonCast.Create(Self, TypeInfo(Double));
end;

function TJElement.AsInt64: Int64;
begin
  raise EInvalidJsonCast.Create(Self, TypeInfo(Int64));
end;

function TJElement.AsInteger: Integer;
begin
  raise EInvalidJsonCast.Create(Self, TypeInfo(Integer));
end;

function TJElement.AsArray: TJArray;
begin
  if IsArray then
    Result := TJArray(Self)
  else
    raise EInvalidJsonCast.Create(Self, TypeInfo(TJArray));
end;

function TJElement.AsNull: TJNull;
begin
  if IsNull then
    Result := TJNull(Self)
  else
    raise EInvalidJsonCast.Create(Self, TypeInfo(TJNull));
end;

function TJElement.AsObject: TJObject;
begin
  if IsObject then
    Result := TJObject(Self)
  else
    raise EInvalidJsonCast.Create(Self, TypeInfo(TJObject));
end;

function TJElement.AsPrimitive: TJPrimitive;
begin
  if IsPrimitive then
    Result := TJPrimitive(Self)
  else
    raise EInvalidJsonCast.Create(Self, TypeInfo(TJPrimitive));
end;

function TJElement.AsString: string;
begin
  raise EInvalidJsonCast.Create(Self, TypeInfo(string));
end;

function TJElement.IsBoolean: Boolean;
begin
  Result := False;
end;

function TJElement.IsDouble: Boolean;
begin
  Result := False;
end;

function TJElement.IsInt64: Boolean;
begin
  Result := False;
end;

function TJElement.IsInteger: Boolean;
begin
  Result := False;
end;

function TJElement.IsArray: Boolean;
begin
  Result := Self is TJArray;
end;

function TJElement.IsNull: Boolean;
begin
  Result := Self is TJNull;
end;

function TJElement.IsObject: Boolean;
begin
  Result := Self is TJObject;
end;

function TJElement.IsPrimitive: Boolean;
begin
  Result := Self is TJPrimitive;
end;

function TJElement.IsString: Boolean;
begin
  Result := False;
end;

{ EInvalidJsonCast }

constructor EInvalidJsonCast.Create(AElement: TJElement; ATypeInfo: PTypeInfo);
begin
  inherited CreateFmt('JSON: Cannot read %s as a %s value',
    [AElement.ClassName, GetTypeName(ATypeInfo)]);
end;

{ TJPrimitive }

constructor TJPrimitive.Create(const Value: Double);
begin
  SetValue(Value);
end;

constructor TJPrimitive.Create(const Value: Boolean);
begin
  SetValue(Value);
end;

constructor TJPrimitive.Create(const Value: Integer);
begin
  SetValue(Value);
end;

function TJPrimitive.AsBoolean: Boolean;
begin
  if not FValue.TryAsType<Boolean>(Result) then
    Result := StrToBool(AsString);
end;

function TJPrimitive.AsDouble: Double;
begin
  if not FValue.TryAsType<Double>(Result) then
    Result := StrToFloat(AsString);
end;

function TJPrimitive.AsInt64: Int64;
begin
  if not FValue.TryAsType<Int64>(Result) then
    Result := StrToInt64(AsString);
end;

function TJPrimitive.AsInteger: Integer;
begin
  if not FValue.TryAsType<Integer>(Result) then
    Result := StrToInt(AsString);
end;

function TJPrimitive.AsString: string;
begin
  Result := FValue.ToString;
end;

constructor TJPrimitive.Create(const Value: string);
begin
  SetValue(Value);
end;

function TJPrimitive.IsBoolean: Boolean;
begin
  Result := FValue.IsType<Boolean>;
end;

function TJPrimitive.IsDouble: Boolean;
begin
  Result := FValue.IsType<Double>;
end;

function TJPrimitive.IsInt64: Boolean;
begin
  Result := FValue.IsType<Int64>;
end;

function TJPrimitive.IsInteger: Boolean;
begin
  Result := FValue.IsType<Integer>;
end;

function TJPrimitive.IsString: Boolean;
begin
  Result := FValue.IsType<string>;
end;

procedure TJPrimitive.SetValue(const Value: TValue);
begin
  FValue := Value;
end;

constructor TJPrimitive.Create(const Value: Int64);
begin
  SetValue(Value);
end;

{ TJObject }

procedure TJObject.Add(const Name: string; Value: TJElement);
var
  Member: TJMember;
  I: Integer;
begin
  I := IndexOf(Name);
  if Value = nil then
    Value := TJNull.Create;
  Member := TJMember.Create(Name, Value);
  if I >= 0 then
    FMembers[I] := Member
  else
    FMembers.Add(Member);
end;

procedure TJObject.Add(const Name: string; const Value: Integer);
begin
  Add(Name, TJPrimitive.Create(Value));
end;

procedure TJObject.Add(const Name, Value: string);
begin
  Add(Name, TJPrimitive.Create(Value));
end;

procedure TJObject.Add(const Name: string; const Value: Int64);
begin
  Add(Name, TJPrimitive.Create(Value));
end;

procedure TJObject.Add(const Name: string; const Value: Boolean);
begin
  Add(Name, TJPrimitive.Create(Value));
end;

procedure TJObject.Add(const Name: string; const Value: Double);
begin
  Add(Name, TJPrimitive.Create(Value));
end;

constructor TJObject.Create;
begin
  FMembers := TJMemberList.Create;
end;

destructor TJObject.Destroy;
begin
  FMembers.Free;
  inherited;
end;

function TJObject.Get(const Name: string): TJElement;
var
  I: Integer;
begin
  I := IndexOf(Name);
  if I >= 0 then
    Result := FMembers[I].Value
  else
    Result := nil;
end;

function TJObject.GetEnumerator: TEnumerator<TJMember>;
begin
  Result := FMembers.GetEnumerator;
end;

function TJObject.hasOwnProperty(const Name: string): Boolean;
begin
  Result := Contains(Name);
end;

function TJObject.Contains(const Name: string): Boolean;
begin
  Result := IndexOf(Name) >= 0;
end;

function TJObject.IndexOf(const Name: string): Integer;
var
  I: Integer;
begin
  for I := 0 to FMembers.Count - 1 do
    if FMembers[I].Name = Name then
      Exit(I);
  Result := -1;
end;

class function TJObject.keys(const obj: TJObject): TStringDynArray;
var
  I: Integer;
begin
  SetLength(Result, obj.FMembers.Count);
  for I := 0 to obj.FMembers.Count - 1 do
    Result[I] := obj.FMembers[I].Name;
end;

procedure TJObject.Remove(const Name: string);
var
  I: Integer;
begin
  I := IndexOf(Name);
  if I >= 0 then
    FMembers.Delete(I);
end;

{ TJArray }

procedure TJArray.Add(const Value: Integer);
begin
  Add(TJPrimitive.Create(Value));
end;

procedure TJArray.Add(const Value: string);
begin
  Add(TJPrimitive.Create(Value));
end;

procedure TJArray.Add(Value: TJElement);
begin
  if Value = nil then
    Value := TJNull.Create;
  FItems.Add(Value);
end;

procedure TJArray.Add(const Value: Int64);
begin
  Add(TJPrimitive.Create(Value));
end;

procedure TJArray.Add(const Value: Boolean);
begin
  Add(TJPrimitive.Create(Value));
end;

procedure TJArray.Add(const Value: Double);
begin
  Add(TJPrimitive.Create(Value));
end;

constructor TJArray.Create;
begin
  FItems := TObjectList<TJElement>.Create(True);
end;

procedure TJArray.Delete(Index: Integer);
begin
  FItems.Delete(Index);
end;

destructor TJArray.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TJArray.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TJArray.GetEnumerator: TEnumerator<TJElement>;
begin
  Result := FItems.GetEnumerator;
end;

function TJArray.GetItem(const Index: Integer): TJElement;
begin
  Result := FItems[Index];
end;

procedure TJArray.SetItem(const Index: Integer; Value: TJElement);
begin
  FItems[Index] := Value;
end;

{ TJMember }

constructor TJMember.Create(const AName: string; AValue: TJElement);
begin
  FName := AName;
  FValue := AValue;
end;

destructor TJMember.Destroy;
begin
  FValue.Free;
  inherited;
end;

end.
