Browse Source

* OpenAPI code generator

Michaël Van Canneyt 9 months ago
parent
commit
4a3b2c3c32

+ 10 - 2
packages/fcl-openapi/fpmake.pp

@@ -72,16 +72,24 @@ begin
      AddUnit('fpopenapi.objects');
      end;
 
-(*
+
+   T:=P.Targets.AddUnit('fpopenapi.generators.pp');
+   with T.Dependencies do
+     begin
+     AddUnit('fpopenapi.pascaltypes');
+     AddUnit('fpopenapi.types');
+     AddUnit('fpopenapi.objects');
+     end;
    T:=P.Targets.AddUnit('fpopenapi.codegen.pp');
    with T.Dependencies do
      begin
      AddUnit('fpopenapi.pascaltypes');
      AddUnit('fpopenapi.types');
      AddUnit('fpopenapi.objects');
+     AddUnit('fpopenapi.generators');
      end;
 
-*) 
+
       
 {$ifndef ALLPACKAGES}
     Run;

+ 677 - 0
packages/fcl-openapi/src/fpopenapi.codegen.pp

@@ -0,0 +1,677 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    Master Open API 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 fpopenapi.codegen;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, strutils, dateutils,  pascodegen, inifiles,
+  fpjson.schema.types,
+  fpjson.schema.Pascaltypes,
+  fpjson.schema.codegen,
+  fpopenapi.objects,
+  fpopenapi.types,
+  fpopenapi.pascaltypes;
+
+Type
+  TUnitKind = (ukDto, ukSerialize, ukClientServiceIntf, ukServerServiceHandler, ukClientServiceImpl, ukServerServiceImpl, ukClientParent, ukServerParent);
+
+const
+  DefaultUnitSuffix = '.{kind}';
+  DefaultUnitExtension = '.pas';
+  DefaultDtoSuffix = 'Dto';
+  DefaultSerializerSuffix = 'Serializer';
+  DefaultClientServiceIntfSuffix = 'Service.Intf';
+  DefaultClientServiceImplSuffix = 'Service.Impl';
+  DefaultServerServiceHandlerSuffix = 'Module.Handler';
+  DefaultServerServiceImplSuffix = 'Module.Impl';
+  DefaultServiceNamePrefix = '';
+  DefaultServiceNameSuffix = 'Service';
+
+
+
+  Suffixes : Array[TUnitKind] of string = (
+     DefaultDtoSuffix,
+     DefaultSerializerSuffix,
+     DefaultClientServiceIntfSuffix,
+     DefaultServerServiceHandlerSuffix,
+     DefaultClientServiceImplSuffix,
+     DefaultServerServiceImplSuffix,
+     '',
+     '');
+
+type
+  { TOpenAPICodeGen }
+
+  TOpenAPICodeGen = class(TComponent)
+  private
+    FAbstractServiceCalls: Boolean;
+    FAPI: TOpenAPI;
+    FAsyncService: boolean;
+    FBaseOutputFileName: string;
+    FClientParentClass: String;
+    FDelphiCode: boolean;
+    FGenerateClient: boolean;
+    FGenerateServer: boolean;
+    FOnLog: TSchemaCodeGenLogEvent;
+    FParentHasCancelRequest: Boolean;
+    FServerParentClass: String;
+    FServiceMap: TStrings;
+    FServiceNamePrefix: String;
+    FServiceNameSuffix: String;
+    FSkipServerServiceImplementationModule: Boolean;
+    FUnitExtension: String;
+    FUnitSuffix: String;
+    FUseEnums: boolean;
+    FUUIDMap: TStrings;
+    FTypeAliases: TStrings;
+    FVerboseHeader: boolean;
+    FUnitNames : Array [TUnitKind] of string;
+    procedure CleanMaps;
+    function GetBaseOutputUnitName: string;
+    function GetUnitName(AIndex: TUnitKind): String;
+    function GetUnitSuffix(aKind: TUnitKind): String;
+    procedure SetUnitName(AIndex: TUnitKind; AValue: String);
+  protected
+    procedure DoLog(const aType: TEventType; const aMessage: string); virtual;
+    procedure DoCodeLog(Sender: TObject; LogType: TCodegenLogType; const Msg: string);
+    procedure DoLog(const aType: TEventType; const aFmt: string; aArgs: array of const);
+    function ResolveUnit(aKind: TUnitKind; FullPath : Boolean = False): String;
+    procedure Configure(aCodegen: TJSONSchemaCodeGenerator); virtual;
+    function CreateAPIData(aAPI: TOpenAPI): TAPIData; virtual;
+
+    procedure GenerateRecordDefs(aData: TAPIData); virtual;
+    procedure GenerateSerializerDefs(aData: TAPIData); virtual;
+    procedure GenerateServiceInterface(aData: TAPIData); virtual;
+    procedure GenerateServiceImplementation(aData: TAPIData); virtual;
+    procedure GenerateServerHandlerModule(aData: TAPIData); virtual;
+    procedure GenerateServerModuleImplementation(aData: TAPIData); virtual;
+    procedure GetUUIDMap(aData: TAPIData);
+    procedure PrepareAPIData(aData: TAPIData); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    // Called during create, use to reset.
+    procedure DefaultSettings;
+    // Load various properties from ini file.
+    procedure LoadConfig(aIni: TCustomIniFile; const aSection: String); virtual;
+    // Load various properties from ini file using the default section.
+    procedure LoadConfig(aConfigFile: String);
+    // Write configuration to .ini
+    procedure SaveConfig(aIni: TCustomIniFile; const aSection: String); virtual;
+    // Write configuration to file
+    procedure SaveConfig(aConfigFile: String);
+    // Generate code.
+    procedure Execute;
+    // The OpenAPI description to work with. Set before calling Execute
+    property API: TOpenAPI read FAPI write FAPI;
+    // Base unit filename
+    property BaseOutputFileName: string read FBaseOutputFileName write FBaseOutputFileName;
+    // Output filename
+    property BaseOutputUnitName: string read GetBaseOutputUnitName;
+    // Aliases for types
+    property TypeAliases: TStrings read FTypeAliases;
+    // InterfaceName:UUID to reuse UUIDS for interfaces.
+    property UUIDMap: TStrings read FUUIDMap;
+    // Map operationId or verb:path to a ServiceName.MethodName pair.
+    property ServiceMap: TStrings read FServiceMap;
+    // Generate Dto/Serializer code compilable with Delphi
+    property DelphiCode: boolean read FDelphiCode write FDelphiCode;
+    // Write command-line options into header
+    property VerboseHeader: boolean read FVerboseHeader write FVerboseHeader;
+    // User enumerateds (default is to use string)
+    property UseEnums: boolean read FUseEnums write FUseEnums;
+    // Generate a service implementation
+    property GenerateServer: boolean read FGenerateServer write FGenerateServer;
+    // Generate a service implementation
+    property GenerateClient: boolean read FGenerateClient write FGenerateClient;
+    // Use async service calls.
+    property AsyncService : boolean Read FAsyncService Write FAsyncService;
+    // Diagnostic messages are written to the log
+    property OnLog: TSchemaCodeGenLogEvent read FOnLog write FOnLog;
+    // Client Service parent has a cancel request method.
+    Property ParentHasCancelRequest : Boolean Read FParentHasCancelRequest Write FParentHasCancelRequest;
+    // How to construct various unit name suffixes: {kind} placeholder. Default is .{Kind};
+    Property UnitSuffix : String read FUnitSuffix Write FUnitSuffix;
+    // Extension for unit files.
+    Property UnitExtension : String Read FUnitExtension Write FUnitExtension;
+    // Dto definition unit file
+    Property DtoUnit : String index ukDto Read GetUnitName Write SetUnitName;
+    // Dto serializer unit file
+    Property SerializeUnit : String index ukSerialize Read GetUnitName Write SetUnitName;
+    // Client service interface definition unit name
+    Property ClientServiceInterfaceUnit : String index ukClientServiceIntf Read GetUnitName Write SetUnitName;
+    // Server service interface definition unit name
+    Property ServerServiceInterfaceUnit : String index ukServerServiceHandler Read GetUnitName Write SetUnitName;
+    // Client service implementation unit name
+    Property ClientServiceImplementationUnit : String index ukClientServiceImpl Read GetUnitName Write SetUnitName;
+    // Server service implementation unit name
+    Property ServerServiceImplementationUnit : String index ukServerServiceImpl Read GetUnitName Write SetUnitName;
+    // Unit containing Client service parent class
+    Property ClientServiceParentUnit : String index ukClientParent Read GetUnitName Write SetUnitName;
+    // Unit containing Server service parent class
+    Property ServerServiceParentUnit : String index ukServerParent Read GetUnitName Write SetUnitName;
+    // Client service parent class name
+    Property ServerServiceParentClass : String Read FServerParentClass Write FServerParentClass;
+    // Server service parent class name
+    Property ClientServiceParentClass : String Read FClientParentClass Write FClientParentClass;
+    // Should the server service implement the methods as abstract ?
+    Property AbstractServiceCalls : Boolean Read FAbstractServiceCalls Write FAbstractServiceCalls;
+    // Skip generation of implementation module (only used when AbstractServiceCalls is True
+    Property SkipServerServiceImplementationModule : Boolean Read FSkipServerServiceImplementationModule Write FSkipServerServiceImplementationModule;
+    // Prefix for client/server service name
+    Property ServiceNameSuffix : String Read FServiceNameSuffix Write FServiceNameSuffix;
+    // Prefix for client/server service name
+    Property ServiceNamePrefix : String Read FServiceNamePrefix Write FServiceNamePrefix;
+    // Prefix for client/server service name
+  end;
+
+
+implementation
+
+uses fpopenapi.generators;
+
+{ TOpenAPICodeGen }
+
+Const
+  DefaultSection                 = 'CodeGen';
+  KeyUnitSuffix                  = 'UnitSuffix';
+  KeyUnitExtension               = 'UnitExtension';
+  KeyDTOUnit                     = 'DtoUnit';
+  KeySerializeUnit               = 'SerializerUnit';
+  KeyClientServiceInterface      = 'ClientServiceInterfaceUnit';
+  KeyServerServiceInterface      = 'ServerServiceInterfaceUnit';
+  KeyClientServiceImplementation = 'ClientServiceImplementationUnit';
+  KeyServerServiceImplementation = 'ServerServiceImplementationUnit';
+  KeyClientParentClass           = 'ClientParentClass';
+  KeyClientParentUnit            = 'ClientParentUnit';
+  KeyServerParentClass           = 'ServerParentClass';
+  KeyServerParentUnit            = 'ServerParentUnit';
+  KeyParentHasCancelRequest      = 'ParentHasCancelRequest';
+  KeyAbstractServiceCalls        = 'AbstractServiceCalls';
+  KeyServiceNameSuffix           = 'ServiceNameSuffix';
+  KeyServiceNamePrefix           = 'ServiceNamePrefix';
+
+{ TOpenAPICodeGen }
+
+constructor TOpenAPICodeGen.Create(AOwner: TComponent);
+
+begin
+  inherited Create(AOwner);
+  FTypeAliases := TStringList.Create;
+  FUUIDMap := TStringList.Create;
+  FServiceMap := TStringList.Create;
+  DefaultSettings;
+end;
+
+
+destructor TOpenAPICodeGen.Destroy;
+
+begin
+  FreeAndNil(FTypeAliases);
+  FreeAndNil(FUUIDMap);
+  FreeAndNil(FServiceMap);
+  inherited Destroy;
+end;
+
+
+procedure TOpenAPICodeGen.DefaultSettings;
+
+var
+  aKind : TUnitKind;
+
+begin
+  GenerateServer:=False;
+  GenerateClient:=True;
+  AbstractServiceCalls:=True;
+  ParentHasCancelRequest:=True;
+  UnitSuffix:=DefaultUnitSuffix;
+  UnitExtension:=DefaultUnitExtension;
+  For aKind in TUnitKind do
+    FUnitNames[aKind]:='';
+  ClientServiceParentClass:='TFPOpenAPIServiceClient';
+  ServerServiceParentClass:='TFPOpenAPIModule';
+  ClientServiceParentUnit:= 'fpopenapiclient';
+  ServerServiceParentUnit:='fpopenapimodule';
+  ServiceNamePrefix:=DefaultServiceNamePrefix;
+  ServiceNameSuffix:=DefaultServiceNameSuffix;
+end;
+
+procedure TOpenAPICodeGen.LoadConfig(aIni : TCustomIniFile; const aSection : String);
+
+var
+  lSection : String;
+
+begin
+  lSection:=aSection;
+  if lSection='' then
+    lSection:=DefaultSection;
+  with aIni do
+    begin
+    UnitSuffix:=ReadString(lSection,KeyUnitSuffix,UnitSuffix);
+    UnitExtension:=ReadString(lSection,KeyUnitExtension,UnitExtension);
+    DtoUnit:=ReadString(lSection,KeyDtoUnit,DtoUnit);
+    SerializeUnit:=ReadString(lSection,KeySerializeUnit,SerializeUnit);
+    ClientServiceInterfaceUnit:=ReadString(lSection,KeyClientServiceInterface,ClientServiceInterfaceUnit);
+    ServerServiceInterfaceUnit:=ReadString(lSection,KeyServerServiceInterface,ServerServiceInterfaceUnit);
+    ClientServiceImplementationUnit:=ReadString(lSection,KeyClientServiceImplementation,ClientServiceImplementationUnit);
+    ServerServiceImplementationUnit:=ReadString(lSection,KeyServerServiceImplementation,ServerServiceImplementationUnit);
+    ClientServiceParentClass:=ReadString(lSection,KeyClientParentClass,ClientServiceParentClass);
+    ClientServiceParentUnit:=ReadString(lSection,KeyClientParentUnit,ClientServiceParentUnit);
+    ServerServiceParentClass:=ReadString(lSection,KeyServerParentClass,ServerServiceParentClass);
+    ServerServiceParentUnit:=ReadString(lSection,KeyServerParentUnit,ServerServiceParentUnit);
+    ParentHasCancelRequest:=ReadBool(lSection,KeyParentHasCancelRequest,ParentHasCancelRequest);
+    AbstractServiceCalls:=ReadBool(lSection,KeyAbstractServiceCalls,AbstractServiceCalls);
+    ServiceNameSuffix:=ReadString(lSection,KeyServiceNameSuffix,ServiceNameSuffix);
+    ServiceNamePrefix:=ReadString(lSection,KeyServiceNamePrefix,ServiceNamePrefix);
+    end;
+end;
+
+procedure TOpenAPICodeGen.LoadConfig(aConfigFile: String);
+
+var
+  lIni : TMemIniFile;
+
+begin
+  lIni:=TMemIniFile.Create(aConfigFile);
+  try
+    LoadConfig(lIni,'');
+  finally
+    lIni.Free;
+  end;
+end;
+
+procedure TOpenAPICodeGen.SaveConfig(aIni : TCustomIniFile; const aSection : String);
+
+var
+  lSection : String;
+
+begin
+  lSection:=aSection;
+  if lSection='' then
+    lSection:=DefaultSection;
+  with aIni do
+    begin
+    WriteString(lSection,KeyUnitSuffix,UnitSuffix);
+    WriteString(lSection,KeyUnitExtension,UnitExtension);
+    WriteString(lSection,KeyDtoUnit,DtoUnit);
+    WriteString(lSection,KeySerializeUnit,SerializeUnit);
+    WriteString(lSection,KeyClientServiceInterface,ClientServiceInterfaceUnit);
+    WriteString(lSection,KeyServerServiceInterface,ServerServiceInterfaceUnit);
+    WriteString(lSection,KeyClientServiceImplementation,ClientServiceImplementationUnit);
+    WriteString(lSection,KeyServerServiceImplementation,ServerServiceImplementationUnit);
+    WriteString(lSection,KeyClientParentClass,ClientServiceParentClass);
+    WriteString(lSection,KeyClientParentUnit,ClientServiceParentUnit);
+    WriteString(lSection,KeyServerParentClass,ServerServiceParentClass);
+    WriteString(lSection,KeyServerParentUnit,ServerServiceParentUnit);
+    WriteBool(lSection,KeyParentHasCancelRequest,ParentHasCancelRequest);
+    WriteBool(lSection,KeyAbstractServiceCalls,AbstractServiceCalls);
+    WriteString(lSection,KeyServiceNameSuffix,ServiceNameSuffix);
+    WriteString(lSection,KeyServiceNamePrefix,ServiceNamePrefix);
+    end;
+end;
+
+procedure TOpenAPICodeGen.SaveConfig(aConfigFile: String);
+
+var
+  lIni : TMemIniFile;
+
+begin
+  lIni:=TMemIniFile.Create(aConfigFile);
+  try
+    SaveConfig(lIni,'');
+    lIni.UpdateFile;
+  finally
+    lIni.Free;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.DoCodeLog(Sender: TObject; LogType: TCodegenLogType;
+  const Msg: string);
+begin
+  if LogType = cltInfo then
+    DoLog(etInfo, Msg)
+  else
+    DoLog(etDebug, Msg);
+end;
+
+
+function TOpenAPICodeGen.GetUnitSuffix (aKind : TUnitKind) : String;
+
+
+var
+  lSuff : String;
+
+begin
+  lSuff:=UnitSuffix;
+  if lSuff='' then
+    lSuff:=DefaultUnitSuffix;
+  Result:=StringReplace(lSuff,'{kind}',Suffixes[aKind],[]);
+end;
+
+function TOpenAPICodeGen.ResolveUnit(aKind: TUnitKind; FullPath: Boolean): String;
+
+begin
+  Result := FUnitNames[aKind];
+  if Result = '' then
+    Result := BaseOutputUnitName + GetUnitSuffix(aKind);
+  if FullPath then
+    Result:=ExtractFilePath(BaseOutputFileName)+Result+UnitExtension;
+end;
+
+
+function TOpenAPICodeGen.GetBaseOutputUnitName: string;
+begin
+  Result := ExtractFileName(BaseOutputFileName);
+end;
+
+function TOpenAPICodeGen.GetUnitName(AIndex: TUnitKind): String;
+begin
+  Result:=FUnitNames[aIndex];
+end;
+
+procedure TOpenAPICodeGen.SetUnitName(AIndex: TUnitKind; AValue: String);
+begin
+  FUnitNames[aIndex]:=aValue;
+end;
+
+procedure TOpenAPICodeGen.DoLog(const aType: TEventType; const aMessage: string);
+begin
+  if Assigned(FOnLog) then
+    FOnLog(aType, aMessage);
+end;
+
+procedure TOpenAPICodeGen.DoLog(const aType: TEventType; const aFmt: string;
+  aArgs: array of const);
+begin
+  if Assigned(FOnLog) then
+    FOnLog(aType, Format(aFmt, aArgs));
+end;
+
+function TOpenAPICodeGen.CreateAPIData(aAPI: TOpenAPI): TAPIData;
+begin
+  Result := TAPIData.Create(aAPI);
+end;
+
+procedure TOpenAPICodeGen.CleanMaps;
+
+  procedure CleanMap(aMap: TStrings);
+  var
+    I, P: integer;
+    S: string;
+  begin
+    for I := aMap.Count - 1 downto 0 do
+    begin
+      S := aMap[I];
+      P := Pos('#', S);
+      if P > 0 then
+      begin
+        S := Trim(Copy(S, 1, P - 1));
+        if S <> '' then
+          aMap[I] := S
+        else
+          aMap.Delete(I);
+      end;
+    end;
+  end;
+
+begin
+  CleanMap(FUUIDMap);
+  CleanMap(FServiceMap);
+end;
+
+procedure TOpenAPICodeGen.PrepareAPIData(aData: TAPIData);
+var
+  I: integer;
+  N, A: string;
+begin
+  for I := 0 to FTypeAliases.Count - 1 do
+  begin
+    FTypeAliases.GetNameValue(I, N, A);
+    if (N <> '') and (A <> '') then
+      aData.AddAliasToTypeMap(ptSchemaStruct, A, N, A, nil);
+  end;
+  CleanMaps;
+  aData.UseEnums := Self.UseEnums;
+  aData.CreateDefaultTypeMaps;
+  aData.CreateDefaultAPITypeMaps(Self.GenerateServer);
+  aData.VoidResultCallbackType:='TVoidResultCallBack';
+  if FServiceMap.Count > 0 then
+    aData.RecordMethodNameMap(FServiceMap);
+  aData.CreateServiceDefs;
+  if (FUUIDMap.Count > 0) then
+    aData.ApplyUUIDMap(FUUIDMap);
+  DoLog(etInfo, 'Found %d Dto types', [aData.APITypeCount]);
+  DoLog(etInfo, 'Created %d services', [aData.ServiceCount]);
+end;
+
+
+procedure TOpenAPICodeGen.GetUUIDMap(aData: TAPIData);
+
+var
+  lType: TAPITypeData;
+  lService: TAPIService;
+  I: integer;
+
+begin
+  for I := 0 to aData.APITypeCount - 1 do
+  begin
+    lType := aData.APITypes[I];
+    FUUIDMap.Values[lType.SchemaName] := lType.InterfaceUUID;
+  end;
+  for I := 0 to aData.ServiceCount - 1 do
+  begin
+    lService := aData.Services[I];
+    FUUIDMap.Values[lService.ServiceName] := lService.ServiceUUID;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.Execute;
+
+var
+  lAPIData: TAPIData;
+
+begin
+  if not assigned(FAPI) then
+    Raise EGenAPI.Create('API not set');
+  lAPIData := CreateAPIData(FAPI);
+  try
+    lAPIData.OnLog := Self.OnLog;
+    lAPIData.DelphiTypes := Self.DelphiCode;
+    lAPIData.ServiceNamePrefix := ServiceNamePrefix;
+    lAPIData.ServiceNameSuffix := ServiceNameSuffix;
+    lAPIData.DtoInterfacePrefix:= DtoInterfacePrefix;
+    PrepareAPIData(lAPIData);
+    GenerateRecordDefs(lAPIData);
+    GenerateSerializerDefs(lAPIData);
+    if GenerateClient then
+      begin
+      GenerateServiceInterface(lAPIData);
+      GenerateServiceImplementation(lAPIData);
+      end;
+    GenerateServerHandlerModule(lAPIData);
+    if AbstractServiceCalls and not SkipServerServiceImplementationModule then
+      GenerateServerModuleImplementation(lAPIData);
+    GetUUIDMap(lAPIData);
+  finally
+    lAPIData.Free;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.Configure(aCodegen: TJSONSchemaCodeGenerator);
+
+begin
+  acodegen.OnLog := @DoCodeLog;
+  acodegen.DelphiCode := Self.DelphiCode;
+  acodegen.VerboseHeader := Self.VerboseHeader;
+  acodegen.WriteClassType := True;
+  if acodegen is TOpenAPIServiceCodeGen then
+    TOpenAPIServiceCodeGen(aCodegen).AsyncService:=Self.AsyncService
+end;
+
+
+procedure TOpenAPICodeGen.GenerateRecordDefs(aData: TAPIData);
+
+var
+  codegen: TDtoCodeGen;
+  lFileName : String;
+
+begin
+  lFileName:=ResolveUnit(ukDto,True);
+  DoLog(etInfo, 'Writing Dto definitions to file "%s"', [lFileName]);
+  codegen := TDtoCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(ukDto);
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.GenerateSerializerDefs(aData: TAPIData);
+
+var
+  codegen: TSerializerCodeGen;
+  lFileName : String;
+
+begin
+  lFileName:=ResolveUnit(ukSerialize,True);
+  DoLog(etInfo, 'Writing serialize helpers to file "%s"', [lFileName]);
+  codegen := TSerializerCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(ukSerialize);
+    codegen.DataUnitName := ResolveUnit(ukDto);
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.GenerateServiceInterface(aData: TAPIData);
+
+var
+  codegen: TServiceInterfaceCodeGen;
+  lFileName : String;
+
+begin
+  lFileName:=ResolveUnit(ukClientServiceIntf,True);
+  DoLog(etInfo, 'Writing service interface to file "%s"', [lFileName]);
+  codegen := TServiceInterfaceCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(ukClientServiceIntf);
+    codegen.DtoUnit := ResolveUnit(ukDto);
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+
+procedure TOpenAPICodeGen.GenerateServiceImplementation(aData: TAPIData);
+
+var
+  codegen: TServiceImplementationCodeGen;
+  lFileName : String;
+
+begin
+  lFileName:=ResolveUnit(ukClientServiceImpl,True);
+  DoLog(etInfo, 'Writing service implementation to file "%s"', [lFileName]);
+  codegen := TServiceImplementationCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(ukClientServiceImpl);
+    codegen.DtoUnit := ResolveUnit(ukDto);
+    codegen.SerializerUnit := ResolveUnit(ukSerialize);
+    codegen.ServiceParentClass := ClientServiceParentClass;
+    codegen.ServiceParentUnit := ClientServiceParentUnit;
+    codegen.ServiceInterfaceUnit := ResolveUnit(ukClientServiceIntf);
+    codegen.ParentHasCancelRequest:=Self.ParentHasCancelRequest;
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+procedure TOpenAPICodeGen.GenerateServerHandlerModule(aData: TAPIData);
+
+var
+  codegen: TServerModuleHandlerCodeGen;
+  lFileName : string;
+  lKind : TUnitKind;
+
+begin
+  if Self.AbstractServiceCalls then
+    lKind:=ukServerServiceHandler
+  else
+    lKind:=ukServerServiceImpl;
+  lFileName:=ResolveUnit(lKind,True);
+  DoLog(etInfo, 'Writing server HTTP handler module implementation to file "%s"', [lFileName]);
+  codegen := TServerModuleHandlerCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(lKind);
+    codegen.DtoUnit := ResolveUnit(ukDto);
+    codegen.SerializerUnit := ResolveUnit(ukSerialize);
+    codegen.ModuleParentClass := ServerServiceParentClass;
+    codegen.AbstractServiceCalls := Self.AbstractServiceCalls;
+    codegen.ModuleParentUnit := ServerServiceParentUnit;
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+
+
+procedure TOpenAPICodeGen.GenerateServerModuleImplementation(aData: TAPIData);
+
+var
+  codegen: TServerImplementationModuleCodeGen;
+  lFileName : string;
+
+begin
+  lFileName:=ResolveUnit(ukServerServiceImpl,True);
+  DoLog(etInfo, 'Writing server HTTP module implementation to file "%s"', [lFileName]);
+  codegen := TServerImplementationModuleCodeGen.Create(Self);
+  try
+    Configure(codegen);
+    codegen.OutputUnitName := ResolveUnit(ukServerServiceImpl);
+    codegen.DtoUnit := ResolveUnit(ukDto);
+    codegen.SerializerUnit := ResolveUnit(ukSerialize);
+    codegen.ModuleParentUnit := ResolveUnit(ukServerServiceHandler);
+    codegen.Execute(aData);
+    codegen.Source.SaveToFile(lFileName);
+  finally
+    codegen.Free;
+  end;
+end;
+
+
+end.

