unit TMS.ServerWizard.Creation.Project;

{$I bcl.inc}

interface

{$IFDEF DELPHIXE2_LVL}

uses
  System.Classes, ToolsAPI, Vcl.Dialogs, TMS.ServerWizard.Types, TMS.ServerWizard.Creation;

  function CreateProjectCreator(const ServerKind : TServerKind; const Kind: TProjectKind;
    const ServerUnit : IOTAFile; const IdentifierMap : TIdentifierMap;
    const CreationSettings : TProjectCreationSettings) : IOTACreator;

  procedure CreateConnectionModuleOnly(const IdentifierMap : TIdentifierMap);

{$ENDIF}

implementation

{$IFDEF DELPHIXE2_LVL}

uses
  Bcl.Rtti.Utils,
  System.SysUtils, TMS.ServerWizard.Files, TMS.ServerWizard.ToolsAPI.Utils,
  TMS.ServerWizard.Creation.Module, TMS.ServerWizard.Configuration,
  System.StrUtils;

type
  TProjectCreator = class(TInterfacedObject, IOTACreator, IOTAProjectCreator,
    IOTAProjectCreator50, IOTAProjectCreator80, IOTAProjectCreator160
    {$IF COMPILERVERSION > 31}, IOTAProjectCreator190{$IFEND})
  private
    FServerKind : TServerKind;
    FServerUnit : IOTAFile;
    FProjectName: string;
    FIdentifierMap : TIdentifierMap;
    FConfig : TProjectConfig;
  public
    constructor Create(const ServerKind : TServerKind; const ProjectName : string;
      const ServerUnit : IOTAFile; const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);
    // IOTACreator
    function GetCreatorType: string;
    function GetExisting: Boolean;
    function GetFileSystem: string;
    function GetOwner: IOTAModule;
    function GetUnnamed: Boolean;
    // IOTAProjectCreator
    function GetFileName: string;
    function GetOptionFileName: string;
    function GetShowSource: Boolean;
    procedure NewDefaultModule;
    function NewOptionSource(const ProjectName: string): IOTAFile;
    procedure NewProjectResource(const Project: IOTAProject);
    function NewProjectSource(const ProjectName: string): IOTAFile; virtual; abstract;
    // IOTAProjectCreator50
    procedure NewDefaultProjectModule(const Project: IOTAProject); virtual; abstract;
    // IOTAProjectCreator80
    function GetProjectPersonality: string;
    // IOTAProjectCreator160
    function GetFrameworkType: string; virtual; abstract;
    function GetPlatforms: TArray<string>;
    function GetPreferredPlatform: string;
    procedure SetInitialOptions(const NewProject: IOTAProject);
    // IOTAProjectCreator190
    function GetSupportedPlatforms: TArray<string>;
  end;

  TProjectCreatorCommon = class(TProjectCreator)
  public
    procedure NewDefaultProjectModule(const Project: IOTAProject); override;
  end;

  TProjectCreatorVCL = class(TProjectCreatorCommon)
  public
    constructor Create(const ServerKind : TServerKind; const ServerUnit : IOTAFile;
      const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);

    function NewProjectSource(const ProjectName: string): IOTAFile; override;
    procedure NewDefaultProjectModule(const Project: IOTAProject); override;
    function GetFrameworkType: string; override;
  end;

  TProjectCreatorFMX = class(TProjectCreatorCommon)
  public
    constructor Create(const ServerKind : TServerKind; const ServerUnit : IOTAFile;
      const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);

    function NewProjectSource(const ProjectName: string): IOTAFile; override;
    procedure NewDefaultProjectModule(const Project: IOTAProject); override;
    function GetFrameworkType: string; override;
  end;

  TProjectCreatorService = class(TProjectCreatorCommon)
  public
    constructor Create(const ServerKind : TServerKind; const ServerUnit : IOTAFile;
      const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);

    function NewProjectSource(const ProjectName: string): IOTAFile; override;
    procedure NewDefaultProjectModule(const Project: IOTAProject); override;
    function GetFrameworkType: string; override;
  end;

  TProjectCreatorConsole = class(TProjectCreatorCommon)
  public
    constructor Create(const ServerKind : TServerKind; const ServerUnit : IOTAFile;
      const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);

    function NewProjectSource(const ProjectName: string): IOTAFile; override;
    procedure NewDefaultProjectModule(const Project: IOTAProject); override;
    function GetFrameworkType: string; override;
  end;

