Пользовательский конвертер для TJsonMarshal в Delphi 11

В документации для TTypeMarshaller.RegisterConverter отсутствует какая-либо подробная информация, и у вас нет другого выбора, кроме как изучить исходный код Delphi RTL. На первый взгляд все перегруженные версии метода можно разделить на 3 группы:

1. Перегрузка с 3 параметрами с последним параметром типа TConverterEvent — регистрирует преобразователь, который выполняет преобразование на основе своего свойства ConverterType . Это свойство доступно только для чтения, но его значение устанавливается вместе с заданием любого из его делегатов преобразования (*Converter свойств).
2. Перегружает 3 параметра с последним параметром типа T...Converter — регистрирует преобразователь для FieldName (2-й параметр) внутри типа класса clazz (1-й параметр). Назовем его «преобразователем поля».
3. Перегружает 2 параметра с последним параметром типа TType...Converter — регистрирует преобразователь для типа класса clazz (1-й параметр). По сути, это вызывает первую перегрузку, в которой для FieldName установлено значение '*', которое зарезервировано для преобразователей типов.

В примере кода вы регистрируете преобразователь полей для поля с именем * внутри типа класса экземпляра, предоставленного в качестве аргумента вашего метода TMyJsonConverter.JsonConvert. Это объясняет, почему ваша процедура преобразования не вызывается.

Кроме того, вы создаете экземпляр TListOfObjectInterceptor, чтобы передать ссылку на его метод ObjectsConverter методу TTypeMarshaller.RegisterConverter. Таким образом вы слили этот TListOfObjectInterceptor экземпляр. Перехватчики следует использовать в сочетании с атрибутом JsonReflect.

Правильный способ регистрации преобразователя полей:

function ListFieldConverter(Data: TObject; Field: string): TListOfObjects;
var
  RttiContext: TRttiContext;
  List: TList<TObject>;
begin
  List := TList<TObject>(RttiContext.GetType(Data.ClassInfo).GetField(Field).GetValue(Data).AsObject);
  Result := TListOfObjects(List.List);
  SetLength(Result, List.Count); // makes unique copy
end;

{ ... }

marshaller.RegisterConverter(TMySampleDTO, 'Employees', ListFieldConverter);
marshaller.RegisterConverter(TMySampleDTO, 'Departments', ListFieldConverter);
marshaller.RegisterConverter(TDepartment, 'Employees', ListFieldConverter);
marshaller.RegisterConverter(TMySampleDTO, 'Worktimes', ListFieldConverter);

Правильный способ регистрации преобразователя типов:

function ListTypeConverter(Data: TObject): TListOfObjects;
var
  List: TList<TObject>;
begin
  List := TList<TObject>(Data);
  Result := TListOfObjects(List.List);
  SetLength(Result, List.Count); // makes unique copy
end;

{ ... }

marshaller.RegisterConverter(TEmployeeList, ListTypeConverter);
marshaller.RegisterConverter(TDepartmentList, ListTypeConverter);
marshaller.RegisterConverter(TWorktimeList, ListTypeConverter);

Как видите, это такой же труд, как и использование атрибутов JsonReflect. Теоретически вы можете регистрировать преобразователи динамически на основе RTTI, но это может быть затруднительно из-за вложенных типов и наследования.

Подводя итог, можно сказать, что хотя библиотека Delphi JSON предоставляет способы подключения к процессу маршалинга, она не очень гибкая и поддерживает только самые базовые сценарии (см. также недавний вопрос Сериализация Spring4D Nullable JSON).

Последнее, что я хотел бы отметить, это то, что вам следует уделять больше внимания условностям. Поля записей/классов должны иметь префикс F по соглашению. Библиотека Delphi JSON учитывает это и удаляет F в процессе сериализации. Сериализация type TData = class Foo: string; end; в JSON дает: {"oo":""}.

Вот кое-что, что работает - по какой-то причине это не работает, когда объект верхнего уровня представляет собой список, но пока я могу с этим смириться. Он использует RTTI и некоторые сомнительные методы поиска списков в объекте, но у меня это работает — в некоторой степени.

Если ObjectToConvert является потомком TList<T>, он все равно вернет json как объект со свойством listHelper, содержащим элементы списка.

Но только для объекта верхнего уровня

Если кто-нибудь сможет выяснить, почему конвертер не работает для верхнего списка (крайнее значение json), не стесняйтесь сказать мне, почему, и я добавлю это в решение.

procedure FindObjectListsInHierarchy(obj: TObject; var result: TList<TClass>);

  function IsListDescendant(clazz:TClass) : boolean;
  begin
    result := false;
    while clazz <> nil do
    begin
      if clazz.ClassName.StartsWith('TList<') then
         exit(true);
      clazz := clazz.ClassParent;
    end;
  end;

begin
  if not assigned(result) then
    Result := TList<TClass>.Create;

  var ctx := TRttiContext.Create;
  var objType := ctx.GetType(obj.ClassType);

  for var prop in objType.GetProperties do
  begin
    if not ((prop.Visibility = mvPublic) or (prop.Visibility = mvPublished)) then
      continue;

    if prop.PropertyType.TypeKind in [tkClass, tkDynarray] then
    begin
      if IsListDescendant(TRttiInstanceType(Prop.Parent).MetaclassType) then
      begin
        if not result.Contains(obj.ClassType) then
          Result.Add(obj.ClassType);

        for var item in TList(Obj) do
          FindObjectListsInHierarchy(item, result);
      end;

      if prop.PropertyType.TypeKind = tkClass then
        FindObjectListsInHierarchy(prop.GetValue(obj).AsObject, result);
    end;
  end;
end;

function TMyJsonConverter.TypeObjectsConverter(Data: TObject): TListOfObjects;
begin
  var list := TList<TObject>(Data);
  Result := TListOfObjects(list.List);
  SetLength(Result, list.Count);
end;

function TMyJsonConverter.JsonConvert(ObjectToConvert: TObject): string;
begin
  var marshaller := TJSONMarshal.Create;
  try
    var listObjects: TList<TClass> := nil;
    try
      FindObjectListsInHierarchy(ObjectToConvert, listObjects);
      for var o in listObjects do
      begin
        marshaller.RegisterJSONMarshalled(o, 'FOwnsObjects', false);
        marshaller.RegisterConverter(o, TypeObjectsConverter);
      end;
    finally
      listObjects.Free;
    end;

    var json := marshaller.Marshal(ObjectToConvert);
    result := json.ToString;
    json.Free;
  finally
    marshaller.Free;
  end;
end;