* Serialize arrays of basic types

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

@@ -44,7 +44,7 @@ Type
     procedure GenerateFPCDirectives(modeswitches : array of string);
     procedure GenerateFPCDirectives();
     function GetPascalTypeAndDefault(aType: TSchemaSimpleType; out aPasType, aPasDefault: string) : boolean;
-    function GetJSONDefault(aType: TPropertyType) : String;
+    function GetJSONDefault(aType: TPascalType) : String;
     procedure SetTypeData(aData : TSchemaData);
   public
     Property TypeData : TSchemaData Read FData;
@@ -86,18 +86,26 @@ Type
   protected
     function MustSerializeType(aType : TPascalTypeData) : boolean; virtual;
     function FieldToJSON(aProperty: TPascalPropertyData) : string; virtual;
-    function ArrayMemberToField(aType: TPropertyType; const aPropertyTypeName: String; const aFieldName: string): string; virtual;
-    function FieldToJSON(aType: TPropertyType; aFieldName: String): string; virtual;
+    function ArrayMemberToField(aType: TPascalType; const aPropertyTypeName: String; const aFieldName: string): string; virtual;
+    function FieldToJSON(aType: TPascalType; aFieldName: String): string; virtual;
     procedure GenerateConverters; virtual;
     function JSONToField(aProperty: TPascalPropertyData) : string; virtual;
-    function JSONToField(aType: TPropertyType; const aPropertyTypeName: string; const aKeyName: string): string; virtual;
+    function JSONToField(aType: TPascalType; const aPropertyTypeName: string; const aKeyName: string): string; virtual;
     procedure WriteFieldDeSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData); virtual;
     procedure WriteFieldSerializer(aType : TPascalTypeData; aProperty: TPascalPropertyData); virtual;
+    // Dto (object) type helpers
     procedure WriteDtoObjectSerializer(aType: TPascalTypeData); virtual;
     procedure WriteDtoSerializer(aType: TPascalTypeData); virtual;
     procedure WriteDtoObjectDeserializer(aType: TPascalTypeData); virtual;
     procedure WriteDtoDeserializer(aType: TPascalTypeData); virtual;
     procedure WriteDtoHelper(aType: TPascalTypeData); virtual;
+    // Array type helpers
+    procedure WriteArrayHelper(aType: TPascalTypeData); virtual;
+    procedure WriteArrayHelperDeserialize(aType: TPascalTypeData);
+    procedure WriteArrayHelperDeSerializeArray(aType: TPascalTypeData);
+    procedure WriteArrayHelperImpl(aType: TPascalTypeData);
+    procedure WriteArrayHelperSerialize(aType: TPascalTypeData);
+    procedure WriteArrayHelperSerializeArray(aType: TPascalTypeData);
   public
     procedure Execute(aData: TSchemaData);
     property DataUnitName: string read FDataUnitName write FDataUnitName;
@@ -148,7 +156,7 @@ begin
 end;
 
 
-function TJSONSchemaCodeGenerator.GetJSONDefault(aType: TPropertyType): String;
+function TJSONSchemaCodeGenerator.GetJSONDefault(aType: TPascalType): String;
 
 begin
   case aType of
@@ -352,8 +360,6 @@ begin
       begin
         DoLog('Generating DTO class type %s', [aData.Types[I].PascalName]);
         lName:=aData.Types[I].PascalName;
-        if lName='Tapi_Message' then
-          Writeln('ag');
         WriteDtoType(aData.Types[I]);
         lArray:=aData.FindSchemaTypeData('['+aData.Types[I].SchemaName+']');
         if lArray<>Nil then
@@ -450,11 +456,9 @@ begin
 end;
 
 
-function TSerializerCodeGenerator.FieldToJSON(aType: TPropertyType; aFieldName : String): string;
+function TSerializerCodeGenerator.FieldToJSON(aType: TPascalType; aFieldName : String): string;
 
 begin
-  if aFieldName='options' then
-    Writeln('ah');
   if aType in [ptAnonStruct,ptSchemaStruct] then
   begin
     Result := Format('%s.SerializeObject', [aFieldName]);
@@ -476,6 +480,8 @@ begin
         Result := Format('DateToISO8601(%s,%s)', [aFieldName,Bools[Not ConvertUTC]]);
       ptEnum :
         Result := Format('%s.AsString', [aFieldName]);
+      ptArray:
+        Result := Format('%s.SerializeArray', [aFieldName]);
     else
       Result := aFieldName;
     end;
@@ -490,7 +496,7 @@ begin
 end;
 
 
-function TSerializerCodeGenerator.JSONToField(aType: TPropertyType; const aPropertyTypeName: string; const aKeyName: string): string;
+function TSerializerCodeGenerator.JSONToField(aType: TPascalType; const aPropertyTypeName: string; const aKeyName: string): string;
 
   function ObjectField(lName: string) : string;
   begin
@@ -500,6 +506,14 @@ function TSerializerCodeGenerator.JSONToField(aType: TPropertyType; const aPrope
       Result := Format('aJSON.Get(''%s'',TJSONObject(Nil))', [lName]);
   end;
 
+  function ArrayField(lName: string) : string;
+  begin
+    if DelphiCode then
+      Result := Format('aJSON.GetValue<TJSONArray>(''%s'',Nil)', [lName])
+    else
+      Result := Format('aJSON.Get(''%s'',TJSONArray(Nil))', [lName]);
+  end;
+
 var
   lPropType,
   lPasDefault: string;
@@ -509,6 +523,10 @@ begin
   begin
     Result := Format('%s.Deserialize(%s)', [aPropertyTypeName, ObjectField(aKeyName)]);
   end
+  else if aType = ptArray then
+  begin
+    Result := Format('%s.Deserialize(%s)', [aPropertyTypeName, ArrayField(aKeyName)]);
+  end
   else
   begin
     case aType of
@@ -545,14 +563,28 @@ begin
 end;
 
 
-function TSerializerCodeGenerator.ArrayMemberToField(aType: TPropertyType; const aPropertyTypeName : String; const aFieldName: string): string;
+function TSerializerCodeGenerator.ArrayMemberToField(aType: TPascalType; const aPropertyTypeName : String; const aFieldName: string): string;
+
+  function getStdType : string;
+  begin
+    case aType of
+      ptFloat32,
+      ptFloat64: Result:='Float';
+      ptString : Result:='string';
+      ptInteger : Result:='Integer';
+      ptInt64 : Result:='Int64';
+      ptBoolean : Result:='Boolean';
+    end;
+  end;
 
 var
-  lPasDefault: string;
+  lType,lPasDefault: string;
 
 begin
   if aType in [ptAnonStruct,ptSchemaStruct] then
     Result := Format('%s.Deserialize(%s as TJSONObject)', [aPropertyTypeName, aFieldName])
+  else if aType = ptArray then
+    Result := Format('%s.Deserialize(%s as TJSONArray)', [aPropertyTypeName, aFieldName])
   else
     begin
     case aType of
@@ -566,18 +598,19 @@ begin
         end;
       ptDateTime:
         Result := Format('%s.AsString', [aFieldName]);
-      ptString,
       ptFloat32,
       ptFloat64,
+      ptString,
       ptInteger,
       ptInt64,
       ptBoolean:
       begin
+        lType:=GetStdType;
         lPasDefault:=GetJSONDefault(aType);
         if DelphiCode then
-          Result := Format('%s.GetValue<%s>('''',%s)', [aFieldName, aPropertyTypeName, lPasDefault])
+          Result := Format('%s.GetValue<%s>('''',%s)', [aFieldName, lType, lPasDefault])
         else
-          Result := Format('%s.As%s', [aFieldName, aPropertyTypeName]);
+          Result := Format('%s.As%s', [aFieldName, lType]);
       end;
       ptAnonStruct:
       begin
@@ -597,7 +630,7 @@ procedure TSerializerCodeGenerator.WriteFieldSerializer(aType : TPascalTypeData;
 
 var
   lAssign, lValue, lKeyName, lFieldName: string;
-  lType: TPropertyType;
+  lType: TPascalType;
   lNilCheck : Boolean;
 
 begin
@@ -647,8 +680,6 @@ begin
     ptArray:
     begin
       Addln('Arr:=TJSONArray.Create;');
-      if lKeyName='options' then
-        Writeln('ah');
       if DelphiCode then
         Addln('Result.AddPair(''%s'',Arr);', [lKeyName])
       else
@@ -706,6 +737,7 @@ begin
       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]);
@@ -896,6 +928,152 @@ begin
   Addln('end;');
 end;
 
+procedure TSerializerCodeGenerator.WriteArrayHelper(aType: TPascalTypeData);
+
+begin
+  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 SerializeArray : TJSONArray;');
+    Addln('function Serialize : String;');
+    end;
+  if stDeserialize in aType.SerializeTypes then
+    begin
+    Addln('class function Deserialize(aJSON : TJSONArray) : %s; overload; static;', [aType.PascalName]);
+    Addln('class function Deserialize(aJSON : String) : %s; overload; static;', [aType.PascalName]);
+    end;
+  undent;
+  Addln('end;');
+end;
+
+procedure TSerializerCodeGenerator.WriteArrayHelperSerializeArray(aType: TPascalTypeData);
+begin
+  Addln('');
+  Addln('function %s.SerializeArray : TJSONArray;',[aType.SerializerName]);
+  Addln('var');
+  indent;
+  Addln('I : Integer;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('Result:=TJSONArray.Create;');
+  Addln('try');
+  indent;
+  Addln('For I:=0 to length(Self)-1 do');
+  Indent;
+  Addln('Result.Add(self[i]);');
+  undent;
+  undent;
+  Addln('except');
+  indent;
+  Addln('Result.Free;');
+  Addln('raise;');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+procedure TSerializerCodeGenerator.WriteArrayHelperSerialize(aType: TPascalTypeData);
+begin
+  Addln('');
+  Addln('function %s.Serialize : String;',[aType.SerializerName]);
+  Addln('var');
+  indent;
+  Addln('lObj : TJSONArray;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('lObj:=SerializeArray;');
+  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.WriteArrayHelperDeSerializeArray(aType: TPascalTypeData);
+var
+  lType : string;
+begin
+  Addln('class function %s.Deserialize(aJSON : TJSONArray) : %s; ', [aType.SerializerName, aType.PascalName]);
+  Addln('');
+  Addln('var');
+  indent;
+  Addln('i : integer;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('SetLength(Result,aJSON.Count);');
+  Addln('For i:=0 to aJSON.Count-1 do');
+  indent;
+  lType:=ArrayMemberToField(aType.ElementTypeData.Pascaltype,aType.ElementTypeData.PascalName,'aJSON[i]');
+  Addln('Result[i]:=%s;',[lType]);
+  undent;
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+procedure TSerializerCodeGenerator.WriteArrayHelperDeserialize(aType: TPascalTypeData);
+begin
+  Addln('class function %s.Deserialize(aJSON : String) : %s; ', [aType.SerializerName,aType.PascalName]);
+  Addln('');
+  Addln('var');
+  indent;
+  Addln('lObj : TJSONData;');
+  Addln('lArr : TJSONArray absolute lobj;');
+  undent;
+  Addln('begin');
+  indent;
+  Addln('lObj:=GetJSON(aJSON);');
+  Addln('try');
+  indent;
+  Addln('Result:=DeSerialize(lArr);');
+  undent;
+  Addln('finally');
+  indent;
+  Addln('lObj.Free;');
+  undent;
+  Addln('end;');
+  undent;
+  Addln('end;');
+  Addln('');
+
+end;
+
+
+procedure TSerializerCodeGenerator.WriteArrayHelperImpl(aType: TPascalTypeData);
+
+begin
+  if stSerialize in aType.SerializeTypes then
+    begin
+    WriteArrayHelperSerializeArray(aType);
+    WriteArrayHelperSerialize(aType);
+    end;
+  if stDeserialize in aType.SerializeTypes then
+    begin
+    WriteArrayHelperDeserializeArray(aType);
+    WriteArrayHelperDeserialize(aType);
+    end;
+end;
+
+
 procedure TSerializerCodeGenerator.GenerateConverters;
 
 begin
@@ -940,9 +1118,15 @@ begin
     Addln('uses');
     indent;
     if DelphiCode then
+      begin
+      AddLn('System.Types,');
       Addln('System.JSON,')
+      end
     else
+      begin
+      AddLn('Types,');
       Addln('fpJSON,');
+      end;
     Addln(DataUnitName+';');
     undent;
     Addln('');
@@ -958,15 +1142,23 @@ begin
             DoLog('Generating serialization helper type %s for Dto %s', [SerializerName, PascalName]);
             WriteDtoHelper(lType);
             Addln('');
+            end
+          else if Pascaltype=ptArray then
+            begin
+            // For arrays of simple types, we need to generate code to read/write the array
+            if (ElementTypeData.Pascaltype=ptArray) and (ElementTypeData.Schema=Nil) then
+              begin
+              WriteArrayHelper(ElementTypeData);
+              end;
             end;
     end;
     undent;
     Addln('implementation');
     Addln('');
     if DelphiCode then
-      Addln('uses System.Generics.Collections, System.SysUtils, System.Types, System.DateUtils, System.StrUtils;')
+      Addln('uses System.Generics.Collections, System.SysUtils, System.DateUtils, System.StrUtils;')
     else
-      Addln('uses Generics.Collections, SysUtils, Types, DateUtils, StrUtils;');
+      Addln('uses Generics.Collections, SysUtils, DateUtils, StrUtils;');
     Addln('');
     GenerateConverters;
     for I := 0 to aData.TypeCount-1 do
@@ -986,6 +1178,14 @@ begin
             WriteDtoObjectDeserializer(aData.Types[I]);
             WriteDtoDeserializer(aData.Types[I]);
           end;
+          end
+        else if lType.Pascaltype=ptArray then
+          begin
+          // For arrays of simple types, we need to generate code to read/write the array
+          if (lType.ElementTypeData.Pascaltype=ptArray) and (lType.ElementTypeData.Schema=Nil) then
+            begin
+            WriteArrayHelperImpl(lType.ElementTypeData);
+            end;
           end;
       end;
     end;

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

@@ -275,7 +275,7 @@ Type
     // Add a type to the list
     Procedure AddType(const aSchemaName: String; aType : TPascalTypeData); virtual;
     // Add a type definition to the type map.
-    procedure AddAliasToTypeMap(aType: TPascalType; const aAlias, aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema); overload;
+    function AddAliasToTypeMap(aType: TPascalType; const aAlias, aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema) : TPascalTypeData; overload;
     // Add a property to a type
     function AddTypeProperty(aType: TPascalTypeData; lProp: TJSONSchema; aName : string = ''; Recurse : Boolean = True): TPascalPropertyData;
     // Add properties to structured pascal type from aSchema. if aSchema = nil then use aType.Schema
@@ -1040,7 +1040,8 @@ begin
 end;
 
 
-procedure TSchemaData.AddAliasToTypeMap(aType : TPascalType; const aAlias,aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema);
+function TSchemaData.AddAliasToTypeMap(aType: TPascalType; const aAlias, aSchemaTypeName, aPascalTypeName: String;
+  aSchema: TJSONSchema): TPascalTypeData;
 
 var
   lType : TPascalTypeData;
@@ -1051,6 +1052,7 @@ begin
     lType.InterfaceName:=aPascalTypeName;
   AddToTypeMap(aAlias,lType);
   AddAliasType(lType);
+  Result:=lType;
 end;
 
 
@@ -1079,24 +1081,40 @@ begin
 end;
 
 procedure TSchemaData.DefineStandardPascalTypes;
+var
+  lArr,lElem : TPascalTypeData;
+
 begin
   // typename--format
-  AddAliasToTypeMap(ptInteger,'integer','integer','integer',Nil);
+  lElem:=AddAliasToTypeMap(ptInteger,'integer','integer','integer',Nil);
+  lArr:=AddAliasToTypeMap(ptArray,'[integer]','[integer]','TIntegerDynArray',Nil);
+  lArr.ElementTypeData:=lElem;
+
   AddAliasToTypeMap(ptInteger,'integer--int32','integer','integer',Nil);
-  AddAliasToTypeMap(ptInt64,'integer--int64','integer','int64',Nil);
-  AddAliasToTypeMap(ptString,'string','string','string',Nil);
+
+  lElem:=AddAliasToTypeMap(ptInt64,'integer--int64','integer','int64',Nil);
+  lArr:=AddAliasToTypeMap(ptArray,'[integer--int64]','[integer--int64]','TInt64DynArray',Nil);
+  lArr.ElementTypeData:=lElem;
+
+  lElem:=AddAliasToTypeMap(ptString,'string','string','string',Nil);
+  lArr:=AddAliasToTypeMap(ptArray,'[string]','[string]','TStringDynArray',Nil);
+  lArr.ElementTypeData:=lElem;
+
   AddAliasToTypeMap(ptDateTime,'string--date','string','TDateTime',Nil);
   AddAliasToTypeMap(ptDateTime,'string--time','string','TDateTime',Nil);
   AddAliasToTypeMap(ptDateTime,'string--date-time','string','TDateTime',Nil);
-  AddAliasToTypeMap(ptBoolean,'boolean','boolean','boolean',Nil);
-  AddAliasToTypeMap(ptFloat64,'number','number','double',Nil);
+
+  lElem:=AddAliasToTypeMap(ptFloat64,'number','number','double',Nil);
+  lArr:=AddAliasToTypeMap(ptArray,'[number]','[number]','TDoubleDynArray',Nil);
+  lArr.ElementTypeData:=lElem;
+
   AddAliasToTypeMap(ptJSON,'JSON','object','string',Nil);
   AddAliasToTypeMap(ptJSON,'any','object','string',Nil);
-  AddAliasToTypeMap(ptArray,'[string]','[string]','TStringDynArray',Nil);
-  AddAliasToTypeMap(ptArray,'[integer]','[integer]','TIntegerDynArray',Nil);
-  AddAliasToTypeMap(ptArray,'[integer--int64]','[integer--int64]','TInt64DynArray',Nil);
-  AddAliasToTypeMap(ptArray,'[number]','[number]','TDoubleDynArray',Nil);
-  AddAliasToTypeMap(ptArray,'[boolean]','[boolean]','TBooleanDynArray',Nil);
+
+  lElem:=AddAliasToTypeMap(ptBoolean,'boolean','boolean','boolean',Nil);
+  lArr:=AddAliasToTypeMap(ptArray,'[boolean]','[boolean]','TBooleanDynArray',Nil);
+  lArr.ElementTypeData:=lElem;
+
 end;