* Generate also string (enum) type definitions

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

@@ -58,10 +58,14 @@ Type
   TTypeCodeGenerator = class(TJSONSchemaCodeGenerator)
   private
     FTypeParentClass: string;
-    procedure WriteDtoConstructor(aType: TPascalTypeData);
-    procedure WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData);
-    procedure WriteDtoType(aType: TPascalTypeData);
-    procedure WriteDtoArrayType(aType: TPascalTypeData);
+    procedure GenerateClassTypes(aData: TSchemaData);
+    procedure GenerateStringTypes(aData: TSchemaData);
+    procedure WriteDtoConstructor(aType: TPascalTypeData); virtual;
+    procedure WriteDtoField(aType: TPascalTypeData; aProperty: TPascalPropertyData); virtual;
+    procedure WriteDtoType(aType: TPascalTypeData); virtual;
+    procedure WriteDtoArrayType(aType: TPascalTypeData); virtual;
+    procedure WriteStringArrayType(aType: TPascalTypeData);
+    procedure WriteStringType(aType: TPascalTypeData); virtual;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Execute(aData: TSchemaData);
@@ -287,6 +291,18 @@ begin
   Addln(Fmt,[aType.PascalName,aType.ElementTypeData.PascalName]);
 end;
 
+procedure TTypeCodeGenerator.WriteStringArrayType(aType: TPascalTypeData);
+
+begin
+  WriteDtoArrayType(aType);
+end;
+
+procedure TTypeCodeGenerator.WriteStringType(aType: TPascalTypeData);
+
+begin
+  Addln('%s = string;',[aType.PascalName]);
+end;
+
 
 constructor TTypeCodeGenerator.Create(AOwner: TComponent);
 begin
@@ -294,12 +310,47 @@ begin
   TypeParentClass := 'TObject';
 end;
 
+procedure TTypeCodeGenerator.GenerateStringTypes(aData : TSchemaData);
 
-procedure TTypeCodeGenerator.Execute(aData: TSchemaData);
+var
+  I: integer;
+  lType,lArray : TPascalTypeData;
+begin
+  for I := 0 to aData.TypeCount-1 do
+    begin
+    lType:=aData.Types[I];
+    if (lType.PascalType=ptString) then
+      begin
+      DoLog('Generating string type %s', [lType.PascalName]);
+      WriteStringType(lType);
+      lArray:=aData.FindSchemaTypeData('['+lType.SchemaName+']');
+      if lArray<>Nil then
+         WriteStringArrayType(lArray);
+      end;
+    end;
+end;
+
+procedure TTypeCodeGenerator.GenerateClassTypes(aData : TSchemaData);
 
 var
   I: integer;
   lArray : TPascalTypeData;
+begin
+  for I := 0 to aData.TypeCount-1 do
+    if aData.Types[I].PascalType in [ptSchemaStruct,ptAnonStruct] then
+      begin
+        DoLog('Generating DTO class type %s', [aData.Types[I].PascalName]);
+        WriteDtoType(aData.Types[I]);
+        lArray:=aData.FindSchemaTypeData('['+aData.Types[I].SchemaName+']');
+        if lArray<>Nil then
+          WriteDtoArrayType(lArray);
+      end
+end;
+
+procedure TTypeCodeGenerator.Execute(aData: TSchemaData);
+
+var
+  I: integer;
 
 begin
   FData := aData;
@@ -319,18 +370,8 @@ begin
     EnsureSection(csType);
     Addln('');
     indent;
-    for I := 0 to aData.TypeCount-1 do
-      if aData.Types[I].PascalType in [ptSchemaStruct,ptAnonStruct] then
-        begin
-          DoLog('Generating type %s', [aData.Types[I].PascalName]);
-          WriteDtoType(aData.Types[I]);
-          lArray:=aData.FindSchemaTypeData('['+aData.Types[I].SchemaName+']');
-          if lArray<>Nil then
-            WriteDtoArrayType(lArray);
-        end;
-{      else if (aData.Types[I].PascalType=ptArray) then
-        WriteDtoArrayType(aData.Types[I]);}
-
+    GenerateStringTypes(aData);
+    GenerateClassTypes(aData);
     undent;
     Addln('implementation');
     Addln('');
@@ -363,6 +404,8 @@ end;
 function TSerializerCodeGenerator.FieldToJSON(aType: TPropertyType; aFieldName : String): string;
 
 begin
+  if aFieldName='options' then
+    Writeln('ah');
   if aType in [ptAnonStruct,ptSchemaStruct] then
   begin
     Result := Format('%s.SerializeObject', [aFieldName]);
@@ -554,6 +597,8 @@ begin
     ptArray:
     begin
       Addln('Arr:=TJSONArray.Create;');
+      if lKeyName='options' then
+        Writeln('ah');
       if DelphiCode then
         Addln('Result.AddPair(''%s'',Arr);', [lKeyName])
       else

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

@@ -65,6 +65,8 @@ Type
 
   { TPascalProperty }
 