function CreateProjectCreator(const ServerKind : TServerKind; const Kind: TProjectKind; const ServerUnit : IOTAFile;
  const IdentifierMap : TIdentifierMap; const CreationSettings : TProjectCreationSettings) : IOTACreator;
var
  Config : TProjectConfig;
begin
  Config := FileConfigs[Kind];
  // ! Special case. If the settings say to use SQLLite as the database driver,
  // don't create the connection module
  if SameText(CreationSettings.DatabaseDriver, 'SQLite') then begin
    Config.ConnectionModule.UnitName := '';
    Config.ConnectionModule.ResourceName := '';
  end;

  case Kind of
    TProjectKind.pkVCL: Result := TProjectCreatorVCL.Create(ServerKind, ServerUnit, IdentifierMap, FileConfigs[Kind]);
    TProjectKind.pkFMX: Result := TProjectCreatorFMX.Create(ServerKind, ServerUnit, IdentifierMap, FileConfigs[Kind]);
    TProjectKind.pkService: Result := TProjectCreatorService.Create(ServerKind, ServerUnit, IdentifierMap, FileConfigs[Kind]);
    TProjectKind.pkConsole: Result := TProjectCreatorConsole.Create(ServerKind, ServerUnit, IdentifierMap, FileConfigs[Kind]);
    else
      raise Exception.Create('Cannot create project: unknown project kind');
  end;
end;

procedure MakePlatformIndependent(const ConnectionModule : IOTAModule);
var
  Editor : IOTASourceEditor;
  Text : string;
  OrigTextLen : Integer;
begin
  // The connection module has a ClassType pseudo-property which should be neither
  // VCL nor FMX. The component SetProperty methods don't set pseudoproperties so
  // edit it directly in the .pas file
  Editor := GetSourceEditorForModule(ConnectionModule);
  if not Assigned(Editor) then begin
    ConnectionModule.ShowFilename(ChangeFileExt(ConnectionModule.FileName, '.pas'));
    Editor := GetSourceEditorForModule(ConnectionModule);
  end;
  if Assigned(Editor) then begin
    Text := GetEditorContents(Editor);
    OrigTextLen := Length(Text);
    Text := StringReplace(Text, '{%CLASSGROUP ''Vcl.Controls.TControl''}', '{%CLASSGROUP ''System.Classes.TPersistent''}',
      [rfReplaceAll, rfIgnoreCase]);
    Text := StringReplace(Text, '{%CLASSGROUP ''FMX.Controls.TControl''}', '{%CLASSGROUP ''System.Classes.TPersistent''}',
      [rfReplaceAll, rfIgnoreCase]);
    SetEditorContents(Editor, OrigTextLen, Text);
  end;
end;

procedure CreateAureliusConnectionModule(const UnitName: string;
  Project: IOTAProject; FileResourceName: string; IdentifierMap : TIdentifierMap);
var
  Existing : IOTAModule;
  Creator : IOTACreator;
