unit XData.JSchema.Writer;

{$I XData.inc}

interface

uses
  Generics.Collections, System.SysUtils, System.Classes,
  Bcl.Json.Classes,
  Bcl.Json.Converters,
  Bcl.Json.Writer,
  Bcl.Json.Serializer,
  XData.JSchema.Classes;

type
  TJSchemaWriter = class
  private
    FWriter: TJsonWriter;
    FConverters: TJsonConverters;
    property Writer: TJsonWriter read FWriter;
  private
    procedure InternalWriteSchema(Schema: TJsonSchema);
    procedure WriteIfNotEmpty(const PropName: string; Value: Integer); overload;
    procedure WriteIfNotEmpty(const PropName: string; Value: Double); overload;
    procedure WriteIfNotEmpty(const PropName: string; Value: Boolean); overload;
    procedure WriteIfNotEmpty(const PropName, Value: string); overload;
    procedure WriteStrings(const PropName: string; Strings: TStrings);
    procedure WriteDefinitions(Schema: TJsonSchema);
    procedure WriteCustomData(Schema: TJsonSchema);
  private
    procedure SchemaProperties(Schema: TJsonSchema);
    procedure StringSchemaProperties(Schema: TStringSchema);
    procedure NumberSchemaProperties(Schema: TNumberSchema);
    procedure IntegerSchemaProperties(Schema: TIntegerSchema);
    procedure BooleanSchemaProperties(Schema: TBooleanSchema);
    procedure NullSchemaProperties(Schema: TNullSchema);
    procedure ArraySchemaProperties(Schema: TArraySchema);
    procedure ObjectSchemaProperties(Schema: TObjectSchema);
    procedure RawReferenceSchemaProperties(Schema: TRawReferenceSchema);
    procedure NameReferenceSchemaProperties(Schema: TNameReferenceSchema);
    procedure NumericSchemaProperties(Schema: TNumericSchema);
  public
    constructor Create(AWriter: TJsonWriter);
    destructor Destroy; override;
    procedure WriteSchema(Schema: TJsonSchema);
  end;

  ESchemaDefinitionNotFound = class(Exception)
  public
    constructor Create(const AName: string);
  end;

implementation

{ TJsonSchemaWriter }

procedure TJSchemaWriter.ArraySchemaProperties(Schema: TArraySchema);
var
  ItemSchema: TJsonSchema;
begin
  SchemaProperties(Schema);

  // Write "items" keyword
  if Schema.ItemSchemas.Count > 0 then
  begin
    Writer.WriteName(TJsonSchemaProps.Items);
    if Schema.ValidateItemByPosition then
    begin
      Writer.WriteBeginArray;
      for ItemSchema in Schema.ItemSchemas do
        InternalWriteSchema(ItemSchema);
      Writer.WriteEndArray;
    end
    else
      InternalWriteSchema(Schema.ItemSchemas[0]);
  end;

  // Write additional items
  if not Schema.AdditionalItems then
  begin
    Writer.WriteName(TJsonSchemaProps.AdditionalItems);
    Writer.WriteBoolean(Schema.AdditionalItems);
  end
  else
    if Schema.AdditionalItemSchema <> nil then
    begin
      Writer.WriteName(TJsonSchemaProps.AdditionalItems);
      InternalWriteSchema(Schema.AdditionalItemSchema);
    end;

  // Remaining metadata
  WriteIfNotEmpty(TJsonSchemaProps.MaxItems, Schema.MaxItems);
  WriteIfNotEmpty(TJsonSchemaProps.MinItems, Schema.MinItems);
  WriteIfNotEmpty(TJsonSchemaProps.UniqueItems, Schema.UniqueItems);
end;

procedure TJSchemaWriter.BooleanSchemaProperties(Schema: TBooleanSchema);
begin
  SchemaProperties(Schema);
end;

constructor TJSchemaWriter.Create(AWriter: TJsonWriter);
begin
  FWriter := AWriter;
  FConverters := TJsonConverters.Create;
end;

destructor TJSchemaWriter.Destroy;
begin
  FConverters.Free;
  inherited
end;

procedure TJSchemaWriter.WriteCustomData(Schema: TJsonSchema);
var
  Pair: TPair<string, TJElement>;
  Converter: IJsonTypeConverter;
