unit XData.JSchema.Classes;

{$I XData.inc}

interface

uses
  Generics.Collections, System.Classes,
  Bcl.Collections,
  Bcl.Json.Classes,
  Aurelius.Types.Nullable;

type
  TJsonSchema = class;

  TJsonSchemaDefinitions = class(TOrderedObjectDictionary<string, TJsonSchema>)
  end;

  TJsonSchema = class
  private
    FSchema: string;
//    FId: string;
    FTitle: string;
    FDescription: string;
    FFormat: string;
    FDefinitions: TJsonSchemaDefinitions;
    FCustomData: TOrderedDictionary<string, TJElement>;
  protected
    function GetType: string; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    /// The "$schema" keyword is both used as a JSON Schema version identifier
    ///  and the location of a resource which is itself a JSON Schema, which describes
    ///  any schema written for this particular version
    ///
    /// This keyword MUST be located at the root of a JSON Schema.
    ///  The value of this keyword MUST be a URI [RFC3986] and a valid JSON Reference
    ///  This URI MUST be both absolute and normalized.
    ///  The resource located at this URI MUST successfully describe itself.
    ///  It is RECOMMENDED that schema authors include this keyword in their schemas.
    ///
    ///  The following values are predefined:
    ///
    ///  http://json  -schema.org/schema#
    ///      JSON Schema written against the current version of the specification.
    ///  http://json-schema.org/hyper-schema#
    ///     JSON Schema written against the current version of the specification.
    ///  http://json-schema.org/draft-04/schema#
    ///     JSON Schema written against this version.
    ///  http://json-schema.org/draft-04/hyper-schema#
    ///     JSON Schema hyperschema written against this version.
    ///  http://json-schema.org/draft-03/schema#
    ///     JSON Schema written against JSON Schema, draft v3
    ///  http://json-schema.org/draft-03/hyper-schema#
    ///     JSON Schema hyperschema written against JSON Schema, draft v3
    property Schema: string read FSchema write FSchema;

    /// The "id" keyword (or "id", for short) is used to alter the resolution scope.
    ///  When an id is encountered, an implementation MUST resolve this id against
    ///  the most immediate parent scope. The resolved URI will be the new resolution
    ///  scope for this subschema and all its children, until another id is encountered.
    ///
    ///  When using "id" to alter resolution scopes, schema authors SHOULD ensure that
    ///  resolution scopes are unique within the schema.
    //property Id: string read FId write FId;

    property _Type: string read GetType;

    /// reserved values:
    ///  date-time: date time in format RFC 3339
    ///  email: e-mail address RFC 5322
    ///  uri: uri value according to RFC 3986
    property Format: string read FFormat write FFormat;

    property Title: string read FTitle write FTitle;
    property Description: string read FDescription write FDescription;

    property Definitions: TJsonSchemaDefinitions read FDefinitions;

    property CustomData: TOrderedDictionary<string, TJElement> read FCustomData;
  end;

  TRawReferenceSchema = class(TJsonSchema)
  private
    FRef: string;
  public
    constructor Create(const ARef: string); overload;
    property Ref: string read FRef write FRef;
  end;

  TNameReferenceSchema = class(TJsonSchema)
  private
    FName: string;
  public
    constructor Create(const AName: string); overload;
    property Name: string read FName write FName;
  end;

  TStringSchema = class(TJsonSchema)
  private
    FMaxLength: Integer;
    FMinLength: Integer;
    FPattern: string;
    FEnum: TStrings;
    FDefaultValue: Nullable<string>;
  protected
    function GetType: string; override;
  public
    constructor Create;
    destructor Destroy; override;

    /// The value of this keyword MUST be an integer. This integer MUST be greater than, or equal to, 0.
    ///  A string instance is valid against this keyword if its length is less than,
    ///  or equal to, the value of this keyword.
    ///
    ///  The length of a string instance is defined as the number of its characters
    ///  as defined by RFC 4627 [RFC4627].
    property MaxLength: Integer read FMaxLength write FMaxLength;

    property MinLength: Integer read FMinLength write FMinLength;

    /// The value of this keyword MUST be a string. This string SHOULD be a valid regular
    ///  expression, according to the ECMA 262 regular expression dialect.
    ///
    /// A string instance is considered valid if the regular expression matches the
    ///  instance successfully. Recall: regular expressions are not implicitly anchored.
    property Pattern: string read FPattern write FPattern;

    /// List of valid values. In Json-Schema specification, "enum" keyword can list any types
    ///  of values. In this case we are simplifying and allowing only string values.
    property Enum: TStrings read FEnum;

    property DefaultValue: Nullable<string> read FDefaultValue write FDefaultValue;
  end;

  TNumericSchema = class(TJsonSchema)
  private
    FMultipleOf: Double;
    FMaximum: Double;
    FExclusiveMaximum: Boolean;
    FMinimum: Double;
    FExclusiveMinimum: Boolean;
    FDefaultValue: Nullable<Double>;
  public
    /// The value of "multipleOf" MUST be a JSON number.
    ///  This number MUST be strictly greater than 0.
    ///
    ///  A numeric instance is valid against "multipleOf" if the result
    ///  of the division of the instance by this keyword's value is an integer.
    property MultipleOf: Double read FMultipleOf write FMultipleOf;

    /// The value of "maximum" MUST be a JSON number.
    ///
    ///  Successful validation depends on the presence and value of "exclusiveMaximum":
    ///  if "exclusiveMaximum" is not present, or has boolean value false, then the instance
    ///  is valid if it is lower than, or equal to, the value of "maximum";
    ///
    ///  if "exclusiveMaximum" has boolean value true, the instance is valid if
    ///  it is strictly lower than the value of "maximum".
    property Maximum: Double read FMaximum write FMaximum;

    /// The value of "exclusiveMaximum" MUST be a boolean.
    ///  If "exclusiveMaximum" is present, "maximum" MUST also be present.
    ///  "exclusiveMaximum", if absent, may be considered as being present with boolean value false.
    property ExclusiveMaximum: Boolean read FExclusiveMaximum write FExclusiveMaximum;


    /// See Maximum/ExclusiveMaximum for the equivalent documentation
    property Minimum: Double read FMinimum write FMinimum;
    property ExclusiveMinimum: Boolean read FExclusiveMinimum write FExclusiveMinimum;

    /// keyword "default"
    property DefaultValue: Nullable<Double> read FDefaultValue write FDefaultValue;
  end;

  TNumberSchema = class(TNumericSchema)
  protected
    function GetType: string; override;
  end;

  TIntegerSchema = class(TNumericSchema)
  protected
    function GetType: string; override;
  end;

  TBooleanSchema = class(TJsonSchema)
  protected
    function GetType: string; override;
  end;

  TNullSchema = class(TJsonSchema)
  protected
    function GetType: string; override;
  end;

  TArraySchema = class(TJsonSchema)
  private
    FItemSchemas: TList<TJsonSchema>;
    FAdditionalItems: Boolean;
    FValidateItemByPosition: Boolean;
    FAdditionalItemSchema: TJsonSchema;
    FMaxItems: Integer;
    FMinItems: Integer;
    FUniqueItems: Boolean;
    procedure SetAdditionalItemSchema(const Value: TJsonSchema);
  protected
    function GetType: string; override;
  public
    constructor Create;
    destructor Destroy; override;

    /// The value of "items" MUST be either an object or an array. If it is an object,
    ///  this object MUST be a valid JSON Schema. If it is an array, items of this array
    ///  MUST be objects, and each of these objects MUST be a valid JSON Schema.
    ///
    ///  ItemsSchemas contain the array of JSON Schemas for "items" keyword.
    ///  If it contains a single item and ValidateItemByPosition is false, then
    ///  it's considered that "items" keyword is a single object
    property ValidateItemByPosition: Boolean read FValidateItemByPosition write FValidateItemByPosition;
    property ItemSchemas: TList<TJsonSchema> read FItemSchemas;

    /// The value of "additionalItems" MUST be either a boolean or an object.
    ///  If it is an object, this object MUST be a valid JSON Schema.
    ///
    ///  if AdditionalItemSchema is not nil and AdditionalItems is True, then
    ///  "additionalItems" keyword is considered to be an object (JSON Schema).
    ///  Otherwise, it's a Boolean
    property AdditionalItems: Boolean read FAdditionalItems write FAdditionalItems default True;
    property AdditionalItemSchema: TJsonSchema read FAdditionalItemSchema write SetAdditionalItemSchema;

    /// The value of this keyword MUST be an integer. This integer MUST be greater than, or equal to, 0.
    property MaxItems: Integer read FMaxItems write FMaxItems;

    /// The value of this keyword MUST be an integer. This integer MUST be greater than, or equal to, 0.
    property MinItems: Integer read FMinItems write FMinItems;

    /// The value of this keyword MUST be a boolean.
    ///
    ///  If this keyword has boolean value false, the instance validates successfully.
    ///  If it has boolean value true, the instance validates successfully if all of its
    ///  elements are unique.
    property UniqueItems: Boolean read FUniqueItems write FUniqueItems;
  end;

  TObjectSchema = class(TJsonSchema)
  private
    FMinProperties: Integer;
    FMaxProperties: Integer;
    FRequired: TStrings;
    FAdditionalProperties: Boolean;
    FAdditionalPropertySchema: TJsonSchema;
    FProperties: TOrderedDictionary<string, TJsonSchema>;
    FPatternProperties: TOrderedDictionary<string, TJsonSchema>;
    procedure SetAdditionalPropertySchema(const Value: TJsonSchema);
  protected
    function GetType: string; override;
  public
    constructor Create;
    destructor Destroy; override;

    /// The value of "properties" MUST be an object. Each value of this object MUST be an object,
    ///  and each object MUST be a valid JSON Schema.
    property Properties: TOrderedDictionary<string, TJsonSchema> read FProperties;

    /// The value of "patternProperties" MUST be an object. Each property name of this object
    ///  SHOULD be a valid regular expression, according to the ECMA 262 regular expression
    ///  dialect. Each property value of this object MUST be an object, and each object MUST
    ///  be a valid JSON Schema.