begin
  if UnitName = '' then Exit;

  Existing := GetExistingModule(UnitName);
  if Assigned(Existing) then
  begin
    // Ensure that it is marked as platform-independent
    MakePlatformIndependent(Existing);
    // Now it won't show an incompatibility warning, add it to the project
    if Assigned(Project) then
      Project.AddFile(Existing.FileName, true)
    else
      Existing.Show;
  end else
  begin
    Creator := TModuleCreatorFromResource.Create(Project, TModuleKind.mkDataModule,
      FileResourceName, UnitName,
      IdentifierMap);
    (Creator as TModuleCreator).OnFormCreated := procedure(FormEditor: IOTAFormEditor)
      var
        Component: IOTAComponent;
        ComponentTypeToAdd: string;
        AdaptedConnection, AureliusConnection: TComponent;
      const
        ComponentError: string = 'Unable to create component %s. The required library may not be installed.';
      begin
        // Add the adapted connection
        ComponentTypeToAdd := IdentifierMap['{CONNECTIONMODULE_CREATE_COMP_TYPE}'];
        AdaptedConnection := nil;
        if ComponentTypeToAdd <> '' then
        begin
          Component := FormEditor.CreateComponent(nil, ComponentTypeToAdd, 64, 8, 32, 32);
           // Note this fails if the library isn't installed, ie it doesn't know the component type
          if Assigned(Component) then
          begin
            AdaptedConnection := TComponent(Component.GetComponentHandle);
            AdaptedConnection.Name := 'Connection';
          end
          else
            MessageDlg(Format(ComponentError, [ComponentTypeToAdd]), mtError, [mbOk], 0);
        end;

        // Add the aurelius connection
        Component := FormEditor.CreateComponent(nil, 'TAureliusConnection', 64, 64, 32, 32);
        if Assigned(Component) then
        begin
          AureliusConnection := TComponent(Component.GetComponentHandle);

          // Quick and dirty check to see if we're using a native driver or an adapter
          if ComponentTypeToAdd <> '' then
          begin
            SafeSetProp(AureliusConnection, 'AdaptedConnection', AdaptedConnection);
            SafeSetProp(AureliusConnection, 'AdapterName', IdentifierMap['{DATABASEDRIVERNAME}']);
            SafeSetProp(AureliusConnection, 'SqlDialect', IdentifierMap['{SQLDIALECT}']);
          end else
            SafeSetProp(AureliusConnection, 'DriverName', IdentifierMap['{DATABASEDRIVERNAME}']);
        end
        else
          MessageDlg(Format(ComponentError, ['TAureliusConnection']), mtError, [mbOk], 0);
      end;
    (BorlandIDEServices as IOTAModuleServices).CreateModule(Creator);
  end;
end;

procedure CreateConnectionModuleOnly(const IdentifierMap : TIdentifierMap);
var
  UnitName : string;
  Project : IOTAProject;
  ModuleServices : IOTAModuleServices;
begin
  ModuleServices := (BorlandIDEServices as IOTAModuleServices);
  Project := ModuleServices.GetActiveProject;

  UnitName := FileConfigs[TProjectKind.pkVCL].ConnectionModule.UnitName;
  CreateAureliusConnectionModule(UnitName, Project,
    FileConfigs[TProjectKind.pkVCL].ConnectionModule.ResourceName,
    IdentifierMap);
end;

{ TProjectCreator }

constructor TProjectCreator.Create(const ServerKind : TServerKind; const ProjectName: string;
  const ServerUnit : IOTAFile; const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);
begin
  inherited Create();
  FServerKind := ServerKind;
  FServerUnit := ServerUnit;
  FProjectName := ProjectName + '_' + ServerKindToString(ServerKind) + '_Server';
  FProjectName := EnsureProjectNameUnique(FProjectName);
  FIdentifierMap := IdentifierMap;
  FIdentifierMap.Add('{PROJECT_NAME}', FProjectName);
  FConfig := Config;
end;

{$REGION 'IOTACreator'}
  function TProjectCreator.GetCreatorType: string;
  begin
    Result := '';
  end;

  function TProjectCreator.GetExisting: Boolean;
  begin
    Result := false; // New project
  end;

  function TProjectCreator.GetFileSystem: string;
  begin
    Result := '';
  end;

  function TProjectCreator.GetOwner: IOTAModule;
  begin
    Result := CurrentProjectGroup;
  end;

  function TProjectCreator.GetUnnamed: Boolean;
  begin
    Result := true; // User will be prompted to save
  end;
{$ENDREGION}

