unit Bcl.Json.ElementConverter;

{$I Bcl.Inc}

interface

uses
  Rtti, SysUtils,
  Bcl.Json.Classes,
  Bcl.Json.Converters,
  Bcl.Json.Reader,
  Bcl.Json.Writer;

type
  TJsonElementConverterFactory = class;

  TJsonElementConverter = class(TInterfacedObject, IJsonTypeConverter)
  strict private
    {$IFDEF AUTOREFCOUNT} [Weak] {$ENDIF}
    FConverters: TJsonConverters;
    function ReadObject(Reader: TJsonReader): TJObject;
    function ReadArray(Reader: TJsonReader): TJArray;
    function ReadElement(Reader: TJsonReader): TJElement;
  strict private
    procedure WriteObject(Writer: TJsonWriter; Element: TJObject);
    procedure WriteArray(Writer: TJsonWriter; Element: TJArray);
    procedure WriteElement(Writer: TJsonWriter; Element: TJElement);
  strict protected
    procedure WriteJson(const Writer: TJsonWriter; const Element: TValue);
    procedure ReadJson(const Reader: TJsonReader; var Element: TValue);
  public
    constructor Create(AConverters: TJsonConverters);
  end;

  TJsonElementConverterFactory = class(TInterfacedObject, IJsonConverterFactory)
  strict protected
    function CreateConverter(Converters: TJsonConverters; const ATypeToken: TTypeToken): IJsonTypeConverter;
  end;

  EJsonElementConverterException = class(Exception)
  public
    constructor Create;
  end;

implementation

{ EJsonElementConverterException }

constructor EJsonElementConverterException.Create;
begin
  inherited Create('Cannot convert TJElement.');
end;

{ TJsonElementConverter }

constructor TJsonElementConverter.Create(AConverters: TJsonConverters);
begin
  FConverters := AConverters;
end;

function TJsonElementConverter.ReadArray(Reader: TJsonReader): TJArray;
begin
  Result := TJArray.Create;
  try
    Reader.ReadBeginArray;
    while Reader.HasNext do
      Result.Add(ReadElement(Reader));
    Reader.ReadEndArray;
  except
    Result.Free;
    raise;
  end;
end;

function TJsonElementConverter.ReadElement(Reader: TJsonReader): TJElement;
begin
  case Reader.Peek of
    TJsonToken.BeginObject:
      Result := ReadObject(Reader);
    TJsonToken.BeginArray:
      Result := ReadArray(Reader);
    TJsonToken.Text:
      Result := TJPrimitive.Create(Reader.ReadString);
    TJsonToken.Boolean:
      Result := TJPrimitive.Create(Reader.ReadBoolean);
    TJsonToken.Null:
      begin
        Reader.ReadNull;
        Result := TJNull.Create;
      end;
    TJsonToken.Number:
      if Reader.IsFloat then
        Result := TJPrimitive.Create(Reader.ReadDouble)
      else
        Result := TJPrimitive.Create(Reader.ReadInt64);
  else
    raise EJsonElementConverterException.Create;
  end;
end;

function TJsonElementConverter.ReadObject(Reader: TJsonReader): TJObject;
var
  Name: string;
begin
  Result := TJObject.Create;
  try
    Reader.ReadBeginObject;
    while Reader.HasNext do
    begin
      Name := Reader.ReadName;
      Result.Add(Name, ReadElement(Reader));
    end;
    Reader.ReadEndObject;
  except
    Result.Free;
    raise;
  end;
end;

procedure TJsonElementConverter.ReadJson(const Reader: TJsonReader; var Element: TValue);
begin
  Element := ReadElement(Reader);
  FConverters.ObjectCreated(Element.AsObject);
end;

procedure TJsonElementConverter.WriteJson(const Writer: TJsonWriter; const Element: TValue);
begin
  WriteElement(Writer, Element.AsType<TJElement>);
end;

procedure TJsonElementConverter.WriteArray(Writer: TJsonWriter;
  Element: TJArray);
var
  I: Integer;
begin
  Writer.WriteBeginArray;
  for I := 0 to Element.Count - 1 do
    WriteElement(Writer, Element.Items[I]);
  Writer.WriteEndArray;
end;

procedure TJsonElementConverter.WriteElement(Writer: TJsonWriter;
  Element: TJElement);
begin
  if (Element = nil) or Element.IsNull then
    Writer.WriteNull
  else
  if Element.IsPrimitive then
  begin
    if Element.IsDouble then
      Writer.WriteDouble(Element.AsDouble)
    else
    if Element.IsInt64 then
      Writer.WriteInteger(Element.AsInt64)
    else
    if Element.IsInteger then
      Writer.WriteInteger(Element.AsInteger)
    else
    if Element.IsBoolean then
      Writer.WriteBoolean(Element.AsBoolean)
    else
      Writer.WriteString(Element.AsString);
  end
  else
  if Element.IsArray then
    WriteArray(Writer, Element.AsArray)
  else
  if Element.IsObject then
    WriteObject(Writer, Element.AsObject)
  else
    raise EJsonElementConverterException.Create;
end;

procedure TJsonElementConverter.WriteObject(Writer: TJsonWriter;
  Element: TJObject);
var
  Member: TJMember;
begin
  Writer.WriteBeginObject;
  for Member in Element do
  begin
    Writer.WriteName(Member.Name);
    WriteElement(Writer, Member.Value);
  end;
  Writer.WriteEndObject;
end;

{ TJsonElementConverterFactory }

function TJsonElementConverterFactory.CreateConverter(Converters: TJsonConverters;
  const ATypeToken: TTypeToken): IJsonTypeConverter;
begin
  if ATypeToken.IsClass and ATypeToken.GetClass.InheritsFrom(TJElement) then
    Result := TJsonElementConverter.Create(Converters)
  else
    Result := nil;
end;

end.
