unit Bcl.Json.Serializer;

{$I Bcl.Inc}

interface

uses
  Generics.Collections, Rtti, TypInfo, Classes, SysUtils,
  Bcl.Json.Converters,
  Bcl.Json.Writer;

type
  TJsonSerializer = class
  private
    FConverters: TJsonConverters;
    FWrittenObjects: TList<TObject>;
    FOwnsConverters: Boolean;
  protected
    procedure ObjectWritten(AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AConverters: TJsonConverters; AOwnsConverters: Boolean); overload;
    destructor Destroy; override;

    function Write(const Value: TValue): string; overload;
    function WriteAs<T>(const Value: T): string; overload;
    function Write(const Value: TValue; const TypeToken: TTypeToken): string; overload;

    procedure Write(const Value: TValue; Stream: TStream); overload;
    procedure WriteAs<T>(const Value: T; Stream: TStream); overload;
    procedure Write(const Value: TValue; const TypeToken: TTypeToken; Stream: TStream); overload;

    procedure Write(const Value: TValue; Writer: TJsonWriter); overload;
    procedure WriteAs<T>(const Value: T; Writer: TJsonWriter); overload;
    procedure Write(const Value: TValue; const TypeToken: TTypeToken; Writer: TJsonWriter); overload;

    function WrittenObjects: TEnumerable<TObject>;
    property Converters: TJsonConverters read FConverters;
  end;

implementation

{ TJsonSerializer }

constructor TJsonSerializer.Create(AConverters: TJsonConverters; AOwnsConverters: Boolean);
begin
  FConverters := AConverters;
  FWrittenObjects := TObjectList<TObject>.Create(false);
  FOwnsConverters := AOwnsConverters;
end;

constructor TJsonSerializer.Create;
begin
  Create(TJsonConverters.Create, True);
end;

destructor TJsonSerializer.Destroy;
begin
  FWrittenObjects.Free;
  if FOwnsConverters then
    FConverters.Free;
  inherited;
end;

procedure TJsonSerializer.ObjectWritten(AObject: TObject);
begin
  FWrittenObjects.Add(AObject);
end;

procedure TJsonSerializer.Write(const Value: TValue; Writer: TJsonWriter);
begin
  Write(Value, Value.TypeInfo, Writer);
end;

procedure TJsonSerializer.WriteAs<T>(const Value: T; Writer: TJsonWriter);
begin
  Write(TValue.From<T>(Value), TypeInfo(T), Writer);
end;

procedure TJsonSerializer.Write(const Value: TValue; const TypeToken: TTypeToken;
  Writer: TJsonWriter);
var
  SearchToken: TTypeToken;
begin
  if (TypeToken.TypeInfo <> nil) then
    SearchToken := TypeToken
  else
    SearchToken := Value.TypeInfo;

  if SearchToken.TypeInfo <> nil then
    FConverters.Get(SearchToken).WriteJson(Writer, Value)
  else
    Writer.WriteNull;
end;

function TJsonSerializer.Write(const Value: TValue): string;
begin
  Result := Write(Value, TTypeToken.Create(Value.TypeInfo));
end;

function TJsonSerializer.Write(const Value: TValue;
  const TypeToken: TTypeToken): string;
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create('', TEncoding.UTF8, False);
  try
    Write(Value, TypeToken, Stream);
    Result := Stream.DataString;
  finally
    Stream.Free;
  end;
end;

function TJsonSerializer.WriteAs<T>(const Value: T): string;
begin
  Result := Write(TValue.From<T>(Value), TTypeToken.Create(TypeInfo(T)));
end;

function TJsonSerializer.WrittenObjects: TEnumerable<TObject>;
begin
  Result := FWrittenObjects;
end;

procedure TJsonSerializer.Write(const Value: TValue; Stream: TStream);
begin
  Write(Value, Value.TypeInfo, Stream);
end;

procedure TJsonSerializer.Write(const Value: TValue;
  const TypeToken: TTypeToken; Stream: TStream);
var
  Writer: TJsonWriter;
begin
  Writer := TJsonWriter.Create(Stream);
  try
    Write(Value, TypeToken, Writer);
  finally
    Writer.Free;
  end;
end;

procedure TJsonSerializer.WriteAs<T>(const Value: T; Stream: TStream);
begin
  Write(TValue.From<T>(Value), TypeInfo(T), Stream);
end;

initialization
end.