{$REGION 'IOTAProjectCreator'}
  function TProjectCreator.GetFileName: string;
  begin
    // Project file name
    Result := IncludeTrailingPathDelimiter(GetDefaultFolder) + FProjectName + '.dpr';
  end;

  function TProjectCreator.GetOptionFileName: string;
  begin
    Result := ''; // DOF file - not used in recent versions
  end;

  function TProjectCreator.GetShowSource: Boolean;
  begin
    Result := false;
  end;

  procedure TProjectCreator.NewDefaultModule;
  begin
    //
  end;

  function TProjectCreator.NewOptionSource(const ProjectName: string): IOTAFile;
  begin
    Result := nil;
  end;

  procedure TProjectCreator.NewProjectResource(const Project: IOTAProject);
  begin
    //
  end;
{$ENDREGION}

{$REGION 'IOTAProjectCreator80'}
  function TProjectCreator.GetProjectPersonality: string;
  begin
    Result := sDelphiPersonality;
  end;
{$ENDREGION}

{$REGION 'IOTAProjectCreator160'}
  function TProjectCreator.GetPlatforms: TArray<string>;
  begin
    SetLength(Result, 1);
    Result[0] := 'Win32';
  end;

  function TProjectCreator.GetPreferredPlatform: string;
  begin
    Result := 'Win32';
  end;

  procedure TProjectCreator.SetInitialOptions(const NewProject: IOTAProject);
  begin
    //
  end;
{$ENDREGION}

{$REGION 'IOTAProjectCreator190'}
  function TProjectCreator.GetSupportedPlatforms: TArray<string>;
  begin
    Result := nil;
  end;
{$ENDREGION}


{ TProjectCreatorCommon }

procedure TProjectCreatorCommon.NewDefaultProjectModule(
  const Project: IOTAProject);
var
  Creator : IOTACreator;
  ModuleServices : IOTAModuleServices;
  UnitName : string;
  Existing : IOTAModule;
begin
  ModuleServices := (BorlandIDEServices as IOTAModuleServices);

  // Server unit
  Existing := GetExistingModule(FConfig.Server.UnitName);
  if Assigned(Existing) then begin
    Project.AddFile(Existing.FileName, false);
  end else begin
    Creator := TModuleCreatorFromIOTAFile.Create(Project, TModuleKind.mkUnit, FServerUnit, FConfig.Server.UnitName, FIdentifierMap);
    ModuleServices.CreateModule(Creator);
  end;

  // If it's a XData or RemoteDB project, create the connection module
  if FServerKind <> TServerKind.skSparkle then begin
    UnitName := FConfig.ConnectionModule.UnitName;
    CreateAureliusConnectionModule(UnitName, Project,
      FConfig.ConnectionModule.ResourceName, FIdentifierMap);
  end;
end;

{ TProjectCreatorVCL }

constructor TProjectCreatorVCL.Create(const ServerKind : TServerKind; const ServerUnit: IOTAFile;
  const IdentifierMap : TIdentifierMap; const Config : TProjectConfig);
begin
  inherited Create(ServerKind, 'VCL', ServerUnit, IdentifierMap, Config);
end;

function TProjectCreatorVCL.NewProjectSource(const ProjectName: string): IOTAFile;
begin
  Result := TFileFromResource.Create(FConfig.Project.ResourceName, FIdentifierMap);
end;

procedure TProjectCreatorVCL.NewDefaultProjectModule(const Project: IOTAProject);
var
  Creator : IOTACreator;
  ModuleServices : IOTAModuleServices;
  Existing : IOTAModule;
begin
  inherited;

  ModuleServices := (BorlandIDEServices as IOTAModuleServices);

  Existing := GetExistingModule(FConfig.Form.UnitName);
  if Assigned(Existing) then
    Project.AddFile(Existing.FileName, true)
  else begin
    // VCL form and form unit
    Creator := TModuleCreatorFromResource.Create(Project, TModuleKind.mkVCLForm, FConfig.Form.ResourceName,
      FConfig.Form.UnitName, FIdentifierMap);
    ModuleServices.CreateModule(Creator);
  end;
