unit Aurelius.Design.Editors;

interface

uses
  SysUtils, Classes, DesignIntf, DesignEditors, Dialogs, ToolsApi;

type
  TAureliusConnectionEditor = class(TComponentEditor)
  strict private
    function GetConnectionProject: IOTAProject;
    procedure ExecuteConnectionDesigner;
    procedure ExecuteImportPlugin;
    procedure CreateImportUnit(const SourceCode: string);
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TAureliusAdapterNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TAureliusDriverNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TAureliusSQLDialectProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TAureliusAdaptedConnectionProperty = class(TComponentProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  TAureliusConnectionSelectionEditor = class(TSelectionEditor)
  public
    procedure RequiresUnits(Proc: TGetStrProc); override;
  end;

implementation

uses
  Bcl.Json,
  Bcl.Json.Classes,
  Aurelius.Comp.Connection,
  Aurelius.Comp.Adapters,
  Aurelius.Comp.Drivers,
  Aurelius.Design.SourceCreator,
  Aurelius.Design.ConnectionDesigner,
  Aurelius.Drivers.Interfaces,
  Aurelius.Plugin,
  Aurelius.Plugin.Options,
  Aurelius.Plugin.Types,
  Aurelius.Plugin.ExportForm;

type
  TAureliusConnectionHack = class(TAureliusConnection);

{ TAureliusAdapterNameProperty }

function TAureliusAdapterNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TAureliusAdapterNameProperty.GetValues(Proc: TGetStrProc);
var
  Adapter: IAureliusAdapter;
begin
  for Adapter in TAureliusAdapterRegister.Instance.Adapters do
    Proc(Adapter.Name);
end;

{ TAureliusSQLDialectProperty }

function TAureliusSQLDialectProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TAureliusSQLDialectProperty.GetValues(Proc: TGetStrProc);
var
  Adapter: IAureliusAdapter;
  SQLDialect: string;
begin
  Adapter := TAureliusAdapterRegister.Instance.FindAdapter(
    (GetComponent(0) as TAureliusConnection).AdapterName
  );
  if Adapter <> nil then
      for SqlDialect in Adapter.SqlDialects do
        Proc(SqlDialect);
end;

{ TAureliusConnectionSelectionEditor }

procedure TAureliusConnectionSelectionEditor.RequiresUnits(Proc: TGetStrProc);
var
  I: Integer;
  Comp: TComponent;
  UsedUnit: string;
begin
  for I := 0 to Designer.Root.ComponentCount - 1 do
  begin
    Comp := Designer.Root.Components[I];
    if Comp is TAureliusConnection then
    begin
      for UsedUnit in TAureliusAdapterRegister.Instance.GetSqlDialectUnits(
        TAureliusConnection(Comp).SqlDialect) do
        Proc(UsedUnit);

      for UsedUnit in TAureliusAdapterRegister.Instance.GetAdapterUnits(
        TAureliusConnection(Comp).AdapterName) do
        Proc(UsedUnit);

      for UsedUnit in TAureliusDriverRegister.Instance.GetDriverUnits(
        TAureliusConnection(Comp).DriverName) do
        Proc(UsedUnit);
    end;
  end;
end;

{ TAureliusAdaptedConnectionProperty }

function TAureliusAdaptedConnectionProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result - [paMultiSelect];
end;

procedure TAureliusAdaptedConnectionProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Comp: TComponent;
  Adapter: IAureliusAdapter;
  Conn: TAureliusConnection;
begin
  Conn := GetComponent(0) as TAureliusConnection;

  for I := 0 to Designer.Root.ComponentCount - 1 do
  begin
    Comp := Designer.Root.Components[I];
    for Adapter in TAureliusAdapterRegister.Instance.Adapters do
      if Adapter.IsAdaptedConnectionValid(Comp) then
        if (Conn.AdapterName = '') or SameText(Conn.AdapterName, Adapter.Name) then
          Proc(Designer.GetComponentName(Comp));
  end;
end;

procedure TAureliusAdaptedConnectionProperty.SetValue(const Value: string);
var
  Conn: TAureliusConnection;
  Adapter: IAureliusAdapter;
  DBConn: IDBConnection;
begin
  inherited SetValue(Value);

  Conn := GetComponent(0) as TAureliusConnection;

  // Set AdapterName from AdaptedConnection
  if (Conn.AdapterName = '') and Assigned(Conn.AdaptedConnection) then
    // find an adapter that supports the component
    for Adapter in TAureliusAdapterRegister.Instance.Adapters do
      if Adapter.IsAdaptedConnectionValid(Conn.AdaptedConnection) then
      begin
        Conn.AdapterName := Adapter.Name;
        break;
      end;

  // Try retrieve SQL Dialect
  if (Conn.AdapterName <> '') and Assigned(Conn.AdaptedConnection) and (Conn.SQLDialect = '') then
  try
    DBConn := Conn.CreateConnection;
    Conn.SQLDialect := DBConn.SqlDialect;
  except
  end;
end;

{ TAureliusConnectionEditor }

procedure TAureliusConnectionEditor.CreateImportUnit(const SourceCode: string);
var
  Services: IOTAModuleServices;
  NewUnitIdent, NewClassName, NewFileName: string;
begin
  if Supports(BorlandIDEServices, IOTAModuleServices, Services) then
  begin
    Services.GetNewModuleAndClassName('', NewUnitIdent, NewClassName, NewFileName);
    Services.CreateModule(TAureliusPluginSourceCreator.Create(
      GetConnectionProject, NewUnitIdent, NewFileName, SourceCode));
  end;
end;

procedure TAureliusConnectionEditor.ExecuteConnectionDesigner;
begin
  if TfmConnectionDesigner.Execute(Component as TAureliusConnection) then
    Designer.Modified;
end;

procedure TAureliusConnectionEditor.ExecuteImportPlugin;
var
  Plugin: TAureliusPlugin;
  Conn: IDBConnection;
  PluginOptions: IASPluginOptions;
  Config: TJObject;
begin
  Conn := (Component as TAureliusConnection).CreateConnection;
  Plugin := TAureliusPlugin.Create(Conn);
  try
    try
      PluginOptions := TASPluginOptions.Create;
      if TAureliusConnectionHack(Component as TAureliusConnection).FPluginConfig <> '' then
      begin
        Config := TJson.Deserialize<TJObject>(TAureliusConnectionHack(Component as TAureliusConnection)
                    .FPluginConfig);
        try
          LoadConfig(PluginOptions, Config);
        finally
          Config.Free;
        end;
      end;

      if Plugin.Execute(PluginOptions) then
      begin
        CreateImportUnit(Plugin.SourceCode);

        Config := TJObject.Create;
        try
          SaveConfig(PluginOptions, Config);
          TAureliusConnectionHack(Component as TAureliusConnection).FPluginConfig := TJson.Serialize(Config);
        finally
          Config.Free;
        end;
      end;
    except
      on E: EAureliusPluginException do
        raise ENonAIRException.Create(E.Message);
    end;
  finally
    Plugin.Free;
  end;
end;

procedure TAureliusConnectionEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ExecuteConnectionDesigner;
    1: ExecuteImportPlugin;
  end;
end;

function TAureliusConnectionEditor.GetConnectionProject: IOTAProject;
var
  ModuleServices: IOTAModuleServices;
  Module: IOTAModule;
  OwnerModule: IOTAModule;
begin
  Result := nil;
  ModuleServices := (BorlandIDEServices as IOTAModuleServices);
  Module := ModuleServices.CurrentModule;

  if Module <> nil then
  begin
    if Module.OwnerModuleCount > 0 then
    begin
      OwnerModule := Module.OwnerModules[0];
      if OwnerModule <> nil then
        if OwnerModule.QueryInterface(IOTAProject, Result) <> S_OK then
          Result := nil;
    end;
  end;

  if Result = nil then
    Result := ToolsApi.GetActiveProject;
end;

function TAureliusConnectionEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Connection settings...';
    1: Result := 'Generate entities from database...';
  end;
end;

function TAureliusConnectionEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

{ TAureliusDriverNameProperty }

function TAureliusDriverNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TAureliusDriverNameProperty.GetValues(Proc: TGetStrProc);
var
  Driver: IAureliusDriver;
begin
  for Driver in TAureliusDriverRegister.Instance.Drivers do
    Proc(Driver.Name);
end;

end.
