unit XData.JSchema.OrderedDictionaryGenerator;

interface

uses
  Bcl.Collections,
  System.TypInfo,
  System.Rtti,
  XData.JSchema.Classes,
  XData.JSchema.Generators;

type
  TJSchemaOrderedDictionaryGenerator = class(TJSchemaGenerator)
  private
    FItemGenerator: IJSchemaGenerator;
  public
    constructor Create(const AClass: TClass; const AItemTypeToken: TTypeToken; AGenerators: TJSchemaGenerators);
    function CreateSchema: TJsonSchema; override;
  end;

  TJSchemaOrderedDictionaryGeneratorFactory = class(TInterfacedObject, IJSchemaGeneratorFactory)
  strict protected
    function CreateGenerator(Context: TJSchemaGeneratorContext; const ATypeToken: TTypeToken): IJSchemaGenerator;
  end;

implementation

uses
  Bcl.Rtti.Utils;

{ TJSchemaOrderedDictionaryGeneratorFactory }

function TJSchemaOrderedDictionaryGeneratorFactory.CreateGenerator(
  Context: TJSchemaGeneratorContext;
  const ATypeToken: TTypeToken): IJSchemaGenerator;
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 := TJSchemaOrderedDictionaryGenerator.Create(Clazz, ItemTypeToken, Context.Generators);
    end;
  end;
end;

{ TJSchemaOrderedDictionaryGenerator }

constructor TJSchemaOrderedDictionaryGenerator.Create(const AClass: TClass;
  const AItemTypeToken: TTypeToken; AGenerators: TJSchemaGenerators);
begin
  FItemGenerator := AGenerators.Get(AItemTypeToken);
end;

function TJSchemaOrderedDictionaryGenerator.CreateSchema: TJsonSchema;
var
  Schema: TObjectSchema;
begin
  Schema := TObjectSchema.Create;
  try
    Schema.AdditionalProperties := True;
    Schema.AdditionalPropertySchema := FItemGenerator.CreateSchema;
    Result := Schema;
  except
    Schema.Free;
    raise;
  end;
end;

end.
