unit Aurelius.Comp.Drivers;

{$I Aurelius.inc}

interface

uses
  SysUtils, Classes, Generics.Collections,
  Aurelius.Drivers.Interfaces,
  Aurelius.Global.Exceptions;

type
  EAureliusDriverException = class(Exception)
  public
    constructor Create(const DriverName, Msg: string); reintroduce;
  end;

  EInvalidDriverParam = class(EAureliusDriverException);
  EDuplicateDriverParam = class(Exception);

  TDriverParamDefs = class;

  IDriverParams = interface
  ['{2E724886-70E3-4482-88EA-1CF6E77806E7}']
    function GetAsString(const ParamName: string; DefaultValue: string = ''): string;
    function GetAsBoolean(const ParamName: string; DefaultValue: Boolean = False): Boolean;
    function GetAsInteger(const ParamName: string; DefaultValue: Integer = 0): Integer;
  end;

  TDriverFactoryArgs = class
  private
    FParams: IDriverParams;
  public
    constructor Create(AParams: TStrings);
    property Params: IDriverParams read FParams;
  end;

  TAureliusDriverFactory = reference to function(Args: TDriverFactoryArgs): IDBConnection;

  IAureliusDriver = interface
  ['{A69B0AF9-6D8F-477D-813F-739BB69F2F56}']
    function GetName: string;
    function GetDriverFactory: TAureliusDriverFactory;
    procedure SetDriverFactory(Value: TAureliusDriverFactory);
    function GetParamDefs: TDriverParamDefs;
    property Name: string read GetName;
    property DriverFactory: TAureliusDriverFactory read GetDriverFactory write SetDriverFactory;
    property ParamDefs: TDriverParamDefs read GetParamDefs;
  end;

  TAureliusDriver = class(TInterfacedObject, IAureliusDriver)
  strict private
    FName: string;
    FDriverFactory: TAureliusDriverFactory;
    FParams: TDriverParamDefs;
  strict protected
    function GetName: string; virtual;
    function GetDriverFactory: TAureliusDriverFactory;
    procedure SetDriverFactory(Value: TAureliusDriverFactory);
    function GetParamDefs: TDriverParamDefs;
  public
    constructor Create(const AName: string);
    destructor Destroy; override;
  end;

  TEditorType = (ptText, ptFilename, ptCombo);

  TDriverParamDef = class
  strict private
    FName: string;
    FEditorType: TEditorType;
    FDefaultValue: string;
    FRequired: boolean;
    FPickList: TList<string>;
  public
    constructor Create(const AName: string);
    destructor Destroy; override;
    procedure DefinePickList(const PickListItems: string);
    property Name: string read FName write FName;
    property EditorType: TEditorType read FEditorType write FEditorType;
    property DefaultValue: string read FDefaultValue write FDefaultValue;
    property Required: boolean read FRequired write FRequired;
    property PickList: TList<string> read FPickList;
  end;

  TDriverParamDefs = class
  strict private
    FParamDefs: TList<TDriverParamDef>;
    function FindParamDef(AName: string): TDriverParamDef;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(const AName: string): TDriverParamDef; overload;
    function Add(const AName: string; ARequired: Boolean): TDriverParamDef; overload;
    function Add(const AName: string; ARequired: Boolean; ADefaultValue: string): TDriverParamDef; overload;
    function AddBoolean(const AName: string): TDriverParamDef;
    function GetParamDefs: TEnumerable<TDriverParamDef>;
    function FindByName(AParamName: string): TDriverParamDef;
  end;

  TDriverParams = class(TInterfacedObject, IDriverParams)
  private
    FParams: TStrings;
    FOwnsParams: Boolean;
    function Exists(const ParamName: string): Boolean;
  public
    constructor Create(AParams: TStrings; AOwnsParams: Boolean = False); overload;
    constructor Create(const ConnectionString: string); overload;
    destructor Destroy; override;
    function GetAsString(const ParamName: string; DefaultValue: string = ''): string;
    function GetAsBoolean(const ParamName: string; DefaultValue: Boolean = False): Boolean;
    function GetAsInteger(const ParamName: string; DefaultValue: Integer = 0): Integer;
  end;

  TAureliusDriverRegister = class
  private
    class var FInstance: TAureliusDriverRegister;
  private
    FDrivers: TDictionary<string, IAureliusDriver>;
    FDriverUnits: TDictionary<string, TArray<string>>;
    procedure PrivateCreate;
    procedure PrivateDestroy;
    function GetDrivers: TEnumerable<IAureliusDriver>;
  public
    function GetDriverUnits(const DriverName: string): TArray<string>;
    procedure RegisterDriverUnits(const DriverName: string; const Units: string);
    procedure RegisterDriverFactory(const DriverName: string; Factory: TAureliusDriverFactory);
  public
    class function Instance: TAureliusDriverRegister;
    procedure RegisterDriver(Driver: IAureliusDriver);
    function GetDriver(const DriverName: string): IAureliusDriver;
    function FindDriver(const DriverName: string): IAureliusDriver;
    property Drivers: TEnumerable<IAureliusDriver> read GetDrivers;
  end;

  EAureliusDriverNotFound = class(EOPFBaseException)
  public
    constructor Create(const DriverName: string);
  end;

