unit Bcl.Json.ListConverter;

interface

uses
  Rtti,
  Bcl.Collections,
  Bcl.Json.Converters,
  Bcl.Json.Reader,
  Bcl.Json.Writer,
  Bcl.Rtti.Utils;

type
  TJsonValueListConverter = class(TInterfacedObject, IJsonTypeConverter)
  strict private
    FClass: TClass;
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FConverters: TJsonConverters;
    FItemConverter: IJsonTypeConverter;
    FIsObjectList: Boolean;
    procedure ReadList(JReader: TJsonReader; List: IValueList);
  public
    procedure WriteJson(const Writer: TJsonWriter; const Value: TValue);
    procedure ReadJson(const Reader: TJsonReader; var Value: TValue);
  public
    constructor Create(const AClass: TClass; const AItemTypeToken: TTypeToken; AConverters: TJsonConverters);
  end;

  TJsonObjectListConverter = class(TInterfacedObject, IJsonTypeConverter)
  strict private
    FClass: TClass;
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FConverters: TJsonConverters;
    FItemConverter: IJsonTypeConverter;
    procedure ReadList(JReader: TJsonReader; List: IObjectList);
  public
    procedure WriteJson(const Writer: TJsonWriter; const Value: TValue);
    procedure ReadJson(const Reader: TJsonReader; var Value: TValue);
  public
    constructor Create(const AClass: TClass; const AItemTypeToken: TTypeToken; AConverters: TJsonConverters);
  end;

  TJsonListConverterFactory = class(TInterfacedObject, IJsonConverterFactory)
  public
    function CreateConverter(Converters: TJsonConverters; const ATypeToken: TTypeToken): IJsonTypeConverter;
  end;

implementation

{ TJsonListConverter }

constructor TJsonValueListConverter.Create(const AClass: TClass;
  const AItemTypeToken: TTypeToken; AConverters: TJsonConverters);
begin
  FClass := AClass;
  FConverters := AConverters;
  FItemConverter := FConverters.Get(AItemTypeToken);
  FIsObjectList := AItemTypeToken.IsClass;
end;

procedure TJsonValueListConverter.ReadJson(const Reader: TJsonReader;
  var Value: TValue);
var
  Target: TObject;
  TargetCreated: Boolean;
begin
  Target := Value.AsObject;
  if Target = nil then
  begin
    Target := FConverters.ObjectFactory.CreateInstance(Self.FClass);
    TargetCreated := True;
  end
  else
    TargetCreated := False;

  try
    ReadList(Reader, AsValueList(Target));
    Value := Target;
    if TargetCreated then
      FConverters.ObjectCreated(Target);
  except
    if TargetCreated then
      Target.Free;
    raise;
  end;
end;

procedure TJsonValueListConverter.ReadList(JReader: TJsonReader;
  List: IValueList);
var
  Value: TValue;
begin
  List.Clear;
  JReader.ReadBeginArray;
  while JReader.HasNext do
  begin
    Value := TValue.Empty;
    FItemConverter.ReadJson(JReader, Value);
    List.Add(Value);
  end;
  JReader.ReadEndArray;
end;

procedure TJsonValueListConverter.WriteJson(const Writer: TJsonWriter;
  const Value: TValue);
var
  List: IValueList;
  I: integer;
  Item: TValue;
  NotifyWrittenObjects: Boolean;
begin
  Writer.WriteBeginArray;
  if not Value.IsEmpty then
  begin
    List := AsValueList(Value.AsObject);
    NotifyWrittenObjects := FIsObjectList and not List.OwnsValues;
    if List <> nil then
      for I := 0 to List.Count - 1 do
      begin
        Item := List.GetItem(I);
        if Item.IsEmpty then
          Writer.WriteNull
        else
        begin
          if NotifyWrittenObjects then
            FConverters.ObjectWritten(Item.AsObject);
          FConverters.Get(Item.TypeInfo).WriteJson(Writer, Item);
        end;
      end;
  end;
  Writer.WriteEndArray;
end;

{ TJsonListConverterFactory }

function TJsonListConverterFactory.CreateConverter(Converters: TJsonConverters;
  const ATypeToken: TTypeToken): IJsonTypeConverter;
var
  ItemTypeToken: TTypeToken;
  Clazz: TClass;
  ItemType: TRttiType;
begin
  Result := nil;
  Clazz := ATypeToken.GetClass;
  if IsValueList(Clazz) then
  begin
    if ATypeToken.ItemTypeInfo <> nil then
      ItemTypeToken := ATypeToken.ItemTypeInfo
    else
    begin
      ItemType := ValueListType(Clazz);
      if ItemType <> nil then
        ItemTypeToken := ItemType.Handle
      else
        ItemTypeToken := TTypeToken.Create(nil); // invalid
    end;

    if ItemTypeToken.TypeInfo <> nil then
      Result := TJsonValueListConverter.Create(Clazz, ItemTypeToken, Converters);
  end
  else
  if IsObjectList(Clazz) then
  begin
    if ATypeToken.ItemTypeInfo <> nil then
      ItemTypeToken := ATypeToken.ItemTypeInfo
    else
      ItemTypeToken := TypeInfo(TObject);

    if ItemTypeToken.TypeInfo <> nil then
      Result := TJsonObjectListConverter.Create(Clazz, ItemTypeToken, Converters);
  end;
end;

{ TJsonObjectListConverter }

constructor TJsonObjectListConverter.Create(const AClass: TClass;
  const AItemTypeToken: TTypeToken; AConverters: TJsonConverters);
begin
  FClass := AClass;
  FConverters := AConverters;
  FItemConverter := FConverters.Get(AItemTypeToken);
end;

procedure TJsonObjectListConverter.ReadJson(const Reader: TJsonReader;
  var Value: TValue);
var
  Target: TObject;
  TargetCreated: Boolean;
begin
  Target := Value.AsObject;
  if Target = nil then
  begin
    Target := FConverters.ObjectFactory.CreateInstance(Self.FClass);
    TargetCreated := True;
  end
  else
    TargetCreated := False;

  try
    ReadList(Reader, AsObjectList(Target));
    Value := Target;
    if TargetCreated then
      FConverters.ObjectCreated(Target);
  except
    if TargetCreated then
      Target.Free;
    raise;
  end;
end;

procedure TJsonObjectListConverter.ReadList(JReader: TJsonReader;
  List: IObjectList);
var
  Value: TValue;
begin
  List.Clear;
  JReader.ReadBeginArray;
  while JReader.HasNext do
  begin
    Value := TValue.Empty;
    FItemConverter.ReadJson(JReader, Value);
    List.Add(Value.AsObject);
  end;
  JReader.ReadEndArray;
end;

procedure TJsonObjectListConverter.WriteJson(const Writer: TJsonWriter;
  const Value: TValue);
var
  List: IObjectList;
  I: integer;
  Item: TValue;
  NotifyWrittenObjects: Boolean;
begin
  Writer.WriteBeginArray;
  if not Value.IsEmpty then
  begin
    List := AsObjectList(Value.AsObject);
    NotifyWrittenObjects := not List.OwnsObjects;
    if List <> nil then
      for I := 0 to List.Count - 1 do
      begin
        Item := List.Item(I);
        if Item.IsEmpty then
          Writer.WriteNull
        else
        begin
          if NotifyWrittenObjects then
            FConverters.ObjectWritten(Item.AsObject);
          FConverters.Get(Item.TypeInfo).WriteJson(Writer, Item);
        end;
      end;
  end;
  Writer.WriteEndArray;
end;

end.
