Browse Source

* Pascal code generation starting from json-schema

Michaël Van Canneyt 9 months ago
parent
commit
f641987464

+ 17 - 0
packages/fcl-jsonschema/fpmake.pp

@@ -78,6 +78,23 @@ begin
       AddUnit('fpjson.schema.types');
       AddUnit('fpjson.schema.schema');
       end;
+
+   T:=P.Targets.AddUnit('fpjson.schema.pascaltypes.pp');
+   with T.Dependencies do
+     begin
+     AddUnit('fpjson.schema.types');
+     AddUnit('fpjson.schema.schema');
+     end;
+
+   T:=P.Targets.AddUnit('fpjson.schema.codegen.pp');
+   with T.Dependencies do
+     begin
+     AddUnit('fpjson.schema.pascaltypes');
+     AddUnit('fpjson.schema.types');
+     AddUnit('fpjson.schema.schema');
+     end;
+
+ 
       
 {$ifndef ALLPACKAGES}
     Run;

+ 800 - 0
packages/fcl-jsonschema/src/fpjson.schema.codegen.pp

@@ -0,0 +1,800 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    JSON Schema - pascal code generator
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpjson.schema.codegen;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, System.DateUtils, Pascal.CodeGenerator,
+  {$ELSE}
+  Classes, SysUtils, dateutils, pascodegen,
+  {$ENDIF}
+  fpjson.schema.types,
+  fpjson.schema.Pascaltypes;
+
+Type
+
+  { TJSONSchemaCodeGen }
+
+  TJSONSchemaCodeGenerator = class(TPascalCodeGenerator)
+  private
+    FData: TSchemaData;
+    FDelphiCode: boolean;
+    FVerboseHeader: Boolean;
+    FWriteClassType: boolean;
+  protected
+    procedure GenerateHeader; virtual;
+    function GetPascalTypeAndDefault(aType: TSchemaSimpleType; out aPasType, aPasDefault: string) : boolean;
+    function GetJSONDefault(aType: TPropertyType) : String;
+    procedure SetTypeData(aData : TSchemaData);
+  public
+    Property TypeData : TSchemaData Read FData;
+    property DelphiCode: boolean read FDelphiCode write FDelphiCode;
+    Property VerboseHeader : Boolean Read FVerboseHeader Write FVerboseHeader;
+    property WriteClassType: boolean read FWriteClassType write FWriteClassType;
+  end;
+
+  { TTypeCodeGenerator }
+
+  TTypeCodeGenerator = class(TJSONSchemaCodeGenerator)
+  private
+    FTypeParentClass: string;
+    procedure WriteDtoConstructor(aType: TPascalTypeData);
+    procedure WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData);
+    procedure WriteDtoType(aType: TPascalTypeData);
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Execute(aData: TSchemaData);
+    property TypeParentClass: string read FTypeParentClass write FTypeParentClass;
+  end;
+
+  { TSerializerCodeGen }
+
+  TSerializerCodeGenerator = class(TJSONSchemaCodeGenerator)
+  private
+    FDataUnitName: string;
+    function FieldToJSON(aProperty: TPascalPropertyData) : string;
+    function ArrayMemberToField(aType: TPropertyType; const aPropertyTypeName: String; const aFieldName: string): string;
+    function FieldToJSON(aType: TPropertyType; aFieldName: String): string;
+    function JSONToField(aProperty: TPascalPropertyData) : string;
+    function JSONToField(aType: TPropertyType; const aPropertyTypeName: string; const aKeyName: string): string;
+    procedure WriteFieldDeSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData);
+    procedure WriteFieldSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData);
+    procedure WriteDtoObjectSerializer(aType: TPascalTypeData);
+    procedure WriteDtoSerializer(aType: TPascalTypeData);
+    procedure WriteDtoObjectDeserializer(aType: TPascalTypeData);
+    procedure WriteDtoDeserializer(aType: TPascalTypeData);
+    procedure WriteDtoHelper(aType: TPascalTypeData);
+  public
+    procedure Execute(aData: TSchemaData);
+    property DataUnitName: string read FDataUnitName write FDataUnitName;
+  end;
+
+implementation
+
+function TJSONSchemaCodeGenerator.GetPascalTypeAndDefault(
+  aType: TSchemaSimpleType; out aPasType, aPasDefault: string) : boolean;
+
+begin
+  Result := True;
+  case aType of
+    sstInteger:
+    begin
+      aPasType := FData.TypeMap['integer'];
+      aPasDefault := '0';
+    end;
+    sstNumber:
+    begin
+      aPasType := FData.TypeMap['number'];
+      aPasDefault := '0';
+    end;
+    sstBoolean:
+    begin
+      aPasType := FData.TypeMap['boolean'];
+      aPasDefault := 'False';
+    end;
+    sstString:
+    begin
+      aPasType := FData.TypeMap['string'];
+      aPasDefault := '''''';
+    end;
+    sstObject:
+    begin
+      aPasType := 'TJSONObject';
+      aPasDefault := 'TJSONObject(Nil)';
+    end;
+    sstArray:
+    begin
+      aPasType := 'TJSONArray';
+      aPasDefault := 'TJSONArray(Nil)';
+    end;
+    else
+      Result := False;
+  end;
+end;
+
+
+function TJSONSchemaCodeGenerator.GetJSONDefault(aType: TPropertyType): String;
+
+begin
+  case aType of
+    ptEnum:
+      Result:='''''';
+    ptDateTime:
+      Result:='''''';
+    ptInteger,
+    ptInt64:
+      Result:='0';
+    ptfloat32,
+    ptfloat64:
+      Result := '0.0';
+    ptBoolean:
+      Result := 'False';
+    ptJSON,
+    ptString:
+      Result := '''''';
+    ptStructure:
+      Result := 'TJSONObject(Nil)';
+    ptArray:
+      Result := 'TJSONArray(Nil)';
+  end;
+end;
+
+
+procedure TJSONSchemaCodeGenerator.SetTypeData(aData: TSchemaData);
+begin
+  FData:=aData;
+end;
+
+
+procedure TJSONSchemaCodeGenerator.GenerateHeader;
+
+begin
+  // Do nothing
+end;
+
+
+{ TTypeCodeGenerator }
+
+procedure TTypeCodeGenerator.WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData);
+
+var
+  lFieldName, lTypeName: string;
+
+begin
+  lFieldName := aProperty.PascalName;
+  lTypeName := aProperty.PascalTypeName;
+  if lTypeName = '' then
+    Addln('// Unknown type for field %s...', [lFieldName])
+  else
+    Addln('%s : %s;', [lFieldName, lTypeName]);
+end;
+
+
+procedure TTypeCodeGenerator.WriteDtoConstructor(aType: TPascalTypeData);
+
+var
+  I : Integer;
+  lProp : TPascalPropertyData;
+  lConstructor : String;
+
+begin
+  Addln('constructor %s.CreateWithMembers;',[aType.PascalName]);
+  Addln('');
+  Addln('begin');
+  indent;
+  For I:=0 to aType.PropertyCount-1 do
+    begin
+    lProp:=aType.Properties[i];
+    if lProp.PropertyType=ptAPIComponent then
+      begin
+      if lProp.TypeData.HasObjectProperty(True) then
+        lConstructor:='CreateWithMembers'
+      else
+        lConstructor:='Create';
+      AddLn('%s := %s.%s;',[lProp.PascalName,lProp.TypeData.PascalName,lConstructor]);
+      end;
+    end;
+  Undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TTypeCodeGenerator.WriteDtoType(aType: TPascalTypeData);
+
+var
+  I: integer;
+
+begin
+  if WriteClassType then
+    Addln('%s = Class(%s)', [aType.PascalName, TypeParentClass])
+  else
+    Addln('%s = record', [aType.PascalName]);
+  indent;
+  for I:=0  to aType.PropertyCount-1 do
+    WriteDtoField(aType,aType.Properties[i]);
+  if WriteClassType and aType.HasObjectProperty(True) then
+    Addln('constructor CreateWithMembers;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+constructor TTypeCodeGenerator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  TypeParentClass := 'TObject';
+end;
+
+
+procedure TTypeCodeGenerator.Execute(aData: TSchemaData);
+
+var
+  I: integer;
+
+begin
+  FData := aData;
+  GenerateHeader;
+  try
+    Addln('unit %s;', [OutputUnitName]);
+    Addln('');
+    Addln('interface');
+    Addln('');
+    EnsureSection(csType);
+    indent;
+    for I := 0 to aData.TypeCount-1 do
+    begin
+      DoLog('Generating type %s', [aData.Types[I].PascalName]);
+      WriteDtoType(aData.Types[I]);
+    end;
+    undent;
+    Addln('implementation');
+    Addln('');
+    if WriteClassType then
+      for I := 0 to aData.TypeCount-1 do
+        begin
+        if aData.Types[I].HasObjectProperty(True) then
+          begin
+          DoLog('Generating type %s constructor', [aData.Types[I].PascalName]);
+          WriteDtoConstructor(aData.Types[I]);
+          end;
+        end;
+    Addln('end.');
+  finally
+    FData := nil;
+  end;
+end;
+
+
+{ TSerializerCodeGenerator }
+
+function TSerializerCodeGenerator.FieldToJSON(aProperty: TPascalPropertyData): string;
+
+begin
+  Result:=FieldToJSON(aProperty.PropertyType,aProperty.PascalName)
+end;
+
+
+function TSerializerCodeGenerator.FieldToJSON(aType: TPropertyType; aFieldName : String): string;
+
+begin
+  if aType in [ptStructure,ptAPIComponent] then
+  begin
+    Result := Format('%s.SerializeObject', [aFieldName]);
+  end
+  else
+  begin
+    case aType of
+      ptBoolean:
+        if DelphiCode then
+          Result := Format('TJSONBool.Create(%s)', [aFieldName])
+        else
+          Result := aFieldName;
+      ptJSON:
+        if DelphiCode then
+          Result := Format('TJSONObject.ParseJSONValue(%s,True,True)', [aFieldName])
+        else
+          Result := Format('GetJSON(%s)', [aFieldName]);
+      ptDateTime :
+        Result := Format('DateToISO8601(%s)', [aFieldName]);
+      ptEnum :
+        Result := Format('%s.AsString', [aFieldName]);
+    else
+      Result := aFieldName;
+    end;
+  end;
+end;
+
+
+function TSerializerCodeGenerator.JSONToField(aProperty : TPascalPropertyData): string;
+
+begin
+  Result:=JSONToField(aProperty.PropertyType,aProperty.TypeNames[ntPascal], aProperty.SchemaName);
+end;
+
+
+function TSerializerCodeGenerator.JSONToField(aType: TPropertyType; const aPropertyTypeName: string; const aKeyName: string): string;
+
+  function ObjectField(lName: string) : string;
+  begin
+    if DelphiCode then
+      Result := Format('aJSON.GetValue<TJSONObject>(''%s'',Nil)', [lName])
+    else
+      Result := Format('aJSON.Get(''%s'',TJSONObject(Nil))', [lName]);
+  end;
+
+var
+  lPasDefault: string;
+
+begin
+  if aKeyName='features' then
+    Writeln('a');
+  if aType in [ptAPIComponent,ptStructure] then
+  begin
+    Result := Format('%s.Deserialize(%s)', [aPropertyTypeName, ObjectField(aKeyName)]);
+  end
+  else
+  begin
+    case aType of
+      ptString,
+      ptFloat32,
+      ptFloat64,
+      ptDateTime,
+      ptEnum,
+      ptInteger,
+      ptInt64,
+      ptBoolean:
+      begin
+        lPasDefault:=GetJSONDefault(aType);
+        if DelphiCode then
+          Result := Format('aJSON.GetValue<%s>(''%s'',%s)', [aPropertyTypeName, aKeyName, lPasDefault])
+        else
+          Result := Format('aJSON.Get(''%s'',%s)', [aKeyName, lPasDefault]);
+      end;
+      ptJSON:
+      begin
+        if DelphiCode then
+          Result := ObjectField(aKeyName)+'.ToJSON'
+        else
+          Result := ObjectField(aKeyName)+'.AsJSON';
+      end;
+    else
+      Result := aKeyName;
+    end;
+  end;
+end;
+
+
+function TSerializerCodeGenerator.ArrayMemberToField(aType: TPropertyType; const aPropertyTypeName : String; const aFieldName: string): string;
+
+var
+  lPasDefault: string;
+
+begin
+  if aPropertyTypeName='' then
+    Writeln('aPropertyTypeName is empty for ',aFieldName);
+  if aType in [ptStructure,ptAPIComponent] then
+    Result := Format('%s.Deserialize(%s as TJSONObject)', [aPropertyTypeName, aFieldName])
+  else
+    begin
+    case aType of
+      ptEnum:
+        begin
+        lPasDefault:=GetJSONDefault(aType);
+        if DelphiCode then
+          Result := Format('%s.GetValue<String>('''',%s)', [aFieldName, lPasDefault])
+        else
+          Result := Format('%s.AsString', [aFieldName]);
+        end;
+      ptDateTime:
+        Result := Format('%s.AsString', [aFieldName]);
+      ptString,
+      ptFloat32,
+      ptFloat64,
+      ptInteger,
+      ptInt64,
+      ptBoolean:
+      begin
+        lPasDefault:=GetJSONDefault(aType);
+        if DelphiCode then
+          Result := Format('%s.GetValue<%s>('''',%s)', [aFieldName, aPropertyTypeName, lPasDefault])
+        else
+          Result := Format('%s.As%s', [aFieldName, aPropertyTypeName]);
+      end;
+      ptStructure:
+      begin
+        if DelphiCode then
+          Result := Format('%s.ToJSON', [aFieldName])
+        else
+          Result := Format('%s.AsJSON', [aFieldName]);
+      end;
+    else
+      Result := aFieldName;
+    end;
+  end;
+end;
+
+
+procedure TSerializerCodeGenerator.WriteFieldSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData);
+
+var
+  lAssign, lValue, lKeyName, lFieldName: string;
+  lType: TPropertyType;
+  lNilCheck : Boolean;
+
+begin
+  lKeyName := aProperty.SchemaName;
+  lFieldName := aProperty.PascalName;
+  lValue := FieldToJSON(aProperty);
+  lType:=aProperty.PropertyType;
+  lNilCheck:=WriteClassType and (lType in [ptJSON,ptStructure,ptAPIComponent]);
+  case lType of
+    ptEnum:
+      begin
+      Addln('if (%s<>%s._empty_) then',[lFieldName,aProperty.PascalTypeName]);
+      indent;
+      if DelphiCode then
+        Addln('Result.AddPair(''%s'',%s);', [lKeyName, lValue])
+      else
+        Addln('Result.Add(''%s'',%s);', [lKeyName, lValue]);
+      undent;
+      end;
+    ptDatetime,
+    ptInteger,
+    ptInt64,
+    ptString,
+    ptBoolean,
+    ptFloat32,
+    ptFloat64,
+    ptJSON,
+    ptAPIComponent:
+    begin
+      if lNilCheck then
+        begin
+        if (lType=ptJSON) then
+          // JSON string...
+          AddLn('if (%s<>'''') then',[lFieldName])
+        else
+          AddLn('if Assigned(%s) then',[lFieldName]);
+        indent;
+        end;
+      if DelphiCode then
+        Addln('Result.AddPair(''%s'',%s);', [lKeyName, lValue])
+      else
+        Addln('Result.Add(''%s'',%s);', [lKeyName, lValue]);
+      if lNilCheck then
+        undent;
+    end;
+    ptArray:
+    begin
+      Addln('Arr:=TJSONArray.Create;');
+      if DelphiCode then
+        Addln('Result.AddPair(''%s'',Arr);', [lKeyName])
+      else
+        Addln('Result.Add(''%s'',Arr);', [lKeyName]);
+      lAssign := Format('%s[i]', [lFieldName]);
+      lAssign := FieldToJSON(aProperty.ElementType, lAssign);
+      Addln('For I:=0 to Length(%s)-1 do', [lFieldName]);
+      indent;
+      Addln('Arr.Add(%s);', [lAssign]);
+      undent;
+    end;
+    else
+      DoLog('Unknown type for property %s', [aProperty.PascalName]);
+  end;
+end;
+
+
+procedure TSerializerCodeGenerator.WriteFieldDeSerializer(aType: TPascalTypeData; aProperty: TPascalPropertyData);
+
+var
+  lElName, lValue, lKeyName, lFieldName: string;
+
+begin
+  lKeyName := aProperty.SchemaName;
+  lFieldName := aProperty.PascalName;
+  if aProperty.PropertyType<>ptArray then
+    lValue := JSONToField(aProperty)
+  else
+    lValue := ArrayMemberToField(aProperty.ElementType,aProperty.ElementTypeName,'lArr[i]');
+  case aProperty.PropertyType of
+    ptEnum :
+      Addln('Result.%s.AsString:=%s;', [lFieldName, lValue]);
+    ptDateTime:
+      begin
+      Addln('Result.%s:=ISO8601ToDateDef(%s,0);', [lFieldName, lValue]);
+      end;
+    ptInteger,
+    ptInt64,
+    ptFloat32,
+    ptFloat64,
+    ptString,
+    ptBoolean,
+    ptStructure,
+    ptJSON,
+    ptAPIComponent:
+      Addln('Result.%s:=%s;', [lFieldName, lValue]);
+    ptArray:
+    begin
+      if DelphiCode then
+        Addln('lArr:=aJSON.GetValue<TJSONArray>(''%s'',Nil);', [lKeyName])
+      else
+        Addln('lArr:=aJSON.Get(''%s'',TJSONArray(Nil));', [lKeyName]);
+      Addln('if Assigned(lArr) then');
+      indent;
+      Addln('begin');
+      Addln('SetLength(Result.%s,lArr.Count);', [lFieldName]);
+      lElName := Format('%s[i]', [lFieldName]);
+      Addln('For I:=0 to Length(Result.%s)-1 do', [lFieldName]);
+      indent;
+      Addln('Result.%s:=%s;', [lElName, lValue]);
+      undent;
+      Addln('end;');
+      undent;
+    end;
+    else
+      DoLog('Unknown type for property %s', [aProperty.PascalName]);
+  end;
+end;
+
+
+procedure TSerializerCodeGenerator.WriteDtoObjectSerializer(aType: TPascalTypeData);
+
+var
+  I: integer;
+  lName: string;
+
+begin
+  lName := aType.SerializerName;
+  Addln('function %s.SerializeObject : TJSONObject;', [lName]);
+  Addln('');
+  if aType.HasArrayProperty then
+  begin
+    Addln('var');
+    indent;
+    Addln('i : integer;');
+    Addln('Arr : TJSONArray;');
+    undent;
+    Addln('');
+  end;
+  Addln('begin');
+  indent;
+  Addln('Result:=TJSONObject.Create;');
+  Addln('try');
+  indent;
+  for I := 0 to aType.PropertyCount-1 do
+    WriteFieldSerializer(aType, aType.Properties[I]);
+  undent;
+  Addln('except');
+  indent;
+  Addln('Result.Free;');
+  Addln('raise;');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TSerializerCodeGenerator.WriteDtoSerializer(aType: TPascalTypeData);
+
+var
+  lName: string;
+
+begin
+  lName := aType.SerializerName;
+  Addln('function %s.Serialize : String;', [lName]);
+  Addln('var');
+  indent;
+  Addln('lObj : TJSONObject;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('lObj:=SerializeObject;');
+  Addln('try');
+  indent;
+  if DelphiCode then
+    Addln('Result:=lObj.ToJSON;')
+  else
+    Addln('Result:=lObj.AsJSON;');
+  undent;
+  Addln('finally');
+  indent;
+  Addln('lObj.Free');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TSerializerCodeGenerator.WriteDtoObjectDeserializer(aType: TPascalTypeData);
+
+var
+  I: integer;
+  lHasArray: boolean;
+
+begin
+  Addln('class function %s.Deserialize(aJSON : TJSONObject) : %s;', [aType.SerializerName, aType.PascalName]);
+  Addln('');
+  lHasArray := aType.HasArrayProperty;
+  //  lHasObject:=aType.HasObjectProperty(True);
+  if lHasArray then
+  begin
+    Addln('var');
+    indent;
+    if lHasArray then
+    begin
+      Addln('lArr : TJSONArray;');
+      Addln('i : Integer;');
+    end;
+    undent;
+  end;
+  undent;
+  Addln('begin');
+  indent;
+  if WriteClassType then
+    Addln('Result := %s.Create;', [aType.PascalName])
+  else
+    Addln('Result := Default(%s);', [aType.PascalName]);
+  Addln('If (aJSON=Nil) then');
+  indent;
+  Addln('exit;');
+  undent;
+  for I := 0 to aType.PropertyCount-1 do
+    WriteFieldDeSerializer(aType, aType.Properties[I]);
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TSerializerCodeGenerator.WriteDtoDeserializer(aType: TPascalTypeData);
+
+begin
+  Addln('class function %s.Deserialize(aJSON : String) : %s;', [aType.SerializerName, aType.PascalName]);
+  Addln('');
+  Addln('var');
+  indent;
+  Addln('lObj : TJSONObject;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('Result := Default(%s);', [aType.PascalName]);
+  if DelphiCode then
+    Addln('lObj := TJSONObject.ParseJSONValue(aJSON,True,True) as TJSONObject;')
+  else
+    Addln('lObj := GetJSON(aJSON) as TJSONObject;');
+  Addln('if (lObj = nil) then');
+  indent;
+  Addln('exit;');
+  undent;
+  Addln('try');
+  indent;
+  Addln('Result:=Deserialize(lObj);');
+  undent;
+  Addln('finally');
+  indent;
+  Addln('lObj.Free');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TSerializerCodeGenerator.WriteDtoHelper(aType: TPascalTypeData);
+
+begin
+  if WriteClassType then
+    Addln('%s = class helper for %s', [aType.SerializerName, aType.PascalName])
+  else
+  if DelphiCode then
+    Addln('%s = record helper for %s', [aType.SerializerName, aType.PascalName])
+  else
+    Addln('%s = type helper for %s', [aType.SerializerName, aType.PascalName]);
+  indent;
+  if stSerialize in aType.SerializeTypes then
+  begin
+    Addln('function SerializeObject : TJSONObject;');
+    Addln('function Serialize : String;');
+  end;
+  if stDeserialize in aType.SerializeTypes then
+  begin
+    Addln('class function Deserialize(aJSON : TJSONObject) : %s; overload; static;', [aType.PascalName]);
+    Addln('class function Deserialize(aJSON : String) : %s; overload; static;', [aType.PascalName]);
+  end;
+  undent;
+  Addln('end;');
+end;
+
+
+procedure TSerializerCodeGenerator.Execute(aData: TSchemaData);
+
+var
+  I: integer;
+  lType: TPascalTypeData;
+
+begin
+  FData := aData;
+  GenerateHeader;
+  try
+    Addln('unit %s;', [OutputUnitName]);
+    Addln('');
+    Addln('interface');
+    Addln('');
+    if not DelphiCode then
+    begin
+      Addln('{$mode objfpc}');
+      Addln('{$h+}');
+      Addln('{$modeswitch typehelpers}');
+    end;
+    Addln('uses');
+    indent;
+    if DelphiCode then
+      Addln('System.JSON,')
+    else
+      Addln('fpJSON,');
+    Addln(DataUnitName+';');
+    undent;
+    Addln('');
+    EnsureSection(csType);
+    indent;
+    for I := 0 to aData.TypeCount-1 do
+    begin
+      with aData.Types[I] do
+        DoLog('Generating serialization helper type %s for Dto %s', [SerializerName, PascalName]);
+      WriteDtoHelper(aData.Types[I]);
+      Addln('');
+    end;
+    undent;
+    Addln('implementation');
+    Addln('');
+    if DelphiCode then
+      Addln('uses System.Generics.Collections, System.SysUtils, System.Types, System.StrUtils;')
+    else
+      Addln('uses Generics.Collections, SysUtils, Types, StrUtils;');
+    Addln('');
+    for I := 0 to aData.TypeCount-1 do
+    begin
+      lType := aData.Types[I];
+      if stSerialize in lType.SerializeTypes then
+      begin
+        WriteDtoObjectSerializer(aData.Types[I]);
+        WriteDtoSerializer(aData.Types[I]);
+      end;
+      if stDeserialize in lType.SerializeTypes then
+      begin
+        WriteDtoObjectDeserializer(aData.Types[I]);
+        WriteDtoDeserializer(aData.Types[I]);
+      end;
+    end;
+    Addln('');
+    Addln('end.');
+  finally
+    FData := nil;
+  end;
+end;
+
+end.
+

+ 803 - 0
packages/fcl-jsonschema/src/fpjson.schema.pascaltypes.pp

@@ -0,0 +1,803 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    JSON Schema - pascal types and helpers
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpjson.schema.pascaltypes;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, System.Contnrs,
+  {$ELSE}
+  Classes, SysUtils, contnrs,
+  {$ENDIF}
+  fpjson.schema.types,
+  fpjson.schema.schema;
+
+Type
+  ESchemaData = Class(EJSONSchema);
+
+  TPascalTypeData = Class;
+
+  TAPICodeGenLogEvent = Procedure (aType : TEventType; const Msg : String) of object;
+
+  TDependencyType = (dtNone,dtDirect,dtIndirect);
+  TDependencyTypes = set of TDependencyType;
+
+  TNameType = (ntSchema,ntPascal,ntInterface,ntImplementation,ntSerializer);
+  TNameTypes = set of TNameType;
+
+  TSerializeType = (stSerialize,stDeserialize);
+  TSerializeTypes = set of TSerializeType;
+
+  TPropertyType = (ptUnknown,
+                   ptBoolean,      // Boolean
+                   ptInteger,      // 32-bit integer
+                   ptInt64,        // 64-bit integer
+                   ptDateTime,     // TDateTime
+                   ptFloat32,      // Single
+                   ptFloat64,      // Double
+                   ptString,       // String
+                   ptEnum,         // Enumerated
+                   ptJSON,         // TJSONData (empty schema object)
+                   ptStructure,    // Class/Record  (schema object with properties)
+                   ptAPIComponent, // Api component
+                   ptArray         // Array of...
+                   );
+  TPropertyTypes = Set of TPropertyType;
+
+  { TPascalProperty }
+
+  TPascalPropertyData = class(TObject)
+  private
+    FSchemaName: string;
+    FElementType: TPropertyType;
+    FEnumValues: TStrings;
+    FPascalName: string;
+    FSchema: TJSONSchema;
+    FTypeNames: Array[TNameType] of string ;
+    FElementTypeNames: Array[TNameType] of string ;
+    FPropertyType: TPropertyType;
+    FTypeData: TPascalTypeData;
+    function GetElementTypeNames(aType : TNameType): String;
+    function GetFallBackTypeName(aPropertyType: TPropertyType): string;
+    function GetPascalTypeName: String;
+    procedure SetElementTypeNames(aType : TNameType; AValue: String);
+    procedure SetEnumValues(AValue: TStrings);
+    Function GetTypeName(aType: TNameType) : String;
+    procedure SetTypeName(aType: TNameType; aValue : String);
+  Public
+    Constructor Create(const aSchemaName, aPascalName : string);
+    Destructor Destroy; override;
+    // schema Name of the property
+    Property SchemaName : string Read FSchemaName Write FSchemaName;
+    // Pascal Name of the property
+    Property PascalName : string Read FPascalName Write FPascalName;
+    // Indexed access to all kind of type names
+    Property TypeNames [aType : TNameType] : String Read GetTypeName Write SetTypeName;
+    // Type of the property
+    Property PropertyType : TPropertyType Read FPropertyType Write FPropertyType;
+    // If Type is ptEnum, the values. Without _empty_.
+    Property EnumValues : TStrings Read FEnumValues Write SetEnumValues;
+    // Pascal type name for the property (same as TypeNames[ntPascal])
+    Property PascalTypeName : String Index ntPascal Read GetTypeName Write SetTypeName;
+    // PropertyType = ptArray : The array element type
+    Property ElementType : TPropertyType Read FElementType Write FElementType;
+    // PropertyType = ptArray : The array element type name (same as ElementTypeNames[ntPascal])
+    Property ElementTypeName : String Index ntPascal Read GetElementTypeNames Write SetElementTypeNames;
+    // PropertyType = ptArray : The array element type names
+    Property ElementTypeNames[aType : TNameType] : String Read GetElementTypeNames Write SetElementTypeNames;
+    // PropertyType = ptAPIComponent: The type data for that component.
+    // PropertyType = ptArray and elType=ptAPIComponent
+    Property TypeData : TPascalTypeData Read FTypeData Write FTypeData;
+    // The JSON Schema for this property
+    Property Schema : TJSONSchema Read FSchema Write FSchema;
+  end;
+
+  { TPascalTypeData }
+
+  TPascalTypeData = class(TObject)
+  private
+    FSchemaName: String;
+    FImplementationName: String;
+    FIndex: Integer;
+    FInterfaceName: String;
+    FInterfaceUUID: String;
+    FPascalName: String;
+    FSchema: TJSONSChema;
+    FDependencies : TFPObjectList;
+    FSerializerName: String;
+    FSerializeTypes: TSerializeTypes;
+    FSorted : Boolean;
+    FProperties : TFPObjectList;
+    function GetDependency(aIndex : Integer): TPascalTypeData;
+    function GetDependencyCount: Integer;
+    function GetImplementationName: String;
+    function GetInterfaceName: String;
+    function GetInterfaceUUID: String;
+    function GetProperty(aIndex : Integer): TPascalPropertyData;
+    function GetPropertyCount: Integer;
+    function GetSerializerName: String;
+  Protected
+    function CreateProperty(const aAPIName, aPascalName: string): TPascalPropertyData; virtual;
+    Procedure SortProperties;
+  Public
+    class function ExtractFirstType(aSchema: TJSONSchema): TSchemaSimpleType;
+  Public
+    Constructor Create(aIndex : integer; const aSchemaName,aPascalName : String; aSchema : TJSONSchema);
+    destructor Destroy; override;
+    // Index of property using API name
+    Function IndexOfProperty(const aApiName: string) : Integer;
+    // Index of property using Pascal name
+    Function IndexOfPascalProperty(const aPascalName: string) : Integer;
+    // Find property by API name.
+    Function FindProperty(const aName: string) : TPascalPropertyData;
+    // Add a property. The pascal name must not yet exist.
+    Function AddProperty(const aApiName,aPascalName : String) : TPascalPropertyData;
+    // Return the requested name
+    function GetTypeName(aNameType : TNameType) : string;
+    // Check whether this component depends on given component. If recurse is true, check all intermediary structures as well.
+    function DependsOn(aData : TPascalTypeData; Recurse : Boolean) : TDependencyType;
+    // Add aData as a type this type depends on.
+    Procedure AddDependency(aData : TPascalTypeData);
+    // Component has array-typed property ?
+    Function HasArrayProperty : Boolean;
+    // Component has object-typed property ? (APIComponentsonly = False -> also return array of string etc.)
+    function HasObjectProperty(APIComponentsOnly: Boolean): Boolean;
+    // Components his component depends on
+    Property Dependency[aIndex : Integer] : TPascalTypeData Read GetDependency;
+    // Number of Components his component depends on
+    Property DependencyCount : Integer Read GetDependencyCount;
+    // Indexed access to Properties
+    Property Properties[aIndex : Integer] : TPascalPropertyData Read GetProperty; default;
+    // Number of properties
+    Property PropertyCount : Integer Read GetPropertyCount;
+    // Pascal type name for DTO (can be influenced by map). Default is OpenAPI name with prefix/suffix
+    Property PascalName : String Read FPascalName;
+    // Schema name.
+    Property SchemaName : String Read FSchemaName;
+    // Interface name. Default Pascal name + 'Intf'
+    Property InterfaceName : String Read GetInterfaceName Write FInterfaceName;
+    // Interface UUID.
+    Property InterfaceUUID : String Read GetInterfaceUUID Write FInterfaceUUID;
+    // Implemention class name. Default Pascal name + 'Obj'
+    Property ImplementationName : String Read GetImplementationName  write FImplementationName;
+    // Name of serialized helper. Default is Pascal name + 'Serializer'
+    Property SerializerName : String Read GetSerializerName Write FSerializerName;
+    // Do we need to serialize/deserialize ?
+    Property SerializeTypes : TSerializeTypes Read FSerializeTypes Write FSerializeTypes;
+    // Schema of this component.
+    Property Schema: TJSONSChema Read FSchema;
+    //
+    Property Sorted : Boolean Read FSorted Write FSorted;
+  end;
+
+  { TPascalTypeDataList }
+
+  TPascalTypeDataList = Class(TFPObjectList)
+  private
+    function GetTypes(aIndex : Integer): TPascalTypeData;
+  Public
+    Procedure Add(aItem : TPascalTypeData); reintroduce;
+    Property Types[aIndex : Integer] : TPascalTypeData Read GetTypes; default;
+  end;
+
+  TKeywordEscapeMode = (kemAmpersand,kemSuffix,kemPrefix);
+
+  { TSchemaData }
+
+  TSchemaData = class(TObject)
+  private
+    FKeywordEscapeMode: TKeywordEscapeMode;
+    FTypeList : TPascalTypeDataList;
+    FTypeMap : TFPObjectHashTable;
+    FArrayTypePrefix: string;
+    FArrayTypeSuffix: string;
+    FDelphiTypes: Boolean;
+    FInterfaceTypePrefix: String;
+    FObjectTypePrefix: string;
+    FObjectTypeSuffix: string;
+    FOnLog: TAPICodeGenLogEvent;
+    FUseEnums: Boolean;
+    function GetSchemaType(aIndex : Integer): TPascalTypeData;
+    function GetSchemaTypeCount: Integer;
+  protected
+    // Logging
+    procedure DoLog(Const aType : TEventType; const aMessage : String);
+    procedure DoLog(Const aType : TEventType; const aFmt : String; aArgs : Array of const);
+    // Add a new type to the type map.
+    procedure AddToTypeMap(const aSchemaName: String; aData : TPascalTypeData); virtual; overload;
+
+    procedure SortTypes;
+  Public
+    Constructor Create; virtual;
+    Destructor Destroy; override;
+    // Is the word a pascal keyword ?
+    class function IsKeyWord(const aWord : String) : Boolean;
+    // Escape the word if it is a pascal keyword ?
+    function EscapeKeyWord(const aWord : string) : string;
+    // Get the pascal name based on API name
+    function GetTypeMap(const aName : string): String;
+    // Return index of named API type (name as in OpenApi). Return -1 if not found.
+    function IndexOfSchemaType(const aSchemaName: String): integer;
+    // Add a type to the list
+    Procedure AddType(const aSchemaName: String; aType : TPascalTypeData); virtual;
+    // Add a type definition to the type map.
+    procedure AddAliasToTypeMap(const aSchemaTypeName,aPascalTypeName : String; aSchema : TJSONSchema = Nil); overload;
+
+    Property TypeCount : Integer Read GetSchemaTypeCount;
+    Property Types[aIndex : Integer] : TPascalTypeData Read GetSchemaType; default;
+    // Map schema type to pascal type.
+    Property TypeMap[aSchemaName : string] : String Read GetTypeMap;
+
+    // prefix for object definitions. Default T
+    Property ObjectTypePrefix : string Read FObjectTypePrefix Write FObjectTypePrefix;
+    // prefix for object definitions. Default empty
+    Property ObjectTypeSuffix : string Read FObjectTypeSuffix Write FObjectTypeSuffix;
+    // Prefix for Dto Objects
+    Property InterfaceTypePrefix : String Read FInterfaceTypePrefix Write FInterfaceTypePrefix;
+    // Prefix for array types
+    Property ArrayTypePrefix : string Read FArrayTypePrefix Write FArrayTypePrefix;
+    // Suffix for array types. Default Array
+    Property ArrayTypeSuffix : string Read FArrayTypeSuffix Write FArrayTypeSuffix;
+    // Use delphi types: TArray<X> instead of Array of X
+    Property DelphiTypes : Boolean Read FDelphiTypes Write FDelphiTypes;
+    // Use enums for enumerateds (default is to keep them as strings)
+    Property UseEnums : Boolean Read FUseEnums Write FUseEnums;
+    // Log callback
+    Property OnLog : TAPICodeGenLogEvent Read FOnLog Write FOnLog;
+    // how to escape keywords
+    Property KeywordEscapeMode : TKeywordEscapeMode Read FKeywordEscapeMode Write FKeywordEscapeMode;
+  end;
+
+implementation
+
+function CompareTypeDataOnName(Item1, Item2: Pointer): Integer;
+
+var
+  lType1 : TPascalTypeData absolute Item1;
+  lType2 : TPascalTypeData absolute Item2;
+
+begin
+  Result:=CompareText(lType1.SchemaName,lType2.SchemaName);
+end;
+
+
+function CompareProperties(Item1, Item2: Pointer): Integer;
+
+var
+  lParam1 : TPascalPropertyData absolute Item1;
+  lParam2 : TPascalPropertyData absolute Item2;
+  
+begin
+  Result:=CompareText(lParam1.PascalName,lParam2.PascalName);
+end;
+
+
+{ TPascalPropertyData }
+
+procedure TPascalPropertyData.SetEnumValues(AValue: TStrings);
+
+begin
+  if FEnumValues=AValue then Exit;
+  FEnumValues.Assign(AValue);
+end;
+
+
+function TPascalPropertyData.GetPascalTypeName: String;
+
+begin
+ Result:=GetTypeName(ntPascal);
+end;
+
+
+function TPascalPropertyData.GetElementTypeNames(aType : TNameType): String;
+
+begin
+  Result:=FElementTypeNames[aType];
+  if Result<>'' then
+    exit;
+  if (PropertyType=ptArray) then
+    begin
+    if (ElementType=ptAPIComponent) then
+      Exit(TypeData.GetTypeName(aType));
+    Result:=GetFallBackTypeName(ElementType);
+    end;
+end;
+
+procedure TPascalPropertyData.SetElementTypeNames(aType : TNameType; AValue: String);
+
+begin
+  FElementTypeNames[aType]:=aValue;
+end;
+
+
+constructor TPascalPropertyData.Create(const aSchemaName, aPascalName: string);
+
+begin
+  FSchemaName:=aSchemaName;
+  FPascalName:=aPascalName;
+  FEnumValues:=TStringList.Create;
+end;
+
+destructor TPascalPropertyData.Destroy;
+
+begin
+  FreeAndNil(FEnumValues);
+  inherited Destroy;
+end;
+
+function TPascalPropertyData.GetTypeName(aType: TNameType): String;
+
+begin
+  Result:=FTypeNames[aType];
+  if Result<>'' then
+    exit;
+  if Assigned(FTypeData) then
+    Exit(FTypeData.GetTypeName(aType));
+  // Fallback
+  Result:=GetFallBackTypeName(FPropertyType);
+end;
+
+function TPascalPropertyData.GetFallBackTypeName(aPropertyType: TPropertyType): string;
+
+begin
+  Case aPropertyType of
+    ptUnknown      : Raise ESchemaData.CreateFmt('Unknown property type for property "%s"',[PascalName]);
+    ptBoolean      : Result:='boolean';
+    ptInteger      : Result:='integer';
+    ptInt64        : Result:='Int64';
+    ptDateTime     : Result:='TDateTime';
+    ptFloat32      : Result:='single';
+    ptFloat64      : Result:='double';
+    ptString       : Result:='string';
+    ptEnum         : Raise ESchemaData.CreateFmt('Unknown name for enumerated property "%s"',[PascalName]);
+    ptJSON         : Result := 'string';
+    ptStructure    : Raise ESchemaData.CreateFmt('Unknown name for structured property "%s"',[PascalName]);
+    ptAPIComponent : Raise ESchemaData.CreateFmt('Unknown name for API-typed property "%s"',[PascalName]);
+  end;
+end;
+
+procedure TPascalPropertyData.SetTypeName(aType: TNameType; aValue: String);
+
+begin
+  FTypeNames[aType]:=aValue;
+end;
+
+
+function TPascalTypeData.GetDependencyCount: Integer;
+
+begin
+  Result:=0;
+  if Assigned(FDependencies) then
+    Result:=FDependencies.Count;
+end;
+
+
+function TPascalTypeData.GetImplementationName: String;
+
+begin
+  Result:=FImplementationName;
+  if Result='' then
+    begin
+    Result:='T'+StringReplace(SchemaName,'Dto','',[rfIgnoreCase]);
+    Result:=Result+'Obj';
+    end;
+end;
+
+
+function TPascalTypeData.GetInterfaceName: String;
+
+begin
+  Result:=FInterfaceName;
+  if Result='' then
+    Result:='I'+SchemaName;
+end;
+
+
+function TPascalTypeData.GetInterfaceUUID: String;
+
+begin
+  if FInterfaceUUID='' then
+    FInterfaceUUID:=TGUID.NewGuid.ToString(False);
+  Result:=FInterfaceUUID;
+end;
+
+
+function TPascalTypeData.GetProperty(aIndex : Integer): TPascalPropertyData;
+
+begin
+  Result:=TPascalPropertyData(FProperties[aIndex]);
+end;
+
+
+function TPascalTypeData.GetPropertyCount: Integer;
+
+begin
+  Result:=FProperties.Count;
+end;
+
+
+function TPascalTypeData.GetSerializerName: String;
+
+begin
+  Result:=FSerializerName;
+  If Result='' then
+    Result:=PascalName+'Serializer';
+end;
+
+
+function TPascalTypeData.CreateProperty(const aAPIName,aPascalName: string): TPascalPropertyData;
+
+begin
+  Result:=TPascalPropertyData.Create(aAPIName,aPascalName);
+end;
+
+
+procedure TPascalTypeData.SortProperties;
+
+begin
+  FProperties.Sort(@CompareProperties);
+end;
+
+
+function TPascalTypeData.GetDependency(aIndex : Integer): TPascalTypeData;
+
+begin
+  if Assigned(FDependencies) then
+    Result:=TPascalTypeData(FDependencies[aIndex])
+  else
+    Raise EListError.CreateFmt('List index out of bounds: %d',[aIndex]);
+end;
+
+
+constructor TPascalTypeData.Create(aIndex: integer; const aSchemaName, aPascalName: String; aSchema: TJSONSchema);
+
+begin
+  FIndex:=aIndex;
+  FSchema:=ASchema;
+  FSchemaName:=aSchemaName;
+  FPascalName:=aPascalName;
+  FSerializeTypes:=[stSerialize,stDeserialize];
+  FProperties:=TFPObjectList.Create(True);
+end;
+
+
+destructor TPascalTypeData.Destroy;
+
+begin
+  FreeAndNil(FProperties);
+  FreeAndNil(FDependencies);
+  Inherited;
+end;
+
+
+function TPascalTypeData.IndexOfProperty(const aApiName: string): Integer;
+
+begin
+  Result:=FProperties.Count-1;
+  While (Result>=0) and Not SameText(GetProperty(Result).SchemaName,aApiName) do
+    Dec(Result);
+end;
+
+
+function TPascalTypeData.IndexOfPascalProperty(const aPascalName: string): Integer;
+
+begin
+  Result:=FProperties.Count-1;
+  While (Result>=0) and Not SameText(GetProperty(Result).PascalName,aPascalName) do
+    Dec(Result);
+end;
+
+
+function TPascalTypeData.FindProperty(const aName: string): TPascalPropertyData;
+
+var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfProperty(aName);
+  If Idx=-1 then
+    Result:=Nil
+  else
+    Result:=GetProperty(Idx);
+end;
+
+
+function TPascalTypeData.AddProperty(const aApiName, aPascalName: String): TPascalPropertyData;
+
+begin
+  if IndexOfPascalProperty(aPascalName)<>-1 then
+    Raise ESchemaData.CreateFmt('Duplicate property name : %s',[aPascalName]);
+  Result:=CreateProperty(aAPIName,aPascalName);
+  FProperties.Add(Result);
+end;
+
+
+function TPascalTypeData.GetTypeName(aNameType: TNameType): string;
+
+begin
+  Case aNameType of
+    ntSchema: Result:=SchemaName;
+    ntPascal: Result:=PascalName;
+    ntInterface : Result:=InterfaceName;
+    ntImplementation : Result:=ImplementationName;
+    ntSerializer : Result:=SerializerName
+  end;
+end;
+
+
+function TPascalTypeData.DependsOn(aData: TPascalTypeData; Recurse: Boolean): TDependencyType;
+
+var
+  I : Integer;
+
+begin
+  Result:=dtNone;
+  if Not Assigned(FDependencies) then
+    exit;
+  For I:=0 to DependencyCount-1 do
+    if (Dependency[i]=aData) then
+      exit(dtDirect);
+  if not Recurse then
+    exit;
+  For I:=0 to DependencyCount-1 do
+    if (Dependency[i].DependsOn(aData,True)<>dtNone) then
+      Exit(dtIndirect);
+end;
+
+
+procedure TPascalTypeData.AddDependency(aData: TPascalTypeData);
+
+begin
+  if FDependencies=Nil then
+     FDependencies:=TFPObjectList.Create(False);
+  FDependencies.Add(aData);
+end;
+
+
+class function TPascalTypeData.ExtractFirstType(aSchema : TJSONSchema): TSchemaSimpleType;
+
+var
+  types : TSchemaSimpleTypes;
+  t : TSchemaSimpleType;
+
+begin
+  result:=sstNone;
+  types:=aSchema.Validations.Types;
+  for T in TSchemaSimpleType do
+    if T in Types then
+      Exit(T);
+end;
+
+
+function TPascalTypeData.HasArrayProperty: Boolean;
+
+var
+  I : integer;
+
+begin
+  Result:=False;
+  if not Assigned(FSchema) then exit;
+  For I:=0 to Schema.Properties.Count-1 do
+    if (ExtractFirstType(Schema.Properties[i])=sstArray) then
+      exit(True);
+end;
+
+
+function TPascalTypeData.HasObjectProperty(APIComponentsOnly : Boolean): Boolean;
+
+var
+  I : integer;
+  lProp : TJSONSchema;
+
+begin
+  Result:=False;
+  if not Assigned(FSchema) then exit;
+  For I:=0 to Schema.Properties.Count-1 do
+    begin
+    lProp:=Schema.Properties[i];
+    if (lProp.Ref<>'') then
+      exit(True);
+    if (ExtractFirstType(lProp)=sstObject) and not APIComponentsOnly then
+      exit(True);
+    end;
+end;
+
+{ TPascalTypeDataList }
+
+function TPascalTypeDataList.GetTypes(aIndex : Integer): TPascalTypeData;
+
+begin
+  Result:=TPascalTypeData(Items[aIndex]);
+end;
+
+
+procedure TPascalTypeDataList.Add(aItem: TPascalTypeData);
+
+begin
+  Inherited Add(aItem);
+end;
+
+
+{ TSchemaData }
+
+function TSchemaData.GetSchemaTypeCount: Integer;
+
+begin
+  Result:=FTypeList.Count;
+end;
+
+
+function TSchemaData.GetSchemaType(aIndex : Integer): TPascalTypeData;
+
+begin
+  Result:=FTypeList[aIndex];
+end;
+
+
+procedure TSchemaData.DoLog(const aType: TEventType; const aMessage: String);
+
+begin
+  If Assigned(FOnLog) then
+    FOnLog(aType,aMessage);
+end;
+
+procedure TSchemaData.DoLog(const aType: TEventType; const aFmt: String;  aArgs: array of const);
+
+begin
+  If Assigned(FOnLog) then
+    FOnLog(aType,Format(aFmt,aArgs));
+end;
+
+
+procedure TSchemaData.AddAliasToTypeMap(const aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema);
+
+begin
+  AddToTypeMap(aSchemaTypeName,TPascalTypeData.Create(-1,aSchemaTypeName,aPascalTypeName,aSchema));
+end;
+
+
+constructor TSchemaData.Create;
+
+begin
+  FTypeMap:=TFPObjectHashTable.Create(False);
+  FTypeList:=TPascalTypeDataList.Create(True);
+  FObjectTypePrefix:='T';
+  FObjectTypeSuffix:='';
+  FInterfaceTypePrefix:='I';
+  FKeywordEscapeMode:=kemSuffix;
+end;
+
+
+destructor TSchemaData.Destroy;
+
+begin
+  FreeAndNil(FTypeList);
+  FreeAndNil(FTypeMap);
+  inherited Destroy;
+end;
+
+
+class function TSchemaData.IsKeyWord(const aWord: String): Boolean;
+
+Const
+  KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+
+      'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+
+      'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+
+      'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+
+      'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+
+      'as;class;dispinterface;except;exports;finalization;finally;initialization;'+
+      'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+
+      'private;published;length;setlength;';
+
+begin
+  Result:=Pos(';'+lowercase(aWord)+';',KW)<>0;
+end;
+
+
+function TSchemaData.EscapeKeyWord(const aWord: string): string;
+
+begin
+  Result:=aWord;
+  if IsKeyWord(Result) then
+    case KeywordEscapeMode of
+      kemSuffix : Result:=Result+'_';
+      kemPrefix : Result:='_'+Result;
+      kemAmpersand : Result:='&'+Result;
+    end;
+end;
+
+
+function TSchemaData.GetTypeMap(const aName: string): String;
+
+var
+  Obj : TPascalTypeData;
+
+begin
+  Obj:=TPascalTypeData(FTypeMap.Items[aName]);
+  if Assigned(Obj) then
+    Result:=Obj.PascalName
+  else
+    Result:=aName;
+end;
+
+
+function TSchemaData.IndexOfSchemaType(const aSchemaName: String): integer;
+
+begin
+  Result:=FTypeList.Count-1;
+  While (Result>=0) and (GetSchemaType(Result).SchemaName<>aSchemaName) do
+    Dec(Result);
+end;
+
+
+procedure TSchemaData.AddType(const aSchemaName: String; aType: TPascalTypeData);
+
+begin
+  FTypeList.Add(aType);
+  addToTypeMap(aSchemaName,aType);
+end;
+
+
+procedure TSchemaData.AddToTypeMap(const aSchemaName: String; aData: TPascalTypeData);
+
+begin
+  if FTypeMap.Items[aSchemaName]=Nil then
+    FTypeMap.Add(aSchemaName,aData);
+end;
+
+
+procedure TSchemaData.SortTypes;
+
+  Procedure AddToList(aList : TPascalTypeDataList; aType : TPascalTypeData);
+
+  var
+    I : integer;
+
+  begin
+    if aType.Sorted then
+      exit;
+    for I:=0 to aType.DependencyCount-1 do
+      AddToList(aList,aType.Dependency[i]);
+    aList.Add(aType);
+    aType.Sorted:=True;
+  end;
+
+var
+  lTmpList,lSortedList : TPascalTypeDataList;
+  i : integer;
+
+begin
+  FTypeList.Sort(@CompareTypeDataOnName);
+  lSortedList:=TPascalTypeDataList.Create(False);
+  try
+    lTmpList:=lSortedList;
+    For I:=0 to FTypeList.Count-1 do
+      AddToList(lSortedList,TPascalTypeData(FTypeList[i]));
+    lTmpList:=FTypeList;
+    FTypeList:=lSortedList;
+    FTypeList.OwnsObjects:=True;
+    lSortedList:=lTmpList;
+    lSortedList.OwnsObjects:=False;
+  finally
+    lSortedList.Free;
+  end;
+end;
+
+
+end.
+