unit Bcl.Json.OrderedDictionaryConverter;

interface

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

type
  TJsonOrderedDictionaryConverter = class(TInterfacedObject, IJsonTypeConverter)
  strict private
    FClass: TClass;
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FConverters: TJsonConverters;
    FItemConverter: IJsonTypeConverter;
    FIsObjectDictionary: Boolean;
    FAsDictionaryMethod: TRttiMethod;
    FContext: TRttiContext;
    procedure ReadDictionary(JReader: TJsonReader; Dictionary: IDictionary);
  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);
    destructor Destroy; override;
  end;

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

implementation

{ TJsonOrderedDictionaryConverter }

constructor TJsonOrderedDictionaryConverter.Create(const AClass: TClass;
  const AItemTypeToken: TTypeToken; AConverters: TJsonConverters);
begin
  FClass := AClass;
  FConverters := AConverters;
  FItemConverter := FConverters.Get(AItemTypeToken);
  FIsObjectDictionary := AItemTypeToken.IsClass;
  FContext := TRttiContext.Create;
  FAsDictionaryMethod := FContext.GetType(AClass).GetMethod('AsDictionary');
  Assert(FAsDictionaryMethod <> nil, 'AsDictionary method not found');
end;

procedure TJsonOrderedDictionaryConverter.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
    ReadDictionary(Reader, FAsDictionaryMethod.Invoke(Value.AsObject, []).AsType<IDictionary>);
    Value := Target;
    if TargetCreated then
      FConverters.ObjectCreated(Target);
  except
    if TargetCreated then
      Target.Free;
    raise;
  end;
end;

destructor TJsonOrderedDictionaryConverter.Destroy;
begin
  FContext.Free;
  inherited;
end;

procedure TJsonOrderedDictionaryConverter.ReadDictionary(JReader: TJsonReader;
  Dictionary: IDictionary);
var
  Value: TValue;
  Key: string;
begin
  Dictionary.Clear;
  JReader.ReadBeginObject;
  while JReader.HasNext do
  begin
    Key := JReader.ReadName;
    Value := TValue.Empty;
    FItemConverter.ReadJson(JReader, Value);
    Dictionary.AddOrSetValue(Key, Value);
  end;
  JReader.ReadEndObject;
end;

procedure TJsonOrderedDictionaryConverter.WriteJson(const Writer: TJsonWriter;
  const Value: TValue);
var
  Dictionary: IDictionary;
  Item: TValuePair;
  NotifyWrittenObjects: Boolean;
begin
  Writer.WriteBeginObject;
  if not Value.IsEmpty then
  begin
    Dictionary := FAsDictionaryMethod.Invoke(Value.AsObject, []).AsType<IDictionary>;
    NotifyWrittenObjects := FIsObjectDictionary and not (doOwnsValues in Dictionary.GetOwnerships);
    if Dictionary <> nil then
      for Item in Dictionary do
      begin
        Writer.WriteName(Item.Key.AsString);
        if Item.Value.IsEmpty then
          Writer.WriteNull
        else
        begin
          if NotifyWrittenObjects then
            FConverters.ObjectWritten(Item.Value.AsObject);
          FConverters.Get(Item.Value.TypeInfo).WriteJson(Writer, Item.Value);
        end;
      end;
  end;
  Writer.WriteEndObject;
end;

{ TJsonOrderedDictionaryConverterFactory }

function TJsonOrderedDictionaryConverterFactory.CreateConverter(Converters: TJsonConverters;
  const ATypeToken: TTypeToken): IJsonTypeConverter;
var
  ItemTypeToken: TTypeToken;
  Clazz: TClass;
  ItemType: TRttiType;
  ParamTypes: TArray<TRttiType>;
begin
  Result := nil;
  Clazz := ATypeToken.GetClass;
  if TRttiUtils.GetInstance.IsGenericOf(Clazz, TOrderedDictionary<string,TObject>) then
  begin
    // Only serialize dictionaries that key are strings
    ParamTypes := TRttiUtils.GetInstance.ExtractGenericTypes(Clazz);
    if (Length(ParamTypes) = 2) and
      (ParamTypes[0].TypeKind in [tkString, tkLString, tkWString, tkUString, tkChar, tkWChar]) then
    begin
      if ATypeToken.ItemTypeInfo <> nil then
        ItemTypeToken := ATypeToken.ItemTypeInfo
      else
      begin
        ItemType := ParamTypes[1];
        if ItemType <> nil then
          ItemTypeToken := ItemType.Handle
        else
          ItemTypeToken := TTypeToken.Create(nil); // invalid
      end;
      if ItemTypeToken.TypeInfo <> nil then
        Result := TJsonOrderedDictionaryConverter.Create(Clazz, ItemTypeToken, Converters);
    end;
  end;
end;

end.