begin
  Converter := FConverters.Get(TJElement);
  for Pair in Schema.CustomData do
  begin
    Writer.WriteName(Pair.Key);
    Converter.WriteJson(Writer, Pair.Value);
  end;
end;

procedure TJSchemaWriter.WriteDefinitions(Schema: TJsonSchema);
var
  Definition: TPair<string, TJsonSchema>;
begin
  if Schema.Definitions.Count > 0 then
  begin
    Writer.WriteName(TJsonSchemaProps.Definitions);
    Writer.WriteBeginObject;
    for Definition in Schema.Definitions do
    begin
      Writer.WriteName(Definition.Key);
      InternalWriteSchema(Definition.Value);
    end;
    Writer.WriteEndObject;
  end;
end;

procedure TJSchemaWriter.WriteIfNotEmpty(const PropName, Value: string);
begin
  if Value <> '' then
  begin
    Writer.WriteName(PropName);
    Writer.WriteString(Value);
  end;
end;

procedure TJSchemaWriter.WriteIfNotEmpty(const PropName: string;
  Value: Integer);
begin
  if Value <> 0 then
  begin
    Writer.WriteName(PropName);
    Writer.WriteInteger(Value);
  end;
end;

procedure TJSchemaWriter.WriteIfNotEmpty(const PropName: string;
  Value: Double);
begin
  if Value <> 0 then
  begin
    Writer.WriteName(PropName);
    Writer.WriteDouble(Value);
  end;
end;

procedure TJSchemaWriter.WriteIfNotEmpty(const PropName: string;
  Value: Boolean);
begin
  if Value then
  begin
    Writer.WriteName(PropName);
    Writer.WriteBoolean(Value);
  end;
end;

procedure TJSchemaWriter.WriteSchema(Schema: TJsonSchema);
begin
  InternalWriteSchema(Schema);
end;

procedure TJSchemaWriter.WriteStrings(const PropName: string;
  Strings: TStrings);
var
  I: Integer;
begin
  if Strings.Count > 0 then
  begin
    Writer.WriteName(PropName);
    Writer.WriteBeginArray;
    for I := 0 to Strings.Count - 1 do
      Writer.WriteString(Strings[I]);
    Writer.WriteEndArray;
  end;
end;

procedure TJSchemaWriter.IntegerSchemaProperties(Schema: TIntegerSchema);
begin
  NumericSchemaProperties(Schema);
end;

procedure TJSchemaWriter.InternalWriteSchema(Schema: TJsonSchema);
begin
  Writer.WriteBeginObject;

  if Schema is TStringSchema then
    StringSchemaProperties(TStringSchema(Schema))
  else
  if Schema is TNumberSchema then
    NumberSchemaProperties(TNumberSchema(Schema))
  else
  if Schema is TIntegerSchema then
    IntegerSchemaProperties(TIntegerSchema(Schema))
  else
  if Schema is TBooleanSchema then
    BooleanSchemaProperties(TBooleanSchema(Schema))
  else
  if Schema is TNullSchema then
    NullSchemaProperties(TNullSchema(Schema))
  else
  if Schema is TObjectSchema then
    ObjectSchemaProperties(TObjectSchema(Schema))
  else
  if Schema is TArraySchema then
    ArraySchemaProperties(TArraySchema(Schema))
  else
  if Schema is TRawReferenceSchema then
    RawReferenceSchemaProperties(TRawReferenceSchema(Schema))
  else
  if Schema is TNameReferenceSchema then
    NameReferenceSchemaProperties(TNameReferenceSchema(Schema))
  else
    SchemaProperties(Schema);

  WriteDefinitions(Schema);
  WriteCustomData(Schema);

  Writer.WriteEndObject;
end;

procedure TJSchemaWriter.NameReferenceSchemaProperties(
  Schema: TNameReferenceSchema);
begin
  Writer.WriteName(TJsonSchemaProps.Ref);
  Writer.WriteString('#/definitions/' + Schema.Name);
  WriteIfNotEmpty(TJsonSchemaProps.Title, Schema.Title);
  WriteIfNotEmpty(TJsonSchemaProps.Description, Schema.Description);
end;

procedure TJSchemaWriter.NullSchemaProperties(Schema: TNullSchema);
begin
  SchemaProperties(Schema);
end;