//    property PatternProperties: TDictionary<string, TJsonSchema> read FPatternProperties;

    ///  if AdditionalPropertySchema is not nil and AdditionalProperties is True, then
    ///  "additionalProperties" keyword is considered to be an object (JSON Schema).
    ///  Otherwise, it's a Boolean
    property AdditionalProperties: Boolean read FAdditionalProperties write FAdditionalProperties default True;
    property AdditionalPropertySchema: TJsonSchema read FAdditionalPropertySchema write SetAdditionalPropertySchema;


    /// The value of this keyword MUST be an integer. This integer MUST be greater than, or equal to, 0.
    property MaxProperties: Integer read FMaxProperties write FMaxProperties;

    /// The value of this keyword MUST be an integer. This integer MUST be greater than, or equal to, 0.
    property MinProperties: Integer read FMinProperties write FMinProperties;

    /// The value of this keyword MUST be an array. This array MUST have at least one element.
    ///  Elements of this array MUST be strings, and MUST be unique.
    property Required: TStrings read FRequired;

    /// "dependencies" keyword:
    ///   This keyword's value MUST be an object. Each value of this object MUST be either an
    ///   object or an array.
    ///
    ///  If the value is an object, it MUST be a valid JSON Schema. This is called a schema dependency.
    ///
    ///  If the value is an array, it MUST have at least one element. Each element MUST be a
    ///   string, and elements in the array MUST be unique. This is called a property dependency.
