unit Bcl.Json.Deserializer;

{$I Bcl.Inc}

interface

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

type
  TObjectCreatedProc = reference to procedure(AObject: TObject);

  TJsonDeserializer = class
  private
    FConverters: TJsonConverters;
    FCreatedObjects: TObjectList<TObject>;
    FOnObjectCreated: TObjectCreatedProc;
    FOwnsConverters: Boolean;
    function GetOwnsObjects: boolean;
    procedure SetOwnsObjects(const Value: boolean);
  protected
    procedure ObjectCreated(AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AConverters: TJsonConverters; AOwnsConverters: Boolean); overload;
    destructor Destroy; override;

    // For Read methods where AValue is passed by reference:
    // When TypeToken is an object, then if an instance exists in AValue parameter, the
    // Json value will be deserialiazed into that instance, without creating a new one.
    // Existing properties will be kept, and properties in Json will override current values.
    // if AValue is nil then a new object instance will be created and returned in AValue.

    function Read<T>(const Json: string): T; overload;
    function Read(const Json: string; const ATypeToken: TTypeToken): TValue; overload;
    procedure Read(const Json: string; var AValue: TValue; const ATypeToken: TTypeToken); overload;

    function Read<T>(Stream: TStream): T; overload;
    function Read(Stream: TStream; const ATypeToken: TTypeToken): TValue; overload;
    procedure Read(Stream: TStream; var AValue: TValue; const ATypeToken: TTypeToken); overload;

    function Read<T>(Reader: TJsonReader): T; overload;
    function Read(Reader: TJsonReader; const ATypeToken: TTypeToken): TValue; overload;
    procedure Read(Reader: TJsonReader; var AValue: TValue; const ATypeToken: TTypeToken); overload;

    function CreatedObjects: TEnumerable<TObject>;
    property OwnsObjects: boolean read GetOwnsObjects write SetOwnsObjects;
    property OnObjectCreated: TObjectCreatedProc read FOnObjectCreated write FOnObjectCreated;
    property Converters: TJsonConverters read FConverters;
  end;

implementation

uses
  Variants;

{ TJsonDeserializer }

constructor TJsonDeserializer.Create(AConverters: TJsonConverters; AOwnsConverters: Boolean);
begin
  FCreatedObjects := TObjectList<TObject>.Create(false);
  FConverters := AConverters;
  FConverters.OnObjectProcessed := Self.ObjectCreated;
  FOwnsConverters := AOwnsConverters;
end;

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

function TJsonDeserializer.CreatedObjects: TEnumerable<TObject>;
begin
  Result := FCreatedObjects;
end;

destructor TJsonDeserializer.Destroy;
begin
  FCreatedObjects.Free;
  if FOwnsConverters then
    FConverters.Free;
  inherited;
end;

function TJsonDeserializer.GetOwnsObjects: boolean;
begin
  Result := FCreatedObjects.OwnsObjects;
end;

procedure TJsonDeserializer.ObjectCreated(AObject: TObject);
begin
  FCreatedObjects.Add(AObject);
  if Assigned(FOnObjectCreated) then
    FOnObjectCreated(AObject);
end;

function TJsonDeserializer.Read(Reader: TJsonReader; const ATypeToken: TTypeToken): TValue;
begin
  Result := TValue.Empty;
  Read(Reader, Result, ATypeToken);
end;

function TJsonDeserializer.Read(const Json: string;
  const ATypeToken: TTypeToken): TValue;
begin
  Result := TValue.Empty;
  Read(Json, Result, ATypeToken);
end;

procedure TJsonDeserializer.Read(const Json: string; var AValue: TValue;
  const ATypeToken: TTypeToken);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create(Json, TEncoding.UTF8, False);
  try
    Read(Stream, AValue, ATypeToken);
  finally
    Stream.Free;
  end;
end;

function TJsonDeserializer.Read<T>(Reader: TJsonReader): T;
begin
  Result := Read(Reader, TypeInfo(T)).AsType<T>;
end;

function TJsonDeserializer.Read<T>(const Json: string): T;
begin
  Result := Read(Json, TypeInfo(T)).AsType<T>;
end;

procedure TJsonDeserializer.Read(Reader: TJsonReader; var AValue: TValue;
  const ATypeToken: TTypeToken);
var
  SearchToken: TTypeToken;
begin
  Assert(Assigned(ATypeToken.TypeInfo) or Assigned(AValue.TypeInfo));
  if ATypeToken.TypeInfo = nil then
    SearchToken := TTypeToken.Create(AValue.TypeInfo)
  else
    SearchToken := ATypeToken;

  FConverters.Get(SearchToken).ReadJson(Reader, AValue);
end;

function TJsonDeserializer.Read(Stream: TStream;
  const ATypeToken: TTypeToken): TValue;
begin
  Result := TValue.Empty;
  Read(Stream, Result, ATypeToken);
end;

procedure TJsonDeserializer.Read(Stream: TStream; var AValue: TValue;
  const ATypeToken: TTypeToken);
var
  Reader: TJsonReader;
begin
  Reader := TJsonReader.Create(Stream);
  try
    Read(Reader, AValue, ATypeToken);
  finally
    Reader.Free;
  end;
end;

function TJsonDeserializer.Read<T>(Stream: TStream): T;
begin
  Result := Read(Stream, TypeInfo(T)).AsType<T>;
end;

procedure TJsonDeserializer.SetOwnsObjects(const Value: boolean);
begin
  FCreatedObjects.OwnsObjects := Value;
end;

end.