end;

function TProjectCreatorVCL.GetFrameworkType: string;
begin
  Result := sFrameworkTypeVCL;
end;

{ TProjectCreatorFMX }

constructor TProjectCreatorFMX.Create(const ServerKind : TServerKind; const ServerUnit: IOTAFile;
  const IdentifierMap: TIdentifierMap; const Config: TProjectConfig);
begin
  inherited Create(ServerKind, 'FMX', ServerUnit, IdentifierMap, Config);
end;

function TProjectCreatorFMX.NewProjectSource(const ProjectName: string): IOTAFile;
begin
  Result := TFileFromResource.Create(FConfig.Project.ResourceName, FIdentifierMap);
end;

procedure TProjectCreatorFMX.NewDefaultProjectModule(const Project: IOTAProject);
var
  Creator : IOTACreator;
  ModuleServices : IOTAModuleServices;
  Existing : IOTAModule;
begin
  inherited;

  ModuleServices := (BorlandIDEServices as IOTAModuleServices);

  // FMX form and form unit
  Existing := GetExistingModule(FConfig.Form.UnitName);
  if Assigned(Existing) then
    Project.AddFile(Existing.FileName, true)
  else begin
    Creator := TModuleCreatorFromResource.Create(Project, TModuleKind.mkFMXForm, FConfig.Form.ResourceName,
      FConfig.Form.UnitName, FIdentifierMap);
    ModuleServices.CreateModule(Creator);
  end;
end;

function TProjectCreatorFMX.GetFrameworkType: string;
begin
  Result := sFrameworkTypeFMX;
end;

{ TProjectCreatorService }

constructor TProjectCreatorService.Create(const ServerKind : TServerKind; const ServerUnit: IOTAFile;
  const IdentifierMap: TIdentifierMap; const Config: TProjectConfig);
begin
  inherited Create(ServerKind, 'Service', ServerUnit, IdentifierMap, Config);
end;

function TProjectCreatorService.NewProjectSource(const ProjectName: string): IOTAFile;
begin
  Result := TFileFromResource.Create(FConfig.Project.ResourceName, FIdentifierMap);
end;

procedure TProjectCreatorService.NewDefaultProjectModule(const Project: IOTAProject);
var
  Creator : IOTACreator;
  ModuleServices : IOTAModuleServices;
  Existing : IOTAModule;
begin
  inherited;

  ModuleServices := (BorlandIDEServices as IOTAModuleServices);

  // Service 'form' (dataset descendant) and  unit
  Existing := GetExistingModule(FConfig.Form.UnitName);
  if Assigned(Existing) then
    Project.AddFile(Existing.FileName, true)
  else begin
    Creator := TModuleCreatorFromResource.Create(Project, TModuleKind.mkService, FConfig.Form.ResourceName, FConfig.Form.UnitName, nil);
    ModuleServices.CreateModule(Creator);
  end;
end;

function TProjectCreatorService.GetFrameworkType: string;
begin
  Result := sFrameworkTypeVCL;
end;

{ TProjectCreatorConsole }

constructor TProjectCreatorConsole.Create(const ServerKind : TServerKind; const ServerUnit: IOTAFile;
  const IdentifierMap: TIdentifierMap; const Config: TProjectConfig);
begin
  inherited Create(ServerKind, 'Console', ServerUnit, IdentifierMap, Config);
end;

function TProjectCreatorConsole.NewProjectSource(const ProjectName: string): IOTAFile;
begin
  Result := TFileFromResource.Create(FConfig.Project.ResourceName, FIdentifierMap);
end;

procedure TProjectCreatorConsole.NewDefaultProjectModule(const Project: IOTAProject);
begin
  inherited;
end;

function TProjectCreatorConsole.GetFrameworkType: string;
begin
  Result := sFrameworkTypeNone;
end;

{$ENDIF}

end.
