unit ASPropMan;

{ **************************************************************************** }
{ Rejbrand AlgoSim Property Manager                                            }
{ Copyright © 2018 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Types, Classes, ASNum, ASTree, ASKernelDefs, ASObjects, ASObjStore,
  ASStructs, Generics.Defaults, Generics.Collections;

type
  TPropertyStore = class
  public type
    TSubstores = TObjectDictionary<string, TPropertyStore>;
  strict protected
    FName: string;
    FSubstores: TSubstores;
    function LocalGetValue(const AKey: string): TAlgosimObject; virtual;
    function IsLeaf: Boolean; inline;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure AddSubstore(APropertyStore: TPropertyStore; const AName: string = '');
    procedure DeleteSubstore(ASubstore: TPropertyStore);
    property Name: string read FName;
    property Leaf: Boolean read IsLeaf;
    function GetValue(const AKey: string): TAlgosimObject;
  end;

  TMultiProcPropertyStore = class(TPropertyStore)
  strict protected type
    TPropStoreData = TDictionary<string, TFunc<TAlgosimObject>>;
  var
    FData: TPropStoreData;
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
    procedure AddValue(const AKey: string; AFcn: TFunc<TAlgosimObject>);
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

  TSingleProcPropertyStore = class(TPropertyStore)
  end;

implementation

{ TPropertyStore }

procedure TPropertyStore.AddSubstore(APropertyStore: TPropertyStore; const AName: string = '');
begin
  if Assigned(APropertyStore) and not AName.IsEmpty then
    APropertyStore.FName := AName;
  if Assigned(FSubstores) then
    FSubstores.AddOrSetValue(APropertyStore.Name, APropertyStore);
end;

constructor TPropertyStore.Create;
begin
  FSubstores := TObjectDictionary<string, TPropertyStore>.Create([doOwnsValues]);
end;

procedure TPropertyStore.DeleteSubstore(ASubstore: TPropertyStore);
begin
  if Assigned(FSubstores) then
  begin
    var LKeys := TList<string>.Create;
    try
      for var LSubstore in FSubstores do
        if LSubstore.Value = ASubstore then
          LKeys.Add(LSubstore.Key);
      for var LKey in LKeys do
        FSubstores.Remove(LKey);
    finally
      LKeys.Free;
    end;
  end;
end;

destructor TPropertyStore.Destroy;
begin
  FreeAndNil(FSubstores);
  inherited;
end;

function TPropertyStore.GetValue(const AKey: string): TAlgosimObject;
var
  p: Integer;
  SubstoreName: string;
  Substore: TPropertyStore;
begin

  if Leaf then
    p := 0
  else
    p := Pos('.', AKey);

  if p > 0 then
  begin
    SubstoreName := Copy(AKey, 1, p - 1);
    if FSubstores.TryGetValue(SubstoreName, Substore) then
      Exit(Substore.GetValue(Copy(AKey, p + 1)))
    else
      raise EPropStoreException.CreateFmt(SNoSubstoreInStore, [SubstoreName, FName]);
  end
  else
  begin
    Result := LocalGetValue(AKey);
    if Result = nil then
      raise EPropStoreException.CreateFmt(SNoPropInStore, [AKey, FName]);
  end;

end;

function TPropertyStore.IsLeaf: Boolean;
begin
  Result := (FSubstores = nil) or (FSubstores.Count = 0);
end;

function TPropertyStore.LocalGetValue(const AKey: string): TAlgosimObject;
begin
  Result := nil;
end;

{ TMultiProcPropertyStore }

procedure TMultiProcPropertyStore.AddValue(const AKey: string;
  AFcn: TFunc<TAlgosimObject>);
begin
  FData.Add(AKey, AFcn);
end;

constructor TMultiProcPropertyStore.Create;
begin
  inherited;
  FData := TPropStoreData.Create;
end;

destructor TMultiProcPropertyStore.Destroy;
begin
  FData.Free;
  inherited;
end;

function TMultiProcPropertyStore.LocalGetValue(
  const AKey: string): TAlgosimObject;
var
  fcn: TFunc<TAlgosimObject>;
begin
  Result := inherited;
  if FData.TryGetValue(AKey, fcn) then
    Result := fcn();
end;

end.