//    property PropertyDependencies: TDictionary<string, TStrings> read FPropertyDependencies;
//    property SchemaDependencies: TDictionary<string, TJsonSchema> read FSchemaDependencies;
  end;

  TJsonSchemaProps = class
  public const
    _Type = 'type';
    Format = 'format';
    Title = 'title';
    Description = 'description';
    Ref = '$ref';
    MaxLength = 'maxLength';
    MinLength = 'minLength';
    Pattern = 'pattern';
    Items = 'items';
    AdditionalItems = 'additionalItems';
    MaxItems = 'maxItems';
    MinItems = 'minItems';
    UniqueItems = 'uniqueItems';
    MaxProperties = 'maxProperties';
    MinProperties = 'minProperties';
    Required = 'required';
    AdditionalProperties = 'additionalProperties';
    Properties = 'properties';
    PatternProperties = 'patternProperties';
    Dependencies = 'dependencies';
    Enum = 'enum';
    Definitions = 'definitions';
    Default = 'default';

    MultipleOf = 'multipleOf';
    Maximum = 'maximum';
    ExclusiveMaximum = 'exclusiveMaximum';
    Minimum = 'minimum';
    ExclusiveMinimum = 'exclusiveMinimum';
  end;

implementation

{ TArraySchema }

constructor TArraySchema.Create;
begin
  inherited;
  FItemSchemas := TObjectList<TJsonSchema>.Create;
  FAdditionalItems := True;
