Snippets
Created by
Stefan Glienke
last modified
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | 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.
|
Comments (0)
You can clone a snippet to your computer for local editing. Learn more.