* Calculate dependencies correctly, only generate definitions for schema types

packages/fcl-jsonschema/src/fpjson.schema.codegen.pp

@@ -65,12 +65,15 @@ Type
 
   { TSerializerCodeGen }
 
+  { TSerializerCodeGenerator }
+
   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;
+    procedure GenerateConverters;
     function JSONToField(aProperty: TPascalPropertyData) : string;
     function JSONToField(aType: TPropertyType; const aPropertyTypeName: string; const aKeyName: string): string;
     procedure WriteFieldDeSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData);
@@ -260,17 +263,19 @@ begin
     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;
+      if aData.Types[I].PascalType in [ptSchemaStruct,ptAnonStruct] then
+        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
+        if (aData.Types[I].PascalType in [ptSchemaStruct,ptAnonStruct])
+           and aData.Types[I].HasObjectProperty(True) then
           begin
           DoLog('Generating type %s constructor', [aData.Types[I].PascalName]);
           WriteDtoConstructor(aData.Types[I]);
@@ -341,11 +346,10 @@ function TSerializerCodeGenerator.JSONToField(aType: TPropertyType; const aPrope
   end;
 
 var
+  lPropType,
   lPasDefault: string;
 
 begin
-  if aKeyName='features' then
-    Writeln('a');
   if aType in [ptSchemaStruct,ptAnonStruct] then
   begin
     Result := Format('%s.Deserialize(%s)', [aPropertyTypeName, ObjectField(aKeyName)]);
@@ -362,9 +366,13 @@ begin
       ptInt64,
       ptBoolean:
       begin
+        if aType=ptDateTime then
+          lPropType:='string'
+        else
+          lPropType:=aPropertyTypeName;
         lPasDefault:=GetJSONDefault(aType);
         if DelphiCode then
-          Result := Format('aJSON.GetValue<%s>(''%s'',%s)', [aPropertyTypeName, aKeyName, lPasDefault])
+          Result := Format('aJSON.GetValue<%s>(''%s'',%s)', [lPropType, aKeyName, lPasDefault])
         else
           Result := Format('aJSON.Get(''%s'',%s)', [aKeyName, lPasDefault]);
       end;
@@ -388,8 +396,6 @@ var
   lPasDefault: string;
 
 begin
-  if aPropertyTypeName='' then
-    Writeln('aPropertyTypeName is empty for ',aFieldName);
   if aType in [ptAnonStruct,ptSchemaStruct] then
     Result := Format('%s.Deserialize(%s as TJSONObject)', [aPropertyTypeName, aFieldName])
   else
@@ -728,6 +734,30 @@ begin
   Addln('end;');
 end;
 
+procedure TSerializerCodeGenerator.GenerateConverters;
+
+begin
+  Addln('function ISO8601ToDateDef(S: String; aDefault : TDateTime) : TDateTime;');
+  Addln('');
+  Addln('begin');
+  indent;
+  Addln('if (S='''') then');
+  indent;
+  Addln('Exit(aDefault);');
+  undent;
+  Addln('try');
+  indent;
+  AddLn('Result:=ISO8601ToDate(S);');
+  undent;
+  Addln('except');
+  indent;
+  Addln('Result:=aDefault;');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
 
 procedure TSerializerCodeGenerator.Execute(aData: TSchemaData);
 
@@ -763,31 +793,38 @@ begin
     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('');
+        if Pascaltype in [ptSchemaStruct,ptAnonStruct] then
+          begin
+          DoLog('Generating serialization helper type %s for Dto %s', [SerializerName, PascalName]);
+          WriteDtoHelper(aData.Types[I]);
+          Addln('');
+          end;
     end;
     undent;
     Addln('implementation');
     Addln('');
     if DelphiCode then
-      Addln('uses System.Generics.Collections, System.SysUtils, System.Types, System.StrUtils;')
+      Addln('uses System.Generics.Collections, System.SysUtils, System.Types, System.DateUtils, System.StrUtils;')
     else
-      Addln('uses Generics.Collections, SysUtils, Types, StrUtils;');
+      Addln('uses Generics.Collections, SysUtils, Types, DateUtils, StrUtils;');
     Addln('');
+    GenerateConverters;
     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;
+      if LType.Pascaltype in [ptSchemaStruct,ptAnonStruct] then
+        begin
+        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;
     end;
     Addln('');
     Addln('end.');

packages/fcl-jsonschema/src/fpjson.schema.pascaltypes.pp

@@ -228,6 +228,8 @@ Type
     // Logging
     procedure DoLog(Const aType : TEventType; const aMessage : String);
     procedure DoLog(Const aType : TEventType; const aFmt : String; aArgs : Array of const);
+    // Override this to finish creating a type.
+    procedure FinishAutoCreatedType(aName: string; aType: TPascalTypeData; lElementTypeData: TPascalTypeData); virtual;
     // Override this to determine the type name of a pascal property
     function GetSchemaTypeAndName(aType: TPascalTypeData; aSchema: TJSONSchema; out aPropType: TPascalType; aNameType: TNameType=ntPascal): String; virtual;
     // Add a new type to the type map.
@@ -618,10 +620,26 @@ procedure TSchemaData.CheckDependencies;
     For I:=0 to aData.PropertyCount-1 do
       begin
       lPropData:=aData.Properties[I].TypeData;
-      if Assigned(lPropData) and (lPropData.Pascaltype in [ptAnonStruct,ptSchemaStruct]) then
+      if Assigned(lPropData) then
         begin
-        lTop.AddDependency(lPropData);
-        CheckProps(lTop,lPropData);
+        Case lPropData.Pascaltype of
+        ptAnonStruct,ptSchemaStruct:
+          begin
+          lTop.AddDependency(lPropData);
+          CheckProps(lTop,lPropData);
+          end;
+        ptArray:
+          begin
+          lPropData:=GetSchemaTypeData(lPropData,lPropData.Schema.Items[0],False);
+          if assigned(lPropData) and (lPropData.PascalType in [ptAnonStruct,ptSchemaStruct]) then
+            begin
+            lTop.AddDependency(lPropData);
+            CheckProps(lTop,lPropData);
+            end;
+          end
+        else
+          ;
+        end;
         end;
       end;
   end;
@@ -790,6 +808,14 @@ begin
     end;
 end;
 
+Procedure TSchemaData.FinishAutoCreatedType(aName : string; aType: TPascalTypeData; lElementTypeData: TPascalTypeData);
+
+begin
+  AddType(aName,aType);
+  if aType.Pascaltype=ptAnonStruct then
+    AddPropertiesToType(aType,aType.Schema,True);
+end;
+
 function TSchemaData.GetSchemaTypeData(aType: TPascalTypeData; lSchema: TJSONSchema; AllowCreate : Boolean = False) : TPascalTypeData;
 
 var
@@ -839,7 +865,7 @@ begin
           if (Result=Nil) and allowCreate then
             begin
             Result:=CreatePascalType(-1,ptEnum,lName,'T'+lBaseName,lSchema);
-            AddType(lName,Result);
+            FinishAutoCreatedType(lName,Result,Nil);
             end;
           end
         else
@@ -860,7 +886,7 @@ begin
         if (Result=Nil) and AllowCreate then
           begin
           Result:=CreatePascalType(-1,ptArray,lName,lPascalName,lSchema);
-          AddType(lName,Result);
+          FinishAutoCreatedType(lName,Result,lElTypeData);
           end;
         end;
       sstObject:
@@ -874,14 +900,12 @@ begin
           else
             lBaseName:='Nested_'+lSchema.Name;
           lName:='{'+lBaseName+'}';
-          Writeln('Alias ',lName);
           lPascalName:='T'+lBaseName;
           Result:=FindSchemaTypeData(lName);
           if (Result=Nil) and AllowCreate then
             begin
             Result:=CreatePascalType(-1,ptAnonStruct,lName,lPascalName,lSchema);
-            AddType(lName,Result);
-            AddPropertiesToType(Result,lSchema,True);
+            FinishAutoCreatedType(lName,Result,lElTypeData);
             end;
           end;
         end;
@@ -977,6 +1001,8 @@ var
 
 begin
   lType:=CreatePascalType(-1,aType,aSchemaTypeName,aPascalTypeName,aSchema);
+  if not (aType in [ptSchemaStruct,ptAnonStruct,ptArray]) then
+    lType.InterfaceName:=aPascalTypeName;
   AddToTypeMap(aAlias,lType);
   AddAliasType(lType);
 end;