procedure TJSchemaWriter.NumberSchemaProperties(Schema: TNumberSchema);
begin
  NumericSchemaProperties(Schema);
end;

procedure TJSchemaWriter.NumericSchemaProperties(Schema: TNumericSchema);
begin
  SchemaProperties(Schema);
  WriteIfNotEmpty(TJsonSchemaProps.MultipleOf, Schema.MultipleOf);
  WriteIfNotEmpty(TJsonSchemaProps.Maximum, Schema.Maximum);
  if Schema.Maximum <> 0 then
    WriteIfNotEmpty(TJsonSchemaProps.ExclusiveMaximum, Schema.ExclusiveMaximum);
  WriteIfNotEmpty(TJsonSchemaProps.Minimum, Schema.Minimum);
  if Schema.Minimum <> 0 then
    WriteIfNotEmpty(TJsonSchemaProps.ExclusiveMinimum, Schema.ExclusiveMinimum);
  if Schema.DefaultValue.HasValue then
  begin
    Writer.WriteName(TJsonSchemaProps.Default);
    Writer.WriteDouble(Schema.DefaultValue);
  end;
end;

procedure TJSchemaWriter.ObjectSchemaProperties(Schema: TObjectSchema);
var
  Prop: TPair<string, TJsonSchema>;
begin
  SchemaProperties(Schema);

  // Write "properties" keyword
  if Schema.Properties.Count > 0 then
  begin
    Writer.WriteName(TJsonSchemaProps.Properties);
    Writer.WriteBeginObject;
    for Prop in Schema.Properties do
    begin
      Writer.WriteName(Prop.Key);
      InternalWriteSchema(Prop.Value);
    end;
    Writer.WriteEndObject;
  end;

  // Write additional properties
  if not Schema.AdditionalProperties then
  begin
    Writer.WriteName(TJsonSchemaProps.AdditionalProperties);
    Writer.WriteBoolean(Schema.AdditionalProperties);
  end
  else
    if Schema.AdditionalPropertySchema <> nil then
    begin
      Writer.WriteName(TJsonSchemaProps.AdditionalProperties);
      InternalWriteSchema(Schema.AdditionalPropertySchema);
    end;

  // Remaining metadata
  WriteIfNotEmpty(TJsonSchemaProps.MaxProperties, Schema.MaxProperties);
  WriteIfNotEmpty(TJsonSchemaProps.MinProperties, Schema.MinProperties);
  WriteStrings(TJsonSchemaProps.Required, Schema.Required);
end;

procedure TJSchemaWriter.RawReferenceSchemaProperties(Schema: TRawReferenceSchema);
begin
  Writer.WriteName(TJsonSchemaProps.Ref);
  Writer.WriteString(Schema.Ref);
  WriteIfNotEmpty(TJsonSchemaProps.Title, Schema.Title);
  WriteIfNotEmpty(TJsonSchemaProps.Description, Schema.Description);
end;

procedure TJSchemaWriter.SchemaProperties(Schema: TJsonSchema);
begin
  WriteIfNotEmpty(TJsonSchemaProps._Type, Schema._Type);
  WriteIfNotEmpty(TJsonSchemaProps.Format, Schema.Format);
  WriteIfNotEmpty(TJsonSchemaProps.Title, Schema.Title);
  WriteIfNotEmpty(TJsonSchemaProps.Description, Schema.Description);
end;

procedure TJSchemaWriter.StringSchemaProperties(Schema: TStringSchema);
begin
  SchemaProperties(Schema);
  WriteIfNotEmpty(TJsonSchemaProps.MaxLength, Schema.MaxLength);
  WriteIfNotEmpty(TJsonSchemaProps.MinLength, Schema.MinLength);
  WriteIfNotEmpty(TJsonSchemaProps.Pattern, Schema.Pattern);
  if Schema.DefaultValue.HasValue then
  begin
    Writer.WriteName(TJsonSchemaProps.Default);
    Writer.WriteString(Schema.DefaultValue);
  end;
  WriteStrings(TJsonSchemaProps.Enum, Schema.Enum);
end;

{ ESchemaDefinitionNotFound }

constructor ESchemaDefinitionNotFound.Create(const AName: string);
begin
  inherited CreateFmt('Definition "%s" not found in JSON Schema', [AName]);
end;

end.
