unit SimpleContainer;

interface

uses
  Generics.Collections,
  Rtti,
  SysUtils,
  TypInfo,
  Spring,
  Spring.Collections;

type
  TLifetime = (Transient, Singleton);

  TSimpleContainer = class
  private
    fMappings: IMultiMap<PTypeInfo, TClass>;
    fInstances: IDictionary<TClass, IInterface>;
    fSingletons: ISet<TPair<TClass, PTypeInfo>>;
    function ResolveInstance(serviceType: PTypeInfo; classInfo: TClass): IInterface;
    function CreateInstance(serviceType: PTypeInfo; classInfo: TClass): IInterface;
    function SelectConstructor(serviceType: PTypeInfo; classInfo: TClass): TRttiMethod;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add<T: IInterface; TImplementation: T>(lifetime: TLifetime = Singleton);

    procedure RemoveAll<T: IInterface>; overload;
    procedure Remove<T: IInterface; TImplementation: T>;
    procedure RemoveAll(component: PTypeInfo); overload;

    function Get<T: IInterface>: T; overload;
    function GetAll<T: IInterface>: IEnumerable<T>; overload;

    function Get(component: PTypeInfo): TValue; overload;
    function GetAll(component: PTypeInfo): IEnumerable<IInterface>; overload;
  end;

implementation

uses
  Spring.Reflection;

resourcestring
  NoSuchComponentRegistered =
    'Error loading component %0:s' + sLineBreak +
    'No such component has been registered in the component container.' + sLineBreak + sLineBreak +
    'Suggestions:' + sLineBreak +
    '  1) Ensure you have registered the component to the container.' + sLineBreak +
    '  2) Ensure that you have not removed the component from the container via a call to RemoveAll().';

  NoConstructorsAvailableForComponent =
    'Error loading component %0:s' + sLineBreak +
    'No constructor was available to create an instance of the registered implementation type %1:s.' + sLineBreak + sLineBreak +
    'Suggestions:' + sLineBreak +
    '  1) Ensure that the implementation type has a public constructor.';


{$REGION 'TSimpleContainer'}

constructor TSimpleContainer.Create;
begin
  inherited Create;
  fMappings := TCollections.CreateMultiMap<PTypeInfo, TClass>;
  fInstances := TCollections.CreateDictionary<TClass, IInterface>;
  fSingletons := TCollections.CreateSet<TPair<TClass, PTypeInfo>>;
end;

destructor TSimpleContainer.Destroy;
begin
  fSingletons := nil;
  fInstances := nil;
  fMappings := nil;
  inherited Destroy;
end;

procedure TSimpleContainer.Add<T, TImplementation>(lifetime: TLifetime);
begin
  Assert(ifHasGuid in GetTypeData(TypeInfo(T)).IntfFlags, 'Interface type must have a guid');
  Assert(PTypeInfo(TypeInfo(TImplementation)).Kind = tkClass, 'Implementation type must be a class');

  fMappings.Add(TypeInfo(T), GetTypeData(TypeInfo(TImplementation)).ClassType);
  if lifetime = Singleton then
    fSingletons.Add(TPair<TClass,PTypeInfo>.Create(
      GetTypeData(TypeInfo(TImplementation)).ClassType, TypeInfo(T)));
end;

function TSimpleContainer.CreateInstance(serviceType: PTypeInfo;
  classInfo: TClass): IInterface;
var
  ctor: TRttiMethod;
  parameters: TArray<TRttiParameter>;
  arguments: TArray<TValue>;
  i: Integer;
begin
  ctor := SelectConstructor(serviceType, classInfo);
  parameters := ctor.GetParameters;
  SetLength(arguments, Length(parameters));
  for i := 0 to High(parameters) do
    arguments[i] := Get(parameters[i].ParamType.Handle);

  ctor.Invoke(classInfo, arguments).AsObject.GetInterface(serviceType.TypeData.Guid, Result);
  if fSingletons.Contains(TPair<TClass,PTypeInfo>.Create(classInfo, serviceType)) then
    fInstances.Add(classInfo, Result);
end;

function TSimpleContainer.Get(component: PTypeInfo): TValue;
var
  compType: TRttiType;
  elemType: PTypeInfo;
  toArray: TRttiMethod;
  classInfo: TClass;
begin
  compType := component.RttiType;
  if compType.IsGenericType then
    if compType.IsDynamicArray then
    begin
      elemType := compType.AsDynamicArray.ElementType.Handle;
      Result := TValue.From(GetAll(elemType).ToArray);
      TValueData(Result).FTypeInfo := component;
      Exit;
    end else
    if compType.GetGenericTypeDefinition = 'IEnumerable<>' then
    begin
      if compType.TryGetMethod('ToArray', toArray) then
      begin
        elemType := toArray.ReturnType.AsDynamicArray.ElementType.Handle;
        Result := TValue.From(GetAll(elemType));
        TValueData(Result).FTypeInfo := component;
        Exit;
      end;
    end;

  if not fMappings[component].TryGetFirst(classInfo) then
    raise EInvalidOperationException.CreateResFmt(
      @NoSuchComponentRegistered, [component.TypeName]);

  Result := TValue.From(ResolveInstance(component, classInfo));
  TValueData(Result).FTypeInfo := component;
end;

function TSimpleContainer.Get<T>: T;
begin
  Result := Get(TypeInfo(T)).AsType<T>;
end;

function TSimpleContainer.GetAll(component: PTypeInfo): IEnumerable<IInterface>;
var
  classInfo: TClass;
begin
  Result := TCollections.CreateList<IInterface>;
  for classInfo in fMappings[component] do
    IList<IInterface>(Result).Add(ResolveInstance(component, classInfo));
end;

function TSimpleContainer.GetAll<T>: IEnumerable<T>;
begin
  IEnumerable<IInterface>(Result) := GetAll(TypeInfo(T));
end;

procedure TSimpleContainer.Remove<T, TImplementation>;
begin
  Assert(ifHasGuid in GetTypeData(TypeInfo(T)).IntfFlags, 'Interface type must have a guid');
  Assert(PTypeInfo(TypeInfo(TImplementation)).Kind = tkClass, 'Implementation type must be a class');

  fInstances.Remove(TypeInfo(TImplementation));
  fMappings.Remove(TypeInfo(T), TypeInfo(TImplementation));
end;

procedure TSimpleContainer.RemoveAll(component: PTypeInfo);
var
  classInfo: TClass;
begin
  for classInfo in fMappings[component] do
    fInstances.Remove(classInfo);
  fMappings.Remove(component);
end;

procedure TSimpleContainer.RemoveAll<T>;
begin
  RemoveAll(TypeInfo(T));
end;

function TSimpleContainer.ResolveInstance(serviceType: PTypeInfo;
  classInfo: TClass): IInterface;
begin
  if not fInstances.TryGetValue(classInfo, Result) then
    Result := CreateInstance(serviceType, classInfo);
end;

function TSimpleContainer.SelectConstructor(serviceType: PTypeInfo;
  classInfo: TClass): TRttiMethod;
begin
  if not TType.GetType(classInfo).Constructors.Ordered(
    function(const left, right: TRttiMethod): Integer
    begin
      Result := right.ParameterCount - left.ParameterCount;
      if Result = 0 then
        Result := right.Parent.BaseTypes.Count - left.Parent.BaseTypes.Count;
    end).TryGetFirst(Result) then
    raise EInvalidOperationException.CreateResFmt(
      @NoConstructorsAvailableForComponent, [serviceType.TypeName, classInfo.ClassName]);
end;

{$ENDREGION}


end.