+ 1314 - 0
packages/fcl-openapi/src/fpopenapi.generators.pp

@@ -0,0 +1,1314 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    Open API code generators
+
+    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 fpopenapi.generators;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, dateutils, contnrs, pascodegen,
+  fpjson.schema.types,
+  fpjson.schema.Pascaltypes,
+  fpjson.schema.codegen,
+  fpopenapi.objects,
+  fpopenapi.types,
+  fpopenapi.pascaltypes;
+
+type
+
+  { TJSONSchemaCodeGeneratorHelper }
+
+  // Helper class to generate an API unit header
+  // And to get access
+  TJSONSchemaCodeGeneratorHelper = class helper for TJSONSchemaCodeGenerator
+    procedure GenerateAPIheader;
+    function ApiData: TAPIData;
+  end;
+
+  { TOpenApiPascalCodeGen }
+
+  TOpenApiPascalCodeGen = class(TJSONSchemaCodeGenerator)
+  private
+    function GetData: TAPIData;
+  protected
+    procedure GenerateHeader; override;
+  public
+    property APIData: TAPIData read GetData;
+  end;
+
+  { TDtoCodeGen }
+
+  TDtoCodeGen = class(TTypeCodeGenerator)
+  protected
+    procedure GenerateHeader; override;
+  end;
+
+  { TSerializerCodeGen }
+
+  TSerializerCodeGen = class(TSerializerCodeGenerator)
+  protected
+    procedure GenerateHeader; override;
+  end;
+
+  { TIntfCodeGen }
+
+  { TOpenAPIServiceCodeGen }
+
+  TOpenAPIServiceCodeGen = class(TOpenApiPascalCodeGen)
+  private
+    FDefineServiceResultType: boolean;
+    FDtoUnit: string;
+    FSerializerUnit: string;
+    FServiceName: string;
+    FAsync: boolean;
+    FServiceRequestIDType: string;
+    FServiceResultType: string;
+    function GetServiceRequestIDType: string;
+    function GetServiceResultType: string;
+  protected
+    procedure WriteResultTypes; virtual;
+    procedure WriteCallbackTypes; virtual;
+    procedure GenerateAuxiliaryTypes; virtual;
+    procedure GenerateServiceResultType; virtual;
+    function GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
+    procedure GetMethodCallbackTypeNames(aTypes: TStrings); virtual;
+    procedure GetMethodResultTypeNames(aTypes: TStrings); virtual;
+    function GetMethodResultType(aMethod: TAPIServiceMethod): string; virtual;
+    function MethodResultCallBackName(aMethod: TAPIServiceMethod): string; virtual;
+    function ParameterToArg(Idx: integer; aParam: TAPIServiceMethodParam): string;  virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property ServiceName: string read FServiceName write FServiceName;
+    property DtoUnit: string read FDtoUnit write FDtoUnit;
+    property SerializerUnit: string read FSerializerUnit write FSerializerUnit;
+    property AsyncService: boolean read FAsync write FAsync;
+    property ServiceResultType: string read GetServiceResultType write FServiceResultType;
+    property DefineServiceResultType: boolean read FDefineServiceResultType write FDefineServiceResultType;
+    property ServiceRequestIDType: string read GetServiceRequestIDType write FServiceRequestIDType;
+  end;
+
+  { TServiceInterfaceCodeGen }
+
+  TServiceInterfaceCodeGen = class(TOpenAPIServiceCodeGen)
+  protected
+    procedure GenerateServiceInterface(aService: TAPIService); virtual;
+  public
+    procedure Execute(aData: TAPIData); virtual;
+  end;
+
+  { TServiceImplementationCodeGen }
+
+  TServiceImplementationCodeGen = class(TOpenAPIServiceCodeGen)
+  private
+    FParentHasCancelRequest: boolean;
+    FServiceInterfaceUnit: string;
+    FServiceParentClass: string;
+    FServiceParentUnit: string;
+    procedure SetServiceInterfaceUnit(AValue: string);
+  protected
+    procedure GenerateCancelRequest(aService: TAPIService); virtual;
+    procedure GenerateConstructor(aService: TAPIService); virtual;
+    procedure GenerateServiceImplementationImpl(aService: TAPIService); virtual;
+    procedure GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
+    procedure GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
+    procedure GenerateServiceImplementationDecl(aService: TAPIService); virtual;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Execute(aData: TAPIData); virtual;
+    property ServiceInterfaceUnit: string read FServiceInterfaceUnit write SetServiceInterfaceUnit;
+    property ServiceParentClass: string read FServiceParentClass write FServiceParentClass;
+    property ServiceParentUnit: string read FServiceParentUnit write FServiceParentUnit;
+    property ParentHasCancelRequest: boolean read FParentHasCancelRequest write FParentHasCancelRequest;
+  end;
+
+  { TServerModuleCodeGen }
+
+  { TServerCodeGen }
+
+  TServerCodeGen = class(TOpenAPIServiceCodeGen)
+  private
+    FModuleParentUnit: string;
+    function GetModuleParentUnit: string;
+  protected
+    procedure GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
+    // needed for service registration
+    function GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
+    function GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
+    // Methods for the actual implementation
+    function GetMethodParameterDecl(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam): string; virtual;
+    function GetMethodArgs(aMethod: TAPIServiceMethod): string; virtual;
+    function GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
+    procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); virtual;
+    procedure GenerateServerServiceImplementationDecl(aService: TAPIService;
+      aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean); virtual;
+  public
+    property ModuleParentUnit: string read GetModuleParentUnit write FModuleParentUnit;
+  end;
+
+  // This module generates a complete module that handles the HTTP Requests and hands them off.
+
+  { TServerModuleHandlerCodeGen }
+
+  TServerModuleHandlerCodeGen = class(TServerCodeGen)
+  private
+    FAbstractServiceCalls: boolean;
+    FModuleParentClass: string;
+    class function ConvertToRouteParams(const aPath: string): string;
+    function GetModuleParentCLass: string;
+  protected
+    procedure GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService); virtual;
+    procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); override;
+    procedure WriteConvertArgument(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam); virtual;
+    procedure GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string); virtual;
+  public
+    procedure Execute(aData: TAPIData); virtual;
+    property AbstractServiceCalls: boolean read FAbstractServiceCalls write FAbstractServiceCalls;
+    property ModuleParentClass: string read GetModuleParentClass write FModuleParentClass;
+  end;
+
+  // This module generates a descendant of the server module.
+  // Can be used when TServerModuleCodeGen is used with AbstractServiceCalls = True
+
+  { TServerImplementationModuleCodeGen }
+
+  TServerImplementationModuleCodeGen = class(TServerCodeGen)
+    //  private
+    //    FServerModuleInterfaceUnit: String;
+  public
+    procedure Execute(aData: TAPIData); virtual;
+    //    property ServerModuleInterfaceUnit : String Read FServerModuleInterfaceUnit Write FServerModuleInterfaceUnit;
+  end;
+
+implementation
+
+{ TJSONSchemaCodeGeneratorHelper }
+
+procedure TJSONSchemaCodeGeneratorHelper.GenerateAPIheader;
+var
+  S, lTitle, lDate, lVersion: string;
+  lDescription: TStrings;
+  I: integer;
+begin
+  lDescription:=nil;
+  lDate:=FormatDateTime('yyyy"-"mm"-"dd hh":"nn', Now);
+  lVersion:=APIData.API.Info.Version;
+  lTitle:=APIData.API.Info.Title;
+  if VerboseHeader and (APIData.API.Info.Description<>'') then
+    begin
+    lDescription:=TStringList.Create;
+    lDescription.Text:=APIData.API.Info.Description;
+    end;
+  Addln('{ -----------------------------------------------------------------------');
+  Indent;
+  Addln('Do not edit !');
+  Addln('');
+  Addln('This file was automatically generated on %s.', [lDate]);
+  S:='';
+  for I:=1 to ParamCount do
+    S:=S+' '+ParamStr(i);
+  Addln('Used command-line parameters:');
+  Indent;
+  Addln(S);
+  Undent;
+  Addln('Source OpenAPI document data:');
+  Indent;
+  if lTitle<>'' then
+    Addln('Title: %s', [lTitle]);
+  if lVersion<>'' then
+    Addln('Version: %s', [lVersion]);
+  if Assigned(lDescription) then
+    begin
+    Addln('Description:');
+    for S in lDescription do
+      AddLn(S);
+    end;
+  Undent;
+  Undent;
+  Addln('  -----------------------------------------------------------------------}');
+  FreeAndNil(lDescription);
+end;
+
+function TJSONSchemaCodeGeneratorHelper.ApiData: TAPIData;
+begin
+  Result:=TypeData as TAPIData;
+end;
+
+{ TOpenAPICodeGen }
+
+
+function TOpenApiPascalCodeGen.GetData: TAPIData;
+begin
+  Result:=TypeData as TAPIData;
+end;
+
+procedure TOpenApiPascalCodeGen.GenerateHeader;
+begin
+  GenerateAPIheader;
+end;
+
+{ TDtoCodeGen }
+
+procedure TDtoCodeGen.GenerateHeader;
+begin
+  GenerateAPIheader;
+end;
+
+{ TSerializerCodeGen }
+
+procedure TSerializerCodeGen.GenerateHeader;
+begin
+  GenerateAPIheader;
+end;
+
+{ TOpenAPIerviceCodeGen }
+
+function TOpenAPIServiceCodeGen.MethodResultCallBackName(aMethod:
+  TAPIServiceMethod): string;
+begin
+  Result:=GetMethodResultType(aMethod);
+  if Result<>'' then
+    Result:=Result+'Callback';
+end;
+
+function TOpenAPIServiceCodeGen.ParameterToArg(Idx: integer;
+  aParam: TAPIServiceMethodParam): string;
+begin
+  Result:=Format('%s : %s', [aParam.Name, aParam.TypeName]);
+  if aParam.DefaultValue<>'' then
+    Result:=Result+' = '+aParam.DefaultValue;
+end;
+
+constructor TOpenAPIServiceCodeGen.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  DefineServiceResultType:=False;
+end;
+
+function TOpenAPIServiceCodeGen.GetServiceResultType: string;
+begin
+  Result:=FServiceResultType;
+  if Result = '' then
+    Result:='TServiceResult';
+end;
+
+function TOpenAPIServiceCodeGen.GetServiceRequestIDType: string;
+begin
+  Result:=FServiceRequestIDType;
+  if Result = '' then
+    Result:='TRESTServiceRequestID';
+end;
+
+procedure TOpenAPIServiceCodeGen.GenerateServiceResultType;
+begin
+  if AsyncService then
+    begin
+    Addln('%s = string;', [ServiceRequestIDType]);
+    Addln('');
+    end;
+  if not DelphiCode then
+    Addln('generic %s<T> = record', [ServiceResultType])
+  else
+    Addln(' %s<T> = record', [ServiceResultType]);
+  Indent;
+  Addln('StatusCode : Integer;');
+  Addln('StatusText : String;');
+  if AsyncService then
+    Addln('RequestID : %s;', [ServiceRequestIDType]);
+  Addln('Value : T;');
+  Undent;
+  AddLn('end;');
+  AddLn('');
+end;
+
+function TOpenAPIServiceCodeGen.GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
+
+  procedure AddTo(var S: string; const T: string);
+  begin
+    if T = '' then exit;
+    if S<>'' then
+      S:=S+'; ';
+    S:=S+T;
+  end;
+
+var
+  lBodyType, lResultType, lName, lParams: string;
+  I: integer;
+
+begin
+  lParams:='';
+  // Non-optional
+  for I:=0 to aMethod.ParamCount-1 do
+    if aMethod.Param[I].DefaultValue = '' then
+      AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
+  if Assigned(aMethod.RequestBodyDataType) then
+    lBodyType:=aMethod.RequestBodyDataType.GetTypeName(ntPascal);
+  if lBodyType<>'' then
+    AddTo(lParams, 'aBody : '+lBodyType);
+  if AsyncService then
+    AddTo(lParams, 'aCallback : '+MethodResultCallbackName(aMethod));
+  // Optional
+  for I:=0 to aMethod.ParamCount-1 do
+    if aMethod.Param[I].DefaultValue<>'' then
+      AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
+  lName:=aMethod.MethodName;
+  if aClassName<>'' then
+    lName:=aClassName+'.'+lName;
+  if AsyncService then
+    Result:=Format('Function %s(%s) : %s;', [lName, lParams, ServiceRequestIDType])
+  else
+    begin
+    lResultType:=GetMethodResultType(aMethod);
+    Result:=Format('Function %s(%s) : %s;', [lName, lParams, lResultType]);
+    end;
+end;
+
+procedure TOpenAPIServiceCodeGen.GetMethodCallbackTypeNames(aTypes: TStrings);
+
+var
+  I, J: integer;
+  lName: string;
+  lService: TAPIService;
+  lMethod: TAPIServiceMethod;
+
+begin
+  for I:=0 to APIData.ServiceCount-1 do
+    begin
+    lService:=APIData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      for J:=0 to lService.MethodCount-1 do
+        begin
+        lMethod:=lService.Methods[J];
+        if lMethod.ResultDataType<>nil then
+          begin
+          lName:=MethodResultCallBackName(lMethod);
+          if lName<>'TVoidResultCallBack' then
+            aTypes.AddObject(lName, lMethod);
+          end;
+        end;
+    end;
+end;
+
+procedure TOpenAPIServiceCodeGen.GetMethodResultTypeNames(aTypes: TStrings);
+
+var
+  I, J: integer;
+  lName: string;
+  lService: TAPIService;
+  lMethod: TAPIServiceMethod;
+
+begin
+  for I:=0 to APIData.ServiceCount-1 do
+    begin
+    lService:=APIData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      for J:=0 to lService.MethodCount-1 do
+        begin
+        lMethod:=lService.Methods[J];
+        if lMethod.ResultDataType<>nil then
+          begin
+          lName:=GetMethodResultType(lMethod);
+          if lName<>'' then
+            aTypes.AddObject(lName, lMethod);
+          end;
+        end;
+    end;
+end;
+
+function TOpenAPIServiceCodeGen.GetMethodResultType(aMethod: TAPIServiceMethod): string;
+
+begin
+  Result:=aMethod.ResultDtoType;
+  if Result<>'' then
+    Result:=Result+'ServiceResult'
+  else
+    Result:='TVoidServiceResult';
+end;
+
+
+{ TServiceInterfaceCodeGen }
+
+procedure TServiceInterfaceCodeGen.GenerateServiceInterface(aService: TAPIService);
+
+var
+  I: integer;
+  lDecl, lParent: string;
+  lMethod: TAPIServiceMethod;
+
+begin
+  DoLog('Generating service interface %s (UUID: %s)',
+    [aService.ServiceName, aService.ServiceUUID]);
+  lParent:=aService.ServiceParentInterface;
+  if lParent<>'' then
+    lParent:='('+lParent+')';
+  Addln('// Service %s', [aService.ServiceInterfaceName]);
+  Addln('');
+  Addln('%s = interface %s [''%s'']', [aService.ServiceInterfaceName,
+    lParent, aService.ServiceUUID]);
+  indent;
+  for I:=0 to aService.MethodCount-1 do
+    begin
+    lMethod:=aService.Methods[I];
+    lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
+    Addln(lDecl);
+    end;
+  if AsyncService then
+    Addln('Procedure CancelRequest(aRequestID : %s);', [ServiceRequestIDType]);
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TOpenAPIServiceCodeGen.WriteResultTypes;
+
+var
+  I: integer;
+  lName, lDef, lResType: string;
+  lTypes: TStringList;
+
+begin
+  Addln('// Service result types');
+  lTypes:=TStringList.Create;
+  try
+    lTypes.Sorted:=True;
+    lTypes.Duplicates:=dupIgnore;
+    GetMethodResultTypeNames(lTypes);
+    lTypes.Sorted:=False;
+    for I:=0 to lTypes.Count-1 do
+      begin
+      lName:=lTypes[I];
+      lResType:=TAPIServiceMethod(lTypes.objects[I]).ResultDtoType;
+      lDef:=Format('%s<%s>', [ServiceResultType, lResType]);
+      if not DelphiCode then
+        lDef:='specialize '+lDef;
+      Addln('%s = %s;', [lName, lDef]);
+      end;
+    Addln('');
+  finally
+    lTypes.Free;
+  end;
+end;
+
+procedure TOpenAPIServiceCodeGen.WriteCallbackTypes;
+
+var
+  I: integer;
+  lName, lDef: string;
+  lTypes: TStringList;
+
+begin
+  Addln('// Service Callback types');
+  lTypes:=TStringList.Create;
+  try
+    lTypes.Sorted:=True;
+    lTypes.Duplicates:=dupIgnore;
+    GetMethodCallbackTypeNames(lTypes);
+    lTypes.Sorted:=False;
+    for I:=0 to lTypes.Count-1 do
+      begin
+      lName:=lTypes[I];
+      lDef:=Format('reference to procedure(aResult : %s)', [lName]);
+      Addln('%s = %s;', [lName, lDef]);
+      end;
+    Addln('');
+  finally
+    lTypes.Free;
+  end;
+end;
+
+
+procedure TOpenAPIServiceCodeGen.GenerateAuxiliaryTypes;
+
+begin
+  if DefineServiceResultType then
+    GenerateServiceResultType;
+  WriteResultTypes;
+  if AsyncService then
+    WriteCallbackTypes;
+end;
+
+
+procedure TServiceInterfaceCodeGen.Execute(aData: TAPIData);
+
+var
+  I: integer;
+  lService: TAPIService;
+
+begin
+  SetTypeData(aData);
+  try
+    GenerateHeader;
+    Addln('unit %s;', [Self.OutputUnitName]);
+    Addln('');
+    if AsyncService then
+      GenerateFPCDirectives(['functionreferences'])
+    else
+      GenerateFPCDirectives();
+    Addln('interface');
+    Addln('');
+    Addln('uses');
+    indent;
+    Addln(' fpopenapiclient, %s;', [DtoUnit]);
+    undent;
+    Addln('');
+    EnsureSection(csType);
+    indent;
+    GenerateAuxiliaryTypes;
+    for I:=0 to aData.ServiceCount-1 do
+      begin
+      lService:=aData.Services[I];
+      if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+        GenerateServiceInterface(lService);
+      end;
+    undent;
+    Addln('');
+    Addln('implementation');
+    Addln('');
+    Addln('end.');
+  finally
+    SetTypeData(nil);
+  end;
+end;
+
+{ TServiceImplementationCodeGen }
+
+procedure TServiceImplementationCodeGen.GenerateServiceImplementationDecl(aService: TAPIService);
+
+var
+  I: integer;
+  lDecl, lParent: string;
+  lMethod: TAPIServiceMethod;
+  lName: string;
+
+begin
+  lName:=aService.ServiceProxyImplementationClassName;
+  DoLog('Generating class %s to implement service interface %s', [lName,
+    aService.ServiceName]);
+  lParent:=ServiceParentClass;
+  Addln('// Service %s', [aService.ServiceInterfaceName]);
+  Addln('');
+  if ServiceInterfaceUnit<>'' then
+    Addln('%s = Class (%s,%s)', [lName, lParent, aService.ServiceInterfaceName])
+  else
+    Addln('%s = Class (%s)', [lName, lParent]);
+  Indent;
+  for I:=0 to aService.MethodCount-1 do
+  begin
+    lMethod:=aService.Methods[I];
+    lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
+    Addln(lDecl);
+  end;
+  if not ParentHasCancelRequest then
+    Addln('Procedure CancelRequest(aRequestID : TServiceRequestID);');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+constructor TServiceImplementationCodeGen.Create(AOwner: TComponent);
+
+begin
+  inherited Create(AOwner);
+  ServiceParentClass:='TFPOpenAPIServiceClient';
+  ServiceParentUnit:='fpopenapiclient';
+end;
+
+
+procedure TServiceImplementationCodeGen.GenerateConstructor(aService: TAPIService);
+
+var
+  lName: string;
+
+begin
+  lName:=aService.ServiceProxyImplementationClassName;
+  Addln('Constructor %s.Create(aOwner : TComponent; aWebClient : TFPAbstractWebClient);',
+    [lName]);
+  Addln('begin');
+  indent;
+  Addln('Inherited Create(aOwner);');
+  // We can try to put http/authenticator in a parent class ?
+  Addln('WebClient:=aWebClient;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TServiceImplementationCodeGen.SetServiceInterfaceUnit(AValue: string);
+
+begin
+  if FServiceInterfaceUnit = AValue then Exit;
+  FServiceInterfaceUnit:=AValue;
+end;
+
+
+procedure TServiceImplementationCodeGen.GenerateCancelRequest(aService: TAPIService);
+
+var
+  lName: string;
+
+begin
+  lName:=aService.ServiceProxyImplementationClassName;
+  Addln('Procedure %s.CancelRequest(aRequestID : TServiceRequestID);', [lName]);
+  Addln('');
+  Addln('begin');
+  indent;
+  Addln('WebClient.CancelRequest(aRequestID);');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TServiceImplementationCodeGen.GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod);
+
+var
+  I: integer;
+  lParam: TAPIServiceMethodParam;
+  lParamName: string;
+
+begin
+  Addln('lURL:=BuildEndPointURL(lMethodURL);');
+  if aMethod.HasQueryParam then
+    Addln('lQuery:='''';');
+  if aMethod.Operation.HasKeyWord(okParameters) then
+    begin
+    for I:=0 to aMethod.Operation.Parameters.Count-1 do
+      begin
+      lParam:=aMethod.Param[I];
+      if lParam.Location = plPath then
+        begin
+        lParamName:=lParam.OriginalName;
+        Addln('lUrl:=ReplacePathParam(lURL,''%s'',%s);',
+          [lParamName, lParam.AsStringValue]);
+        end;
+      end;
+    for I:=0 to aMethod.Operation.Parameters.Count-1 do
+      begin
+      lParam:=aMethod.Param[I];
+      if lParam.Location = plQuery then
+        begin
+        lParamName:=lParam.OriginalName;
+        Addln('lQuery:=ConcatRestParam(lQuery,''%s'',%s);', [lParamName, lParam.AsStringValue]);
+        end;
+      end;
+    end;
+  if aMethod.HasQueryParam then
+    Addln('lURL:=lURL+lQuery;');
+end;
+
+
+procedure TServiceImplementationCodeGen.GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod);
+
+var
+  lDecl: string;
+  lHTTPMethod: string;
+  lBodyArg: string;
+  lName: string;
+
+begin
+  lName:=aService.ServiceProxyImplementationClassName;
+  lDecl:=GenerateClientServiceMethodDecl(aMethod, lName);
+  Addln(lDecl);
+  Addln('');
+  Addln('const');
+  indent;
+  Addln('lMethodURL = ''%s'';', [aMethod.Path.PathComponent]);
+  undent;
+  Addln('');
+  Addln('var');
+  indent;
+  Addln('lURL : String;');
+  Addln('lResponse : TServiceResponse;');
+  if aMethod.HasQueryParam then
+    Addln('lQuery : String;');
+  undent;
+  Addln('');
+  Addln('begin');
+  indent;
+  Addln('Result:=Default(%s);', [GetMethodResultType(aMethod)]);
+  GenerateURLConstruction(aService, aMethod);
+  lHTTPMethod:=aMethod.Operation.PathComponent;
+  if aMethod.RequestBodyDataType<>nil then
+    lBodyArg:='aBody.Serialize'
+  else
+    lBodyArg:='''''';
+  Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s);', [lHTTPMethod, lBodyArg]);
+  AddLn('Result:=%s.Create(lResponse);', [GetMethodResultType(aMethod)]);
+  if aMethod.ResultDataType<>nil then
+    begin
+    Addln('if Result.Success then');
+    indent;
+    Addln('Result.Value:=%s.Deserialize(lResponse.Content);', [aMethod.ResultDtoType]);
+    Undent;
+    end
+  else
+    Addln('Result.Value:=Result.Success;');
+  undent;
+  Addln('end;');
+  Addln('');
+end;
+
+procedure TServiceImplementationCodeGen.GenerateServiceImplementationImpl(aService: TAPIService);
+
+var
+  I: integer;
+  lName: string;
+
+begin
+  lName:=aService.ServiceProxyImplementationClassName;
+  DoLog('Generating implementation for class %s', [lName]);
+  if AsyncService then
+    GenerateCancelRequest(aService);
+  for I:=0 to aService.MethodCount-1 do
+    GenerateServiceMethodImpl(aService, aService.Methods[I]);
+end;
+
+procedure TServiceImplementationCodeGen.Execute(aData: TAPIData);
+
+var
+  I: integer;
+  lService: TAPIService;
+
+begin
+  SetTypeData(aData);
+  GenerateHeader;
+  Addln('unit %s;', [Self.OutputUnitName]);
+  Addln('');
+  if AsyncService then
+    GenerateFPCDirectives(['functionreferences, anonymousfunctions'])
+  else
+    GenerateFPCDirectives();
+  Addln('interface');
+  Addln('');
+  Addln('uses');
+  indent;
+  AddLn('fpopenapiclient');
+  if ServiceInterfaceUnit<>'' then
+    Addln(', %s                     // Service definition ', [ServiceInterfaceUnit]);
+  if (ServiceParentUnit<>'') and not SameText(ServiceParentUnit, 'fpopenapiclient') then
+    Addln(', %s                     // Service parent class ', [ServiceParentUnit]);
+  Addln(', %s;', [DtoUnit]);
+  undent;
+  Addln('');
+  EnsureSection(csType);
+  indent;
+  if ServiceInterfaceUnit = '' then
+    GenerateAuxiliaryTypes;
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      GenerateServiceImplementationDecl(lService);
+    end;
+  undent;
+  Addln('');
+  Addln('implementation');
+  Addln('');
+  Addln('uses');
+  indent;
+  if DelphiCode then
+    Addln('System.SysUtils')
+  else
+    Addln('SysUtils');
+  Addln(', %s;', [SerializerUnit]);
+  undent;
+  Addln('');
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      GenerateServiceImplementationImpl(lService);
+    end;
+  Addln('');
+  Addln('end.');
+end;
+
+{ TServerModuleCodeGen }
+
+function TServerCodeGen.GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string;
+
+var
+  lMethodName: string;
+
+begin
+  lMethodName:=aMethod.MethodName;
+  lMethodName:='Handle'+lMethodName+'Request';
+  if aClassName<>'' then
+    lMethodName:=aClassName+'.'+lMethodName;
+  Result:=lMethodName;
+end;
+
+function TServerCodeGen.GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
+
+var
+  lMethodName: string;
+
+begin
+  lMethodName:=GetMethodHandleRequestName(aMethod, aClassName);
+  Result:=Format('Procedure %s(aRequest : TRequest; aResponse : TResponse);',
+    [lMethodName]);
+  if aclassName = '' then
+    Result:=Result+' virtual;';
+end;
+
+
+function TServerCodeGen.GetMethodParameterDecl(aMethod: TAPIServiceMethod;
+  aParam: TAPIServiceMethodParam): string;
+
+begin
+  Result:=aParam.Name+': ';
+  Result:=Result+aParam.TypeName;
+end;
+
+
+function TServerCodeGen.GetMethodArgs(aMethod: TAPIServiceMethod): string;
+
+var
+  I: integer;
+
+begin
+  Result:='';
+  for I:=0 to aMethod.ParamCount-1 do
+    begin
+    if Result<>'' then
+      Result:=Result+'; ';
+    Result:=Result+GetMethodParameterDecl(aMethod, aMethod.Param[i]);
+    end;
+  if aMethod.RequestBodyDataType<>nil then
+    begin
+    if Result<>'' then
+      Result:=Result+'; ';
+    Result:=Result+'aBody : '+aMethod.RequestBodyDataType.PascalName;
+    end;
+end;
+
+function TServerCodeGen.GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
+var
+  lMethodArgs: string;
+  lMethodName: string;
+  lResultType: string;
+begin
+  lMethodName:=aMethod.MethodName;
+  if aClassName<>'' then
+    lMethodName:=aClassName+'.'+lMethodName;
+  lResultType:=aMethod.ResultDtoType;
+  lMethodArgs:=GetMethodArgs(aMethod);
+  if lResultType = '' then
+    Result:=Format('procedure %s(%s);', [lMethodName, lMethodArgs])
+  else
+    Result:=Format('function %s(%s) : %s;', [lMethodName, lMethodArgs, lResultType]);
+end;
+
+
+procedure TServerCodeGen.GenerateServerServiceImplementationDecl(aService: TAPIService;
+  aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean);
+
+var
+  lDecl: string;
+  lMethod: TAPIServiceMethod;
+  I: integer;
+
+begin
+  Addln('%s = class(%s)', [aModuleName, aParentModule]);
+  Addln('Public');
+  Indent;
+  if IsHandler then
+    begin
+    Addln('class Procedure RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False); override;');
+    for I:=0 to aService.MethodCount-1 do
+      begin
+      lMethod:=aService.Methods[i];
+      lDecl:=GetServerServiceHandleMethodDecl(lMethod, '');
+      Addln(lDecl);
+      end;
+    end;
+  AddLn('');
+
+  for I:=0 to aService.MethodCount-1 do
+    begin
+    lMethod:=aService.Methods[i];
+    lDecl:=GetServerServiceMethodDecl(lMethod, '');
+    if isHandler then
+      begin
+      lDecl:=lDecl+' virtual;';
+      if isAbstract then
+        lDecl:=lDecl+' abstract;';
+      end
+    else
+      lDecl:=lDecl+' override;';
+
+    Addln(lDecl);
+    end;
+  undent;
+  AddLn('end;');
+  AddLn('');
+end;
+
+class function TServerModuleHandlerCodeGen.ConvertToRouteParams(const aPath: string): string;
+
+begin
+  Result:=StringReplace(aPath, '{', ':', [rfReplaceAll]);
+  Result:=StringReplace(Result, '}', '', [rfReplaceAll]);
+end;
+
+procedure TServerModuleHandlerCodeGen.GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService);
+
+const
+  lRegisterCall = 'RegisterOpenAPIRoute(aBaseURL,''%s'',@%s,aUseStreaming);';
+
+var
+  I: integer;
+  lMethod: TAPIServiceMethod;
+  lDecl, lEndPoint: string;
+
+begin
+  Addln('class Procedure %s.RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False);', [aClassName]);
+  Addln('begin');
+  Indent;
+  for I:=0 to aService.MethodCount-1 do
+    begin
+    lMethod:=aService.Methods[i];
+    lDecl:=GetMethodHandleRequestName(lMethod, '');
+    lEndPoint:=ConvertToRouteParams(lMethod.Path.PathComponent);
+    Addln(lRegisterCall, [lEndPoint, lDecl]);
+    end;
+  Undent;
+  Addln('end;');
+  Addln('');
+end;
+
+
+procedure TServerModuleHandlerCodeGen.WriteConvertArgument(aMethod: TAPIServiceMethod;
+  aParam: TAPIServiceMethodParam);
+
+const
+  LocationNames: array[TParamLocation] of string =
+    ('alQuery', 'alPath', 'alHeader', 'alCookie');
+
+var
+  lDefault: string;
+  lLocation: string;
+  lLocalName: string;
+  lParamName: string;
+
+begin
+  lParamName:=aParam.OriginalName;
+  lLocalName:='_'+aParam.Name;
+  lDefault:=aParam.DefaultValue;
+  if lDefault = '' then
+    case aParam.ArgType of
+      ptString: lDefault:='''''';
+      ptInteger: lDefault:='0';
+      ptInt64: lDefault:='Int64(0)';
+      ptDateTime: lDefault:='TDateTime(0.0)';
+      ptFloat32: lDefault:='0.0';
+      ptFloat64: lDefault:='0.0';
+    end;
+  lLocation:=LocationNames[aParam.Location];
+  AddLn('%s:=ExtractRequestArgument(aRequest,%s,''%s'',%s);',
+    [lLocalName, lLocation, lParamName, lDefault]);
+end;
+
+procedure TServerModuleHandlerCodeGen.GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
+
+var
+  lResultType: string;
+  lCallArgs: string;
+  i: integer;
+
+  procedure AddToArgs(aName: string);
+  begin
+    if lCallArgs<>'' then
+      lCallargs:=lCallArgs+';';
+    lCallargs:=lCallArgs+aName;
+  end;
+
+begin
+  AddLn(GetServerServiceHandleMethodDecl(lMethod, aClassName));
+  lResultType:=lMethod.ResultDtoType;
+  Addln('');
+  Addln('var');
+  indent;
+  Addln('lResult : %s;', [lResultType]);
+  for I:=0 to lMethod.ParamCount-1 do
+    begin
+    Addln('_%s;', [GetMethodParameterDecl(lMethod, lMethod.Param[i])]);
+    AddToArgs('_'+lMethod.Param[I].Name);
+    end;
+  if lMethod.RequestBodyDataType<>nil then
+    begin
+    Addln('_Body : %s;', [lMethod.RequestBodyDataType.PascalName]);
+    AddToArgs('_lBody');
+    end;
+  undent;
+  Addln('');
+  Addln('begin');
+  indent;
+  Addln('lResult:=Default(%s);', [lResultType]);
+  Addln('try');
+  Indent;
+  Addln('if PrepareRequest(aRequest,aResponse) then');
+  Indent;
+  Addln('begin');
+  if lResultType<>'' then
+    begin
+    for I:=0 to lMethod.ParamCount-1 do
+      WriteConvertArgument(lMethod, lMethod.Param[i]);
+    if lMethod.RequestBodyDataType<>nil then
+      AddLn('_lBody:=%s.Deserialize;', [lMethod.RequestBodyDataType.PascalName]);
+    Addln('lResult:=%s(%s);', [lMethod.MethodName, lCallArgs]);
+    if WriteClassType then
+      begin
+      Addln('try');
+      Indent;
+      Addln('aResponse.Content:=lResult.Serialize;');
+      end;
+    end
+  else
+    Addln('%s;', [lMethod.MethodName]);
+  if (lResultType<>'') and WriteClassType then
+    begin
+    Undent;
+    Addln('finally');
+    Indent;
+    Addln('FreeAndNil(lResult);');
+    Undent;
+    Addln('end;'); // Finally
+    end;
+  Addln('end;'); // if PrepareRequest
+  Undent;
+  Addln('ProcessResponse(aRequest,aResponse);');
+  Undent;
+  Addln('except');
+  Indent;
+  Addln('on E : Exception do');
+  Indent;
+  Addln('HandleRequestError(E,aRequest,aResponse);');
+  Undent;
+  Undent;
+  Addln('end;'); // except
+  undent;
+  Addln('end;'); // handlerequest
+  Addln('');
+end;
+
+
+procedure TServerCodeGen.GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
+
+var
+  lResultType, lDecl: string;
+
+begin
+  lDecl:=GetServerServiceMethodDecl(lMethod, aClassName);
+  lResultType:=lMethod.ResultDtoType;
+  AddLn(lDecl);
+  Addln('');
+  Addln('begin');
+  Indent;
+  AddLn('Result:=Default(%s);', [lResultType]);
+  Undent;
+  Addln('end;');
+  Addln('');
+end;
+
+procedure TServerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean);
+
+var
+  lMethod: TAPIServiceMethod;
+  I: integer;
+
+begin
+  AddLn('');
+  if not IsAbstract then
+    begin
+    for I:=0 to aService.MethodCount-1 do
+      begin
+      lMethod:=aService.Methods[i];
+      GenerateServerServiceMethodImpl(lMethod, aModuleName);
+      end;
+    AddLn('');
+    end;
+end;
+
+
+function TServerModuleHandlerCodeGen.GetModuleParentCLass: string;
+
+begin
+  Result:=FModuleParentClass;
+  if Result = '' then
+    Result:='TFPOpenAPIModule';
+end;
+
+
+function TServerCodeGen.GetModuleParentUnit: string;
+
+begin
+  Result:=FModuleParentUnit;
+  if Result = '' then
+    Result:='fpopenapimodule';
+end;
+
+
+procedure TServerModuleHandlerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; IsAbstract: boolean);
+
+var
+  I: integer;
+  lMethod: TAPIServiceMethod;
+
+begin
+  GenerateRegisterAPIRoutes(aModuleName, aService);
+  for I:=0 to aService.MethodCount-1 do
+   begin
+    lMethod:=aService.Methods[i];
+    GenerateServerServiceHandleMethodImpl(lMethod, aModuleName);
+   end;
+  inherited GenerateServerServiceImplementationImpl(aService, aModuleName, isAbstract);
+end;
+
+
+procedure TServerModuleHandlerCodeGen.Execute(aData: TAPIData);
+
+var
+  I: integer;
+  lService: TAPIService;
+  lName: string;
+
+begin
+  SetTypeData(aData);
+  GenerateHeader;
+  GenerateFPCDirectives();
+  Addln('unit %s;', [Self.OutputUnitName]);
+  Addln('');
+  if AsyncService then
+    GenerateFPCDirectives();
+  Addln('interface');
+  Addln('');
+  Addln('uses');
+  indent;
+  AddLn('%s, httpprotocol, httpdefs, fphttpapp, httproute, %s;',
+    [ModuleParentUnit, DtoUnit]);
+  undent;
+  Addln('');
+  EnsureSection(csType);
+  indent;
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      begin
+      if AbstractServiceCalls then
+        lName:='TAbstract'+lService.ServiceName+'Module'
+      else
+        lName:='T'+lService.ServiceName+'Module';
+      GenerateServerServiceImplementationDecl(
+        lService, ModuleParentClass, lName, AbstractServiceCalls, True);
+      end;
+    end;
+  undent;
+  Addln('');
+  Addln('implementation');
+  Addln('');
+  Addln('uses');
+  indent;
+  if DelphiCode then
+    Addln('System.SysUtils')
+  else
+    Addln('SysUtils');
+  Addln(', %s;', [SerializerUnit]);
+  undent;
+  Addln('');
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      begin
+      if AbstractServiceCalls then
+        lName:='TAbstract'+lService.ServiceName+'Module'
+      else
+        lName:='T'+lService.ServiceName+'Module';
+      GenerateServerServiceImplementationImpl(lService, lName, AbstractServiceCalls);
+      end;
+    end;
+  Addln('');
+  Addln('end.');
+end;
+
+{ TServerImplementationModuleCodeGen }
+
+procedure TServerImplementationModuleCodeGen.Execute(aData: TAPIData);
+
+var
+  I: integer;
+  lService: TAPIService;
+  lName, lParentName: string;
+
+begin
+  SetTypeData(aData);
+  GenerateHeader;
+  GenerateFPCDirectives();
+  Addln('unit %s;', [Self.OutputUnitName]);
+  Addln('');
+  if AsyncService then
+    GenerateFPCDirectives();
+  Addln('interface');
+  Addln('');
+  Addln('uses');
+  indent;
+  AddLn('%s, %s;', [ModuleParentUnit, DtoUnit]);
+  undent;
+  Addln('');
+  EnsureSection(csType);
+  indent;
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      begin
+      lName:='T'+lService.ServiceName+'Module';
+      lParentName:='TAbstract'+lService.ServiceName+'Module';
+      GenerateServerServiceImplementationDecl(lService, lParentName, lName, False, False);
+      end;
+    end;
+  undent;
+  Addln('');
+  Addln('implementation');
+  Addln('');
+  Addln('uses');
+  indent;
+  if DelphiCode then
+    Addln('System.SysUtils')
+  else
+    Addln('SysUtils');
+  Addln(', %s;', [SerializerUnit]);
+  undent;
+  Addln('');
+  for I:=0 to aData.ServiceCount-1 do
+    begin
+    lService:=aData.Services[I];
+    if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
+      begin
+      lName:='T'+lService.ServiceName+'Module';
+      GenerateServerServiceImplementationImpl(lService, lName, False);
+      end;
+    end;
+  Addln('');
+  Addln('end.');
+end;
+
+
+end.

+ 92 - 56
packages/fcl-openapi/src/fpopenapi.pascaltypes.pp

@@ -58,7 +58,7 @@ type
   { TAPIServiceMethod }
 
   { TAPIServiceMethodParam }
-  TParamLocation = (plQuery,plPath);
+  TParamLocation = (plQuery,plPath,plHeader,plCookie);
 
   TAPIServiceMethodParam = Class(TObject)
   private
@@ -93,18 +93,18 @@ type
 
   TAPIServiceMethod = Class(TObject)
   private
-    FBodyType: String;
+    FBodyType: TAPITypeData;
     FMethodName: String;
     FOperation: TApiOperation;
     FResultCallbackType: String;
-    FResultClassType: String;
-    FResultDtoType: String;
-    FResultType: String;
+    FResultDataType: TAPITypeData;
     FService: TAPIService;
     FPath : TPathItem;
     FParams : TFPObjectList;
     function GetParam(aIndex : Integer): TAPIServiceMethodParam;
     function GetParamCount: Integer;
+    function GetRequestBodyType: String;
+    function GetResultType(AIndex: TNameType): String;
   protected
     // override this if you want to subclass the parameter
     function CreateParam(const aType: TPascaltype; const aOriginalName, aName, aTypeName: String; aParam: TParameter     ): TAPIServiceMethodParam; virtual;
@@ -116,22 +116,25 @@ type
     function AddParam(const aType: TPascalType; const aOriginalName, aName, aTypeName: String; aParam: TParameter
       ): TAPIServiceMethodParam;
     // Find parameter methods by name.
-    Function ParamByNAme(aOriginalName : String) : TAPIServiceMethodParam;
+    Function ParamByName(aOriginalName : String) : TAPIServiceMethodParam;
     // Does this class have parameters with location 'path'
     function HasPathParam: Boolean;
     // Does this class have parameters with location 'query'
     Function HasQueryParam : Boolean;
     // Does this method have parameters with default values ?
     Function HasOptionalParams : Boolean;
-
     // Pascal type of request body. May be empty.
-    Property RequestBodyType : String Read FBodyType Write FBodyType;
+    Property RequestBodyType : String Read GetRequestBodyType; deprecated;
+    // Pascal type of request body. May be empty.
+    Property RequestBodyDataType : TAPITypeData Read FBodyType Write FBodyType;
+    // Result data type. Can be nil
+    Property ResultDataType : TAPITypeData Read FResultDataType Write FResultDataType;
     // Result type. Can be empty
-    Property ResultType : String Read FResultType Write FResultType;
+    Property ResultType : String index ntInterface Read GetResultType;
     // Component result class type.
-    Property ResultClassType : String Read FResultClassType Write FResultClassType;
+    Property ResultClassType : String index ntImplementation Read GetResultType;
     // Component result Dto type
-    Property ResultDtoType : String Read FResultDtoType Write FResultDtoType;
+    Property ResultDtoType : String index ntPascal Read GetResultType;
     // Callback type for result.
     Property ResultCallBackType : String Read FResultCallbackType write FResultCallBackType;
     // OpenAPI Operation for this method.
@@ -152,10 +155,10 @@ type
   private
     FMethods : TFPObjectList;
     FNeedsAuthentication: Boolean;
-    FServiceImplementationClassName: String;
     FServiceInterfaceName: string;
     FServiceName: string;
     FServiceParentInterface: String;
+    FServiceProxyImplementationClassName: String;
     FServiceUUID: string;
     function GetMethod(aIndex : Integer): TAPIServiceMethod;
     function GetMethodCount: Integer;
@@ -183,7 +186,7 @@ type
     // Service interface UUID
     Property ServiceUUID : string Read GetServiceUUID Write FServiceUUID;
     // Service interface implementation Class Name
-    Property ServiceImplementationClassName : String Read GetServiceImplementationClassName Write FServiceImplementationClassName;
+    Property ServiceProxyImplementationClassName : String Read GetServiceImplementationClassName Write FServiceProxyImplementationClassName;
     // Indexed access to methods.
     Property Methods[aIndex : Integer]: TAPIServiceMethod Read GetMethod;
     // Number of methods.
@@ -232,16 +235,16 @@ type
     function GenerateServiceName(const aUrl : String; const aPath: TPathItem; aOperation: TAPIOperation): String;virtual;
     // Create a new service definition. Override this if you want to subclass it.
     function CreateService(const aName: String): TAPIService; virtual;
-    // Add a service
-    function AddService(const aName: String) : TAPIService;
     // Configure a service
     procedure ConfigService(const aService: TAPIService); virtual;
     // Generate the name of the method, based on URL/Operation. Takes into account the mapping.
     function GenerateServiceMethodName(const aUrl : String; const aPath: TPathItem; aOperation: TAPIOperation): String; virtual;
     // Return the request body type. The application/json content type is used.
-    function GetMethodRequestBodyType(aMethod: TAPIServiceMethod): string; virtual;
+    function GetMethodRequestBodyType(aMethod: TAPIServiceMethod): TAPITypeData; virtual;
+    // Return the method result type
+    function GetMethodResultTypeData(aMethod: TAPIServiceMethod): TAPITypeData; virtual;
     // Return the method result type
-    function GetMethodResultType(aMethod: TAPIServiceMethod; aNameType: TNameType): String; virtual;
+    function GetMethodResultType(aMethod: TAPIServiceMethod; aNameType: TNameType): String; virtual; deprecated;
     // Return the method result callback name
     function GenerateMethodResultCallBackName(aMethod: TAPIServiceMethod): String; virtual;
     // Configure the service method. Called after it is created.
@@ -253,16 +256,18 @@ type
     // Check the output of various operations of a OpenAPI path item. Used in determining the need for deserialization
     function CheckOperationsOutput(aPath: TPathItem; aData: TAPITypeData): Boolean;
     // Check input/output for serialization
-    procedure CheckInputOutput;
+    procedure CheckInputOutput(aIncludeServer : Boolean);
   Public
     // Create. API must be alive while the data is kept alive.
     constructor Create(aAPI : TOpenAPI); reintroduce;
     // Destroy
     destructor Destroy; override;
+    // Add a service
+    function AddService(const aName: String) : TAPIService;
     // Create default type maps (integer,string etc.)
     Procedure CreateDefaultTypeMaps; virtual;
     // Create default API type maps (#components in openapi)
-    Procedure CreateDefaultAPITypeMaps;
+    Procedure CreateDefaultAPITypeMaps(aIncludeServer : Boolean);
     // Create service defs from paths. Call RecordMethodNameMap first)
     Procedure CreateServiceDefs; virtual;
     // Get schema element typename of aRef. For components, return requested name
@@ -422,9 +427,9 @@ end;
 
 function TAPIService.GetServiceImplementationClassName: String;
 begin
-  Result:=FServiceImplementationClassName;
+  Result:=FServiceProxyImplementationClassName;
   if Result='' then
-    Result:='T'+ServiceName;
+    Result:='T'+ServiceName+'Proxy';
 end;
 
 function TAPIService.GetServiceInterfaceName: string;
@@ -482,6 +487,22 @@ begin
   Result:=FParams.Count;
 end;
 
+function TAPIServiceMethod.GetRequestBodyType: String;
+begin
+  if assigned(FBodyType) then
+    Result:=FBodyType.GetTypeName(ntPascal)
+  else
+    Result:='';
+end;
+
+function TAPIServiceMethod.GetResultType(AIndex: TNameType): String;
+begin
+  if assigned(FResultDataType) then
+    Result:=FResultDataType.GetTypeName(aIndex)
+  else
+    Result:='';
+end;
+
 procedure TAPIServiceMethod.SortParams;
 begin
    FParams.Sort(@CompareParamName);
@@ -516,7 +537,7 @@ begin
   FParams.Add(Result);
 end;
 
-function TAPIServiceMethod.ParamByNAme(aOriginalName: String): TAPIServiceMethodParam;
+function TAPIServiceMethod.ParamByName(aOriginalName: String): TAPIServiceMethodParam;
 
 var
   Idx : Integer;
@@ -613,14 +634,8 @@ end;
 
 function TAPIData.FindApiType(const aName: String): TAPITypeData;
 
-var
-  Idx : Integer;
-
 begin
-  Result:=Nil;
-  Idx:=IndexOfApiType(aName);
-  if Idx<>-1 then
-    Result:=APITypes[Idx];
+  Result:=FindSchemaTypeData(aName) as TAPITypeData;
 end;
 
 function TAPIData.GetAPIType(const aName : String): TAPITypeData;
@@ -752,7 +767,7 @@ begin
     Raise EGenAPI.CreateFmt('Unknown service: %s',[aName]);
 end;
 
-procedure TAPIData.CheckInputOutput;
+procedure TAPIData.CheckInputOutput(aIncludeServer: Boolean);
 
 var
   I: Integer;
@@ -764,16 +779,24 @@ begin
     begin
     lSerTypes:=[];
     lData:=APITypes[i];
-    if NeedsSerialize(lData) then
-      Include(lSerTypes,stSerialize);
-    if NeedsDeserialize(lData) then
-      Include(lSerTypes,stDeSerialize);
+    if aIncludeServer then
+      begin
+      if NeedsSerialize(lData) or NeedsDeserialize(lData) then
+        lSerTypes:=[stSerialize,stDeSerialize]
+      end
+    else
+      begin
+      if NeedsSerialize(lData) then
+        Include(lSerTypes,stSerialize);
+      if NeedsDeserialize(lData) then
+        Include(lSerTypes,stDeSerialize);
+      end;
     lData.SerializeTypes:=lSerTypes;
     DoLog(etInfo,'%s needs serialize: %s, deserialize: %s',[lData.SchemaName,BoolToStr(stSerialize in lSerTypes,True),BoolToStr(stDeSerialize in lSerTypes,True)]);
     end;
 end;
 
-procedure TAPIData.CreateDefaultAPITypeMaps;
+procedure TAPIData.CreateDefaultAPITypeMaps(aIncludeServer : Boolean);
 
   Procedure AddProperties(aType : TAPITypeData);
 
@@ -812,7 +835,7 @@ begin
   // Finally, sort
   CheckDependencies;
   SortTypes;
-  CheckInputOutput;
+  CheckInputOutput(aIncludeServer);
 end;
 
 function TAPIData.GenerateServiceName(const aUrl: String; const aPath: TPathItem;
@@ -991,23 +1014,34 @@ begin
     end;
 end;
 
-function TAPIData.GetMethodResultType(aMethod : TAPIServiceMethod; aNameType : TNameType) : String;
+function TAPIData.GetMethodResultTypeData(aMethod: TAPIServiceMethod): TAPITypeData;
 
 var
   lResponse: TResponse;
   lMedia : TMediaType;
 
 begin
-  Result:='Boolean';
   if AMethod.Operation.Responses.Count>0 then
     begin
     lResponse:=AMethod.Operation.Responses.ResponseByindex[0];
     lMedia:=lResponse.Content.MediaTypes['application/json'];
-    if (lMedia.Schema.Ref<>'') then
-      Result:=GetRefSchemaTypeName(lMedia.Schema.Ref,aNameType)
-    else if (lMedia.Schema.Validations.Types<>[]) then
-      Result:=GetSchemaTypeName(lMedia.Schema,aNameType)
-    end;
+    if lMedia=Nil then
+      Raise EGenAPI.CreateFmt('No application/json response media type for %s.%s',[aMethod.Service.ServiceName,aMethod.MethodName]);
+    Result:=GetSchemaTypeData(Nil,lMedia.Schema,True) as TAPITypeData;
+    end
+  else
+    Result:=Nil; // FindApiType('boolean');
+end;
+
+function TAPIData.GetMethodResultType(aMethod : TAPIServiceMethod; aNameType : TNameType) : String;
+
+var
+  lData : TAPITypeData;
+begin
+  lData:=aMethod.ResultDataType;
+  if not assigned(lData) then
+    Raise EGenAPI.CreateFmt('No result type %s.%s',[aMethod.Service.ServiceName,aMethod.MethodName]);
+  Result:=lData.GetTypeName(aNameType);
 end;
 
 function TAPIData.IsRequestBodyApplicationJSON(aOperation : TAPIOperation) : Boolean;
@@ -1028,25 +1062,26 @@ begin
     end;
 end;
 
-function TAPIData.GetMethodRequestBodyType(aMethod : TAPIServiceMethod) : string;
+function TAPIData.GetMethodRequestBodyType(aMethod: TAPIServiceMethod): TAPITypeData;
 
 var
   lMedia : TMediaType;
 
 begin
-  Result:='';
+  Result:=Nil;
   if Not aMethod.Operation.HasKeyWord(okRequestBody) then
     exit;
   if aMethod.Operation.RequestBody.HasReference then
-    Result:=GetRefSchemaTypeName(aMethod.Operation.RequestBody.Reference.Ref,ntInterface)
+    Result:=TAPITypeData(GetPascalTypeDataFromRef(aMethod.Operation.RequestBody.Reference.Ref))
   else
     begin
     lMedia:=aMethod.Operation.RequestBody.Content['application/json'];
-    if (lMedia.Schema.Ref<>'') then
-      Result:=GetRefSchemaTypeName(lMedia.Schema.Ref,ntInterface)
-    else if (lMedia.Schema.Validations.Types<>[]) then
-      Result:=GetSchemaTypeName(lMedia.Schema,ntInterface);
+    if lMedia<>Nil then
+      Result:=TAPITypeData(GetSchemaTypeData(Nil,lMedia.Schema,True));
     end;
+  if Result=Nil then
+    with aMethod do
+      Raise EGenAPI.CreateFmt('Unknown result type for method %s.%s: %s',[Service.ServiceName,MethodName,Operation.RequestBody.Reference.Ref]);
 end;
 
 
@@ -1054,11 +1089,8 @@ end;
 procedure TAPIData.ConfigureServiceMethod(aService : TAPIService; aMethod : TAPIServiceMethod);
 
 begin
-  aMethod.ResultCallBackType:=GenerateMethodResultCallBackName(aMethod);
-  aMethod.ResultType:=GetMethodResultType(aMethod,ntInterface);
-  aMethod.ResultClassType:=GetMethodResultType(aMethod,ntImplementation);
-  aMethod.ResultDtoType:=GetMethodResultType(aMethod,ntPascal);
-  aMethod.RequestBodyType:=GetMethodRequestBodyType(aMethod);
+  aMethod.ResultDataType:=GetMethodResultTypeData(aMethod);
+  aMethod.RequestBodyDataType:=GetMethodRequestBodyType(aMethod);
 end;
 
 
@@ -1331,7 +1363,11 @@ procedure TAPIData.FinishAutoCreatedType(aName: string; aType: TPascalTypeData;
 begin
   if aType.Pascaltype=ptArray then
     begin
-    aType.InterfaceName:=Format('%s<%s>',[InterfaceArrayType,lElementTypeData.InterfaceName]);
+    if InterfaceArrayType<>'' then
+      aType.InterfaceName:=Format('%s<%s>',[InterfaceArrayType,lElementTypeData.InterfaceName])
+    else
+      aType.InterfaceName:=lElementTypeData.InterfaceName+ArrayTypeSuffix;
+    aType.ImplementationName:=aType.PascalName;
     end;
   Inherited;
 end;

+ 286 - 0
packages/fcl-openapi/tests/UtOpenApiPascalTypes.pas

@@ -0,0 +1,286 @@
+unit UtOpenApiPascalTypes;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson.schema.types, fpjson.schema.pascaltypes,
+  fpopenapi.types, fpopenapi.objects, fpopenapi.pascaltypes;
+
+Type
+
+  { TTestPascalTypes }
+
+  TTestPascalTypes = Class(TTestCase)
+  private
+    FAPI: TOpenAPI;
+    FAPIData: TAPIData;
+    function AssertService(const Msg: String; aService: TAPIService; const aName: string; aMethods: array of string): TAPIService;
+    function AssertServiceMethod(const Msg: string; aMethod: TAPIServiceMethod; aParams: array of string; const aResultName,
+      aBodyName: string): TAPIServiceMethod;
+    function AssertServiceMethodResult(const Msg: string; aMethod: TAPIServiceMethod; aResultTypeData: TAPITypeData;
+      const aResultClassName, aResultInterfaceName: string): TAPIServiceMethod;
+    procedure AssertSimpleComponent(const Msg: String; aType: TAPITypeData);
+  Public
+    class procedure AssertEquals(const Msg: string; aExpected, aActual: TPascalType); overload;
+    function AssertPascalTypeData(const Msg: string; aType: TPascalTypeData; aPascaltype: TPascalType; const aSchemaName, aPascalName: String) : TPascalTypeData;
+    procedure AssertProperty(Msg: String; aType: TPascalTypeData; aIndex: Integer; const aSchemaName, aPascalName, aPascalTypeName: String; aPascalType: TPascalType; aTypeData: TPascalTypeData);
+    procedure Load(const aFileName: string);
+    procedure Setup; override;
+    procedure TearDown; override;
+    Property API : TOpenAPI Read FAPI;
+    Property Data : TAPIData Read FAPIData;
+  Published
+    procedure TestHookup;
+    procedure TestFindService;
+    procedure TestSimpleComponent;
+    procedure TestSimpleService;
+    procedure TestSimpleServiceArrayArgument;
+    procedure TestDoubleServiceArrayArgument;
+    procedure TestServiceNoApplicationJSONResponse;
+    procedure TestServiceNoApplicationJSONRequestBody;
+  end;
+
+implementation
+
+uses typinfo, fpopenapi.reader;
+
+{ TTestPascalTypes }
+
+class procedure TTestPascalTypes.AssertEquals(const Msg : string; aExpected, aActual : TPascalType);
+
+begin
+  AssertEquals(Msg,GetEnumName(Typeinfo(TPascalType),Ord(aExpected)),
+                   GetEnumName(Typeinfo(TPascalType),Ord(aActual)));
+end;
+
+function TTestPascalTypes.AssertPascalTypeData(const Msg: string; aType: TPascalTypeData; aPascaltype: TPascalType;
+  const aSchemaName, aPascalName: String): TPascalTypeData;
+begin
+  AssertNotNull(Msg+': have type',aType);
+  AssertEquals(Msg+' Schema name',aSchemaName,aType.SchemaName);
+  AssertEquals(Msg+' Pascal name',aPascalName,aType.PascalName);
+  AssertEquals(Msg+' Pascal type',aPascalType,aType.PascalType);
+  Result:=aType;
+end;
+
+
+procedure TTestPascalTypes.AssertProperty(Msg : String; aType : TPascalTypeData; aIndex : Integer; const aSchemaName,aPascalName,aPascalTypeName : String; aPascalType : TPascalType; aTypeData: TPascalTypeData);
+
+var
+  lProp : TPascalPropertyData;
+
+begin
+  AssertNotNull(Msg+': have type',aType);
+  AssertTrue(Msg+': have properties',aType.PropertyCount>0);
+  AssertTrue(Msg+': have valid index',aIndex<aType.PropertyCount);
+  lProp:=aType.Properties[aIndex];
+  AssertNotNull(Msg+': have property',lProp);
+  AssertEquals(Msg+': schema name',aSchemaName,lProp.SchemaName);
+  AssertEquals(Msg+': pascal name',aPascalName,lProp.PascalName);
+  AssertEquals(Msg+': Pascal type name',aPascalTypeName,lProp.PascalTypeName);
+  AssertEquals(Msg+': Pascal type',aPascalType,lProp.PropertyType);
+  AssertSame(Msg+': Type data',aTypeData,lProp.TypeData);
+end;
+
+
+procedure TTestPascalTypes.Setup;
+begin
+  inherited Setup;
+  FAPI:=TOpenAPI.Create;
+  FAPIData:=TAPIData.Create(FAPI);
+end;
+
+procedure TTestPascalTypes.TearDown;
+begin
+  FreeAndNil(FAPIData);
+  FreeAndNil(FAPI);
+  inherited TearDown;
+end;
+
+procedure TTestPascalTypes.TestHookup;
+begin
+  AssertNotNull('Have api',API);
+  AssertNotNull('Have data',Data);
+  AssertFalse('API empty',API.HasKeyWord(oakComponents) or API.HasKeyWord(oakPaths));
+end;
+
+procedure TTestPascalTypes.TestFindService;
+
+var
+  lService : TAPIService;
+
+begin
+  lService:=Data.AddService('a');
+  AssertNotNull('Have service',lService);
+  AssertSame('Find correct service',lService,Data.FindService('a'));
+  AssertNull('unexisting service',Data.FindService('ab'));
+end;
+
+procedure TTestPascalTypes.AssertSimpleComponent(const Msg : String; aType : TAPITypeData);
+
+begin
+  AssertNotNull(Msg+': Have type',aType);
+  AssertEquals(Msg+': Have type name','a',aType.SchemaName);
+  AssertEquals(Msg+': Have pascal name','Ta',aType.PascalName);
+  AssertEquals(Msg+': Have 2 properties',2,aType.PropertyCount);
+  AssertProperty(Msg+': prop b', aType,0,'b','b','string',ptString,Data.ApiNamedTypes['string']);
+  AssertProperty(Msg+': prop c', aType,1,'c','c','integer',ptInteger,Data.ApiNamedTypes['integer']);
+end;
+
+procedure TTestPascalTypes.TestSimpleComponent;
+
+begin
+  load('simplecomponent');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  AssertEquals('Have 1 API type',1,Data.TypeCount);
+  AssertSimpleComponent('First component',Data.APITypes[0]);
+end;
+
+function TTestPascalTypes.AssertService(const Msg: String; aService: TAPIService; const aName: string; aMethods: array of string
+  ): TAPIService;
+
+var
+  I : integer;
+
+begin
+  AssertNotNull(Msg+': Have service',aService);
+  AssertEquals(Msg+': service name',aName,aService.ServiceName);
+  AssertEquals(Msg+': count',Length(aMethods),aService.MethodCount);
+  for I:=0 to aService.MethodCount-1 do
+    AssertEquals(Msg+': method '+IntToStr(I),aMethods[i],aService.Methods[i].MethodName);
+  Result:=aService;
+end;
+
+function TTestPascalTypes.AssertServiceMethod(const Msg: string; aMethod: TAPIServiceMethod; aParams: array of string;
+  const aResultName, aBodyName: string): TAPIServiceMethod;
+
+var
+  I : Integer;
+
+begin
+  AssertNotNull(Msg+': have method',aMethod);
+  AssertEquals(Msg+': param count',Length(aParams),aMethod.ParamCount);
+  for I:=0 to aMethod.ParamCount-1 do
+    AssertEquals(Msg+': param '+IntToStr(I),aParams[I],aMethod.Param[I].Name);
+  AssertEquals(Msg+': ResultDtoType',aResultName,aMethod.ResultDtoType);
+  AssertEquals(Msg+': BodyName',aBodyName,aMethod.RequestBodyType);
+  Result:=aMethod;
+end;
+
+function TTestPascalTypes.AssertServiceMethodResult(const Msg: string; aMethod: TAPIServiceMethod; aResultTypeData: TAPITypeData;
+  const aResultClassName, aResultInterfaceName: string): TAPIServiceMethod;
+
+begin
+  AssertNotNull(Msg+': have method',aMethod);
+  AssertEquals(Msg+': ResultClassType',aResultClassName,aMethod.ResultClassType);
+  AssertEquals(Msg+': ResultInterfaceType',aResultInterfaceName,aMethod.ResultType);
+  AssertSame(Msg+': BodyName',aResultTypeData,aMethod.ResultDataType);
+  Result:=aMethod;
+end;
+
+procedure TTestPascalTypes.TestSimpleService;
+
+var
+  lService : TAPIService;
+  lMethod : TAPIServiceMethod;
+begin
+  load('simpleservice');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  Data.CreateServiceDefs;
+  AssertEquals('Have 1 API type',1,Data.TypeCount);
+  AssertSimpleComponent('First component',Data.APITypes[0]);
+  AssertEquals('Have 1 service type',1,Data.ServiceCount);
+  lService:=AssertService('First component',Data.Services[0],'SimpleService',['List']);
+  lMethod:=AssertServiceMethod('Method List',lService.Methods[0],[],'Ta','');
+  AssertServiceMethodResult('Method List',lMethod,Data.APITypes[0],'TaObj','Ia');
+end;
+
+procedure TTestPascalTypes.TestSimpleServiceArrayArgument;
+var
+  lService : TAPIService;
+  lMethod : TAPIServiceMethod;
+begin
+  load('simpleservicearray');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  Data.CreateServiceDefs;
+  AssertEquals('Have 2 API type',2,Data.TypeCount);
+  AssertSimpleComponent('First component',Data.APITypes[0]);
+  AssertPascalTypeData('Element type',Data.APITypes[1],ptArray,'[a]','TaArray');
+  AssertEquals('Have 1 service def',1,Data.ServiceCount);
+  lService:=AssertService('First service',Data.Services[0],'SimpleService',['List']);
+  lMethod:=AssertServiceMethod('Service 0 Method List',lService.Methods[0],[],'TaArray','');
+  AssertServiceMethodResult('Service 0 Method List',lMethod,Data.APITypes[1],'TaArray','IaArray');
+end;
+
+procedure TTestPascalTypes.TestDoubleServiceArrayArgument;
+var
+  lService : TAPIService;
+  lMethod : TAPIServiceMethod;
+begin
+  load('doubleservicearray');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  Data.CreateServiceDefs;
+  AssertEquals('Have 2 API type',2,Data.TypeCount);
+  AssertSimpleComponent('First component',Data.APITypes[0]);
+  AssertPascalTypeData('Element type',Data.APITypes[1],ptArray,'[a]','TaArray');
+  AssertEquals('Have 2 services',2,Data.ServiceCount);
+  lService:=AssertService('First Service',Data.Services[1],'SimpleService',['List']);
+  lMethod:=AssertServiceMethod('Service 0 Method List',lService.Methods[0],[],'TaArray','');
+  AssertServiceMethodResult('Service 0 Method List',lMethod,Data.APITypes[1],'TaArray','IaArray');
+  lService:=AssertService('second service',Data.Services[0],'Simple2Service',['List2']);
+  lMethod:=AssertServiceMethod('Service 1 Method List',lService.Methods[0],[],'TaArray','');
+  AssertServiceMethodResult('service 1 List',lMethod,Data.APITypes[1],'TaArray','IaArray');
+end;
+
+procedure TTestPascalTypes.TestServiceNoApplicationJSONResponse;
+
+begin
+  load('noapplicationjsonresponse');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  Data.CreateServiceDefs;
+  AssertEquals('API type count',1,Data.TypeCount);
+  AssertEquals('Service count',0,Data.ServiceCount);
+end;
+
+procedure TTestPascalTypes.TestServiceNoApplicationJSONRequestBody;
+
+begin
+  load('noapplicationjsonrequestbody');
+  AssertTrue('Have components',API.HasKeyWord(oakComponents));
+  Data.CreateDefaultTypeMaps;
+  Data.CreateDefaultAPITypeMaps;
+  Data.CreateServiceDefs;
+  AssertEquals('API type count',1,Data.TypeCount);
+  AssertEquals('Service count',0,Data.ServiceCount);
+end;
+
+procedure TTestPascalTypes.Load(const aFileName : string);
+
+var
+  lReader : TOpenAPIReader;
+
+begin
+  lReader:=TOpenAPIReader.Create(Nil);
+  try
+    lReader.ReadFromFile(API,'data'+PathDelim+aFileName+'.json');
+  finally
+    lReader.Free;
+  end;
+end;
+
+initialization
+  RegisterTest(TTestPascalTypes);
+end.
+

+ 4 - 8
packages/fcl-openapi/tests/testopenapi.lpi

@@ -62,19 +62,15 @@
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="../src/fpopenapi.data.ppcal.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit>
-      <Unit>
-        <Filename Value="../src/fpopenapi.ppcaltypes.pp"/>
+        <Filename Value="../src/fpopenapi.writer.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="../src/fpopenapi.writer.pp"/>
+        <Filename Value="../src/fpopenapi.pascaltypes.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
       <Unit>
-        <Filename Value="jsoncomparer.pp"/>
+        <Filename Value="UtOpenApiPascalTypes.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
     </Units>
@@ -86,7 +82,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src;../../JSONSchema/fpc/src"/>
+      <OtherUnitFiles Value="../src;../../fcl-jsonschema/src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>

+ 1 - 1
packages/fcl-openapi/tests/testopenapi.pp

@@ -4,7 +4,7 @@ program testopenapi;
 
 uses
   Classes, consoletestrunner, utOpenApi, fpopenapi.consts, fpopenapi.types, fpopenapi.objects, utOpenApiReader, utOpenAPIWriter,
-  fpopenapi.reader, jsoncomparer, jsonparser;
+  fpopenapi.reader, jsonparser, UtOpenApiPascalTypes;
 
 type