end;

destructor TArraySchema.Destroy;
begin
  FItemSchemas.Free;
  FAdditionalItemSchema.Free;
  inherited;
end;

function TArraySchema.GetType: string;
begin
  Result := 'array';
end;

procedure TArraySchema.SetAdditionalItemSchema(const Value: TJsonSchema);
begin
  if FAdditionalItemSchema <> Value then
    FAdditionalItemSchema.Free;
  FAdditionalItemSchema := Value;
end;

{ TObjectSchema }

constructor TObjectSchema.Create;
begin
  inherited;
  FRequired := TStringList.Create;
  FProperties := TOrderedObjectDictionary<string, TJsonSchema>.Create([doOwnsValues]);
  FPatternProperties := TOrderedObjectDictionary<string, TJsonSchema>.Create([doOwnsValues]);
  FAdditionalProperties := True;
end;

destructor TObjectSchema.Destroy;
begin
  FRequired.Free;
  FProperties.Free;
  FPatternProperties.Free;
  FAdditionalPropertySchema.Free;
  inherited;
end;

function TObjectSchema.GetType: string;
begin
  Result := 'object';
end;

procedure TObjectSchema.SetAdditionalPropertySchema(const Value: TJsonSchema);
begin
  if FAdditionalPropertySchema <> Value then
    FAdditionalPropertySchema.Free;
  FAdditionalPropertySchema := Value;
end;

{ TStringSchema }

constructor TStringSchema.Create;
begin
  inherited;
  FEnum := TStringList.Create;
end;

destructor TStringSchema.Destroy;
begin
  FEnum.Free;
  inherited;
end;

function TStringSchema.GetType: string;
begin
  Result := 'string';
end;

{ TNumberSchema }

function TNumberSchema.GetType: string;
begin
  Result := 'number';
end;

{ TIntegerSchema }

function TIntegerSchema.GetType: string;
begin
  Result := 'integer';
end;

{ TBooleanSchema }

function TBooleanSchema.GetType: string;
begin
  Result := 'boolean';
end;

{ TNullSchema }

function TNullSchema.GetType: string;
begin
  Result := 'null';
end;

{ TJsonSchema }

constructor TJsonSchema.Create;
begin
  inherited;
  FDefinitions := TJsonSchemaDefinitions.Create([doOwnsValues]);
  FCustomData := TOrderedObjectDictionary<string, TJElement>.Create([doOwnsValues]);
end;

destructor TJsonSchema.Destroy;
begin
  FCustomData.Free;
  FDefinitions.Free;
  inherited;
end;

function TJsonSchema.GetType: string;
begin
  Result := '';
end;

{ TReferenceSchema }

constructor TRawReferenceSchema.Create(const ARef: string);
begin
  inherited Create;
  FRef := ARef;
end;

{ TReferenceSchema }

constructor TNameReferenceSchema.Create(const AName: string);
begin
  inherited Create;
  FName := AName;
end;

end.