implementation

uses
  StrUtils;

function SplitStrings(const Values: string): TArray<string>;
begin
  Result := TArray<string>(SplitString(Values, ','));
end;

{ EAureliusDriverNotFound }

constructor EAureliusDriverNotFound.Create(const DriverName: string);
begin
  inherited CreateFmt('Aurelius connection driver "%s" not found', [DriverName]);
end;

{ TAureliusDriverRegister }

function TAureliusDriverRegister.FindDriver(const DriverName: string): IAureliusDriver;
begin
  if not FDrivers.TryGetValue(UpperCase(DriverName), Result) then
    Result := nil;
end;

function TAureliusDriverRegister.GetDriver(const DriverName: string): IAureliusDriver;
begin
  Result := FindDriver(DriverName);
  if Result = nil then
    raise EAureliusDriverNotFound.Create(DriverName);
end;

function TAureliusDriverRegister.GetDrivers: TEnumerable<IAureliusDriver>;
begin
  Result := FDrivers.Values;
end;

function TAureliusDriverRegister.GetDriverUnits(
  const DriverName: string): TArray<string>;
begin
  if not FDriverUnits.TryGetValue(UpperCase(DriverName), Result) then
    SetLength(Result, 0);
end;

class function TAureliusDriverRegister.Instance: TAureliusDriverRegister;
begin
  if FInstance = nil then
  begin
    FInstance := TAureliusDriverRegister.Create;
    FInstance.PrivateCreate;
  end;
  Result := FInstance;
end;

procedure TAureliusDriverRegister.PrivateCreate;
begin
  FDrivers := TDictionary<string, IAureliusDriver>.Create;
  FDriverUnits := TDictionary<string, TArray<string>>.Create;
end;

procedure TAureliusDriverRegister.PrivateDestroy;
begin
  FDrivers.Free;
  FDriverUnits.Free;
end;

procedure TAureliusDriverRegister.RegisterDriverFactory(
  const DriverName: string; Factory: TAureliusDriverFactory);
var
  Driver: IAureliusDriver;
begin
  Driver := FindDriver(DriverName);
  if Assigned(Driver) then
    Driver.DriverFactory := Factory;
end;

procedure TAureliusDriverRegister.RegisterDriver(Driver: IAureliusDriver);
begin
  if not FDrivers.ContainsKey(UpperCase(Driver.Name)) then
    FDrivers.Add(UpperCase(Driver.Name), Driver)
  else
    FDrivers[UpperCase(Driver.Name)] := Driver;
end;

procedure TAureliusDriverRegister.RegisterDriverUnits(
  const DriverName: string; const Units: string);
begin
  FDriverUnits.AddOrSetValue(UpperCase(DriverName), SplitStrings(Units));
end;

{ TAureliusDriver }

procedure TAureliusDriver.SetDriverFactory(Value: TAureliusDriverFactory);
begin
  FDriverFactory := Value;
end;

constructor TAureliusDriver.Create(const AName: string);
begin
  FName := AName;
  FParams := TDriverParamDefs.Create;
end;

destructor TAureliusDriver.Destroy;
begin
  FParams.Free;
  inherited;
end;

function TAureliusDriver.GetDriverFactory: TAureliusDriverFactory;
begin
  Result := FDriverFactory;
end;

function TAureliusDriver.GetName: string;
begin
  Result := FName;
end;

function TAureliusDriver.GetParamDefs: TDriverParamDefs;
begin
  Result := FParams;
end;

{ TDriverFactoryArgs }

constructor TDriverFactoryArgs.Create(AParams: TStrings);
begin
  FParams := TDriverParams.Create(AParams);
end;

{ TDriverParam }

constructor TDriverParamDef.Create(const AName: string);
begin
  FName := AName;
  FPickList := TList<string>.Create;
end;

procedure TDriverParamDef.DefinePickList(const PickListItems: string);
var
  PickValue: string;
begin
  for PickValue in SplitStrings(PickListItems) do
    FPickList.Add(PickValue);
end;

destructor TDriverParamDef.Destroy;
begin
  FPickList.Free;
  inherited;
end;

{ TDriverParams }

function TDriverParamDefs.Add(const AName: string; ARequired: Boolean;
  ADefaultValue: string): TDriverParamDef;
begin
  if FindParamDef(AName) <> nil then
    raise EDuplicateDriverParam.CreateFmt('Param %s already exists.', [AName]);
  Result := TDriverParamDef.Create(AName);
  FParamDefs.Add(Result);
  Result.Required := ARequired;
  Result.DefaultValue := ADefaultValue;
end;

function TDriverParamDefs.AddBoolean(const AName: string): TDriverParamDef;
begin
  Result := Add(AName);
  Result.EditorType := TEditorType.ptCombo;
  Result.PickList.Add('True');
  Result.PickList.Add('False');
end;

function TDriverParamDefs.Add(const AName: string): TDriverParamDef;
begin
  Result := Add(AName, False, '');
end;

function TDriverParamDefs.Add(const AName: string;
  ARequired: Boolean): TDriverParamDef;
begin
  Result := Add(AName, ARequired, '');
end;

constructor TDriverParamDefs.Create;
begin
  FParamDefs := TObjectList<TDriverParamDef>.Create(True);
end;

destructor TDriverParamDefs.Destroy;
begin
  FParamDefs.Free;
  inherited;
end;

function TDriverParamDefs.FindParamDef(AName: string): TDriverParamDef;
var
  Param: TDriverParamDef;
begin
  Result := nil;
  for Param in FParamDefs do
    if SameText(Param.Name, AName) then
      Exit(Param);
end;

function TDriverParamDefs.GetParamDefs: TEnumerable<TDriverParamDef>;
begin
  Result := FParamDefs;
end;

function TDriverParamDefs.FindByName(AParamName: string): TDriverParamDef;
begin
  Result := FindParamDef(AParamName);
end;

destructor TDriverParams.Destroy;
begin
  if FOwnsParams then
    FParams.Free;
  inherited;
end;

{ TDriverParams }

constructor TDriverParams.Create(AParams: TStrings; AOwnsParams: Boolean = False);
begin
  FParams := AParams;
  FOwnsParams := AOwnsParams;
end;

constructor TDriverParams.Create(const ConnectionString: string);
begin
  Create(TStringList.Create, True);
  FParams.Delimiter := ';';
  FParams.DelimitedText := ConnectionString;
end;

function TDriverParams.Exists(const ParamName: string): Boolean;
begin
  Result := FParams.Values[ParamName] <> '';
end;

function TDriverParams.GetAsBoolean(const ParamName: string;
  DefaultValue: Boolean = False): Boolean;
begin
  if Exists(ParamName) then
    Result := SameText(FParams.Values[ParamName], 'True')
  else
    Result := DefaultValue;
end;

function TDriverParams.GetAsInteger(const ParamName: string;
  DefaultValue: Integer): Integer;
begin
  if Exists(ParamName) then
  begin
    if not TryStrToInt(FParams.Values[ParamName], Result) then
      raise Exception.CreateFmt('"%s" is not a valid integer value for param "%s"',
        [FParams.Values[ParamName], ParamName]);
  end
  else
    Result := DefaultValue;
end;

function TDriverParams.GetAsString(const ParamName: string; DefaultValue: string = ''): string;
begin
  if Exists(ParamName) then
    Result := FParams.Values[ParamName]
  else
    Result := DefaultValue;
end;

{ EAureliusDriverException }

constructor EAureliusDriverException.Create(const DriverName, Msg: string);
begin
  inherited CreateFmt('[%s Driver] %s', [DriverName, Msg]);
end;

initialization
finalization
  if TAureliusDriverRegister.FInstance <> nil then
  begin
    TAureliusDriverRegister.FInstance.PrivateDestroy;
    TAureliusDriverRegister.FInstance.Free;
    TAureliusDriverRegister.FInstance := nil;
  end;

end.