+  { TPascalPropertyData }
+
   TPascalPropertyData = class(TObject)
   private
     FSchemaName: string;
@@ -82,6 +84,7 @@ Type
     procedure SetElementTypeNames(aType : TNameType; AValue: String);
     procedure SetEnumValues(AValue: TStrings);
     Function GetTypeName(aType: TNameType) : String;
+    procedure SetTypeData(AValue: TPascalTypeData);
     procedure SetTypeName(aType: TNameType; aValue : String);
   Public
     Constructor Create(const aSchemaName, aPascalName : string);
@@ -106,7 +109,7 @@ Type
     Property ElementTypeNames[aType : TNameType] : String Read GetElementTypeNames Write SetElementTypeNames;
     // PropertyType = ptSchemaStruct: The type data for that component.
     // PropertyType = ptArray and elType=ptSchemaStruct
-    Property TypeData : TPascalTypeData Read FTypeData Write FTypeData;
+    Property TypeData : TPascalTypeData Read FTypeData Write SetTypeData;
     // The JSON Schema for this property
     Property Schema : TJSONSchema Read FSchema Write FSchema;
   end;
@@ -393,6 +396,14 @@ begin
   Result:=GetFallBackTypeName(FPropertyType);
 end;
 
+procedure TPascalPropertyData.SetTypeData(AValue: TPascalTypeData);
+begin
+  if FTypeData=AValue then Exit;
+  FTypeData:=AValue;
+  if Assigned(FTypeData) then
+    FElementType:=FTypeData.Pascaltype;
+end;
+
 function TPascalPropertyData.GetFallBackTypeName(aPropertyType: TPropertyType): string;
 
 begin
@@ -509,6 +520,8 @@ constructor TPascalTypeData.Create(aIndex: integer; aType: TPascalType; const aS
   );
 
 begin
+  if (aType=ptArray) and (Pos('Meeting',aSchemaName)>0) then
+    Writeln('ah');
   FIndex:=aIndex;
   FSchema:=ASchema;
   FSchemaName:=aSchemaName;
@@ -874,9 +887,11 @@ begin
       sstArray:
         begin
         lElTypeData:=GetSchemaTypeData(Nil,lSchema.Items[0]);
+//        if
 //         Data.FindSchemaTypeData('Array of string')
         lPascalName:=ArrayTypePrefix+lElTypeData.PascalName+ArrayTypeSuffix;
-
+        if lElTypeData.SchemaName='MeetingOption' then
+          Writeln('Ah');
         lName:='['+lElTypeData.SchemaName;
         if lSchema.Items[0].Validations.HasKeywordData(jskformat) then
           lName:=lName+'--'+lSchema.Items[0].Validations.Format;
@@ -886,6 +901,8 @@ begin
           lName:='';
         if (Result=Nil) and AllowCreate then
           begin
+          if (lName='[MeetingOption]') then
+            Writeln('ah');
           Result:=CreatePascalType(-1,ptArray,lName,lPascalName,lSchema);
           FinishAutoCreatedType(lName,Result,lElTypeData);
           lName:='';
@@ -935,6 +952,7 @@ begin
   lName:=aName;
   if lName='' then
     lName:=EscapeKeyWord(lProp.Name);
+  Writeln('Adding property name ',lName,' to ',aType.PascalName);
   if lProp.Validations.TypesCount>1 then
     Raise ESchemaData.CreateFmt('Creating property for schema with multiple types ("%s") is not supported',[lName]);
   if (lProp.Validations.GetFirstType=sstArray) then

packages/fcl-openapi/src/fpopenapi.pascaltypes.pp

@@ -824,19 +824,27 @@ procedure TAPIData.CreateDefaultAPITypeMaps(aIncludeServer : Boolean);
 
 var
   I : Integer;
-  lName,lType : String;
+  lName,lTypeName : String;
   lSchema : TJsonSchema;
   lData : TAPITypeData;
+  lType : TSchemaSimpleType;
 
 begin
   For I:=0 to FAPI.Components.Schemas.Count-1 Do
     begin
     lName:=FAPI.Components.Schemas.Names[I];
     lSchema:=FAPI.Components.Schemas.Schemas[lName];
-    if sstObject in lSchema.Validations.Types then
+    lType:=lSchema.Validations.GetFirstType;
+    if (lType in [sstObject,sstString]) then
       begin
-      lType:=EscapeKeyWord(ObjectTypePrefix+lName+ObjectTypeSuffix);
-      lData:=CreatePascalType(I,ptSchemaStruct,lName,lType,lSchema);
+      lTypeName:=EscapeKeyWord(ObjectTypePrefix+lName+ObjectTypeSuffix);
+      case lType of
+        sstObject : lData:=CreatePascalType(I,ptSchemaStruct,lName,lTypeName,lSchema);
+        sstString :
+          begin
+          lData:=CreatePascalType(I,ptString,lName,lTypeName,lSchema);
+          end;
+      end;
       ConfigType(lData);
       AddType(lName,lData);
       AddToTypeMap(lName,lData);