Quick.IOC.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894
  1. { ***************************************************************************
  2. Copyright (c) 2016-2022 Kike Pérez
  3. Unit : Quick.IoC
  4. Description : IoC Dependency Injector
  5. Author : Kike Pérez
  6. Version : 1.0
  7. Created : 19/10/2019
  8. Modified : 19/01/2022
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.IoC;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. System.SysUtils,
  26. RTTI,
  27. {$IFDEF DEBUG_IOC}
  28. Quick.Debug.Utils,
  29. {$ENDIF}
  30. System.TypInfo,
  31. System.Generics.Collections,
  32. Quick.Logger.Intf,
  33. Quick.Options;
  34. type
  35. TActivatorDelegate<T> = reference to function: T;
  36. TIocRegistration = class
  37. type
  38. TRegisterMode = (rmTransient, rmSingleton, rmScoped);
  39. private
  40. fName : string;
  41. fRegisterMode : TRegisterMode;
  42. fIntfInfo : PTypeInfo;
  43. fImplementation : TClass;
  44. fActivatorDelegate : TActivatorDelegate<TValue>;
  45. public
  46. constructor Create(const aName : string);
  47. property Name : string read fName;
  48. property IntfInfo : PTypeInfo read fIntfInfo write fIntfInfo;
  49. property &Implementation : TClass read fImplementation write fImplementation;
  50. function IsSingleton : Boolean;
  51. function IsTransient : Boolean;
  52. function IsScoped : Boolean;
  53. function AsSingleton : TIocRegistration;
  54. function AsTransient : TIocRegistration;
  55. function AsScoped : TIocRegistration;
  56. property ActivatorDelegate : TActivatorDelegate<TValue> read fActivatorDelegate write fActivatorDelegate;
  57. end;
  58. TIocRegistrationInterface = class(TIocRegistration)
  59. private
  60. fInstance : IInterface;
  61. public
  62. property Instance : IInterface read fInstance write fInstance;
  63. end;
  64. TIocRegistrationInstance = class(TIocRegistration)
  65. private
  66. fInstance : TObject;
  67. public
  68. property Instance : TObject read fInstance write fInstance;
  69. end;
  70. TIocRegistration<T> = record
  71. private
  72. fRegistration : TIocRegistration;
  73. public
  74. constructor Create(aRegistration : TIocRegistration);
  75. function AsSingleton : TIocRegistration<T>;
  76. function AsTransient : TIocRegistration<T>;
  77. function AsScoped : TIocRegistration<T>;
  78. function DelegateTo(aDelegate : TActivatorDelegate<T>) : TIocRegistration<T>;
  79. end;
  80. IIocRegistrator = interface
  81. ['{F3B79B15-2874-4B66-9B7F-06E2EBFED1AE}']
  82. function GetKey(aPInfo : PTypeInfo; const aName : string = ''): string;
  83. function RegisterType(aTypeInfo : PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration;
  84. function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
  85. procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = '');
  86. end;
  87. TIocRegistrator = class(TInterfacedObject,IIocRegistrator)
  88. private
  89. fDependencies : TDictionary<string,TIocRegistration>;
  90. fDependencyOrder : TList<TIocRegistration>;
  91. public
  92. constructor Create;
  93. destructor Destroy; override;
  94. property Dependencies : TDictionary<string,TIocRegistration> read fDependencies write fDependencies;
  95. property DependencyOrder : TList<TIocRegistration> read fDependencyOrder;
  96. function IsRegistered<TInterface: IInterface; TImplementation: class>(const aName : string = '') : Boolean; overload;
  97. function IsRegistered<T>(const aName : string = '') : Boolean; overload;
  98. function GetKey(aPInfo : PTypeInfo; const aName : string = ''): string;
  99. function RegisterType<TInterface: IInterface; TImplementation: class>(const aName : string = '') : TIocRegistration<TImplementation>; overload;
  100. function RegisterType(aTypeInfo : PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration; overload;
  101. function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration; overload;
  102. function RegisterInstance<T : class>(const aName : string = '') : TIocRegistration<T>; overload;
  103. function RegisterInstance<TInterface : IInterface>(aInstance : TInterface; const aName : string = '') : TIocRegistration; overload;
  104. function RegisterOptions<T : TOptions>(aOptions : T) : TIocRegistration<T>;
  105. procedure Unregister<TInterface: IInterface>(const aName : string = ''); overload;
  106. procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = ''); overload;
  107. end;
  108. IIocContainer = interface
  109. ['{6A486E3C-C5E8-4BE5-8382-7B9BCCFC1BC3}']
  110. function RegisterType(aInterface: PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration;
  111. function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
  112. function Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue;
  113. procedure Unregister(aTypeInfo : PTypeInfo; const aName : string = '');
  114. procedure Build;
  115. end;
  116. IIocInjector = interface
  117. ['{F78E6BBC-2A95-41C9-B231-D05A586B4B49}']
  118. end;
  119. TIocInjector = class(TInterfacedObject,IIocInjector)
  120. end;
  121. IIocResolver = interface
  122. ['{B7C07604-B862-46B2-BF33-FF941BBE53CA}']
  123. function Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue; overload;
  124. end;
  125. TIocResolver = class(TInterfacedObject,IIocResolver)
  126. private
  127. fRegistrator : TIocRegistrator;
  128. fInjector : TIocInjector;
  129. function CreateInstance(aClass : TClass) : TValue;
  130. public
  131. constructor Create(aRegistrator : TIocRegistrator; aInjector : TIocInjector);
  132. function Resolve<T>(const aName : string = ''): T; overload;
  133. function Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue; overload;
  134. function ResolveAll<T>(const aName : string = '') : TList<T>;
  135. end;
  136. TTypedFactory<T : class, constructor> = class(TVirtualInterface)
  137. private
  138. fResolver : TIocResolver;
  139. public
  140. constructor Create(PIID: PTypeInfo; aResolver : TIocResolver);
  141. procedure DoInvoke(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue);
  142. end;
  143. IFactory<T> = interface
  144. ['{92D7AB4F-4C0A-4069-A821-B057E193DE65}']
  145. function New : T;
  146. end;
  147. TSimpleFactory<T : class, constructor> = class(TInterfacedObject,IFactory<T>)
  148. private
  149. fResolver : TIocResolver;
  150. public
  151. constructor Create(aResolver : TIocResolver);
  152. function New : T;
  153. end;
  154. TSimpleFactory<TInterface : IInterface; TImplementation : class, constructor> = class(TInterfacedObject,IFactory<TInterface>)
  155. private
  156. fResolver : TIocResolver;
  157. public
  158. constructor Create(aResolver : TIocResolver);
  159. function New : TInterface;
  160. end;
  161. TIocContainer = class(TInterfacedObject,IIocContainer)
  162. private
  163. fRegistrator : TIocRegistrator;
  164. fResolver : TIocResolver;
  165. fInjector : TIocInjector;
  166. fLogger : ILogger;
  167. class var
  168. GlobalInstance: TIocContainer;
  169. protected
  170. class constructor Create;
  171. class destructor Destroy;
  172. public
  173. constructor Create;
  174. destructor Destroy; override;
  175. function IsRegistered<TInterface: IInterface; TImplementation: class>(const aName: string): Boolean; overload;
  176. function IsRegistered<TInterface : IInterface>(const aName: string): Boolean; overload;
  177. function RegisterType<TInterface: IInterface; TImplementation: class>(const aName : string = '') : TIocRegistration<TImplementation>; overload;
  178. function RegisterType(aInterface: PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration; overload;
  179. function RegisterInstance<T : class>(const aName: string = ''): TIocRegistration<T>; overload;
  180. function RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration; overload;
  181. function RegisterInstance<TInterface : IInterface>(aInstance : TInterface; const aName : string = '') : TIocRegistration; overload;
  182. function RegisterOptions<T : TOptions>(aOptions : TOptions) : TIocRegistration<T>; overload;
  183. function RegisterOptions<T : TOptions>(aOptions : TConfigureOptionsProc<T>) : TIocRegistration<T>; overload;
  184. function Resolve<T>(const aName : string = ''): T; overload;
  185. function Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue; overload;
  186. function ResolveAll<T>(const aName : string = '') : TList<T>;
  187. function AbstractFactory<T : class, constructor>(aClass : TClass) : T; overload;
  188. function AbstractFactory<T : class, constructor> : T; overload;
  189. function RegisterTypedFactory<TFactoryInterface : IInterface; TFactoryType : class, constructor>(const aName : string = '') : TIocRegistration<TTypedFactory<TFactoryType>>;
  190. function RegisterSimpleFactory<TInterface : IInterface; TImplementation : class, constructor>(const aName : string = '') : TIocRegistration;
  191. procedure Unregister<TInterface: IInterface>(const aName : string = ''); overload;
  192. procedure Unregister(aInterface: PTypeInfo; const aName : string = ''); overload;
  193. procedure Build;
  194. end;
  195. TIocServiceLocator = class
  196. public
  197. class function GetService<T> : T;
  198. class function TryToGetService<T: IInterface>(aService : T) : Boolean;
  199. end;
  200. Name = class(TCustomAttribute)
  201. private
  202. fName: string;
  203. public
  204. constructor Create(aName: string);
  205. property Name: String read fName;
  206. end;
  207. EIocRegisterError = class(Exception);
  208. EIocResolverError = class(Exception);
  209. EIocBuildError = class(Exception);
  210. //singleton global instance
  211. function GlobalContainer : TIocContainer;
  212. function ServiceLocator : TIocServiceLocator;
  213. implementation
  214. function GlobalContainer: TIocContainer;
  215. begin
  216. Result := TIocContainer.GlobalInstance;
  217. end;
  218. function ServiceLocator : TIocServiceLocator;
  219. begin
  220. Result := TIocServiceLocator.Create;
  221. end;
  222. { TIocRegistration }
  223. constructor TIocRegistration.Create;
  224. begin
  225. fRegisterMode := TRegisterMode.rmTransient;
  226. end;
  227. function TIocRegistration.AsTransient: TIocRegistration;
  228. begin
  229. Result := Self;
  230. fRegisterMode := TRegisterMode.rmTransient;
  231. end;
  232. function TIocRegistration.AsSingleton : TIocRegistration;
  233. begin
  234. Result := Self;
  235. fRegisterMode := TRegisterMode.rmSingleton;
  236. end;
  237. function TIocRegistration.AsScoped: TIocRegistration;
  238. begin
  239. Result := Self;
  240. fRegisterMode := TRegisterMode.rmScoped;
  241. end;
  242. function TIocRegistration.IsTransient: Boolean;
  243. begin
  244. Result := fRegisterMode = TRegisterMode.rmTransient;
  245. end;
  246. function TIocRegistration.IsSingleton: Boolean;
  247. begin
  248. Result := fRegisterMode = TRegisterMode.rmSingleton;
  249. end;
  250. function TIocRegistration.IsScoped: Boolean;
  251. begin
  252. Result := fRegisterMode = TRegisterMode.rmScoped;
  253. end;
  254. { TIocContainer }
  255. class constructor TIocContainer.Create;
  256. begin
  257. GlobalInstance := TIocContainer.Create;
  258. end;
  259. class destructor TIocContainer.Destroy;
  260. begin
  261. if GlobalInstance <> nil then GlobalInstance.Free;
  262. inherited;
  263. end;
  264. function TIocContainer.AbstractFactory<T>(aClass: TClass): T;
  265. begin
  266. Result := fResolver.CreateInstance(aClass).AsType<T>;
  267. end;
  268. function TIocContainer.AbstractFactory<T> : T;
  269. begin
  270. Result := fResolver.CreateInstance(TClass(T)).AsType<T>;
  271. end;
  272. procedure TIocContainer.Build;
  273. var
  274. dependency : TIocRegistration;
  275. begin
  276. {$IFDEF DEBUG_IOC}
  277. TDebugger.TimeIt(Self,'Build','Container dependencies building...');
  278. {$ENDIF}
  279. for dependency in fRegistrator.DependencyOrder do
  280. begin
  281. try
  282. {$IFDEF DEBUG_IOC}
  283. TDebugger.Trace(Self,'[Building container]: %s',[dependency.fIntfInfo.Name]);
  284. {$ENDIF}
  285. if dependency.IsSingleton then fResolver.Resolve(dependency.fIntfInfo,dependency.Name);
  286. {$IFDEF DEBUG_IOC}
  287. TDebugger.Trace(Self,'[Built container]: %s',[dependency.fIntfInfo.Name]);
  288. {$ENDIF}
  289. except
  290. on E : Exception do raise EIocBuildError.CreateFmt('Build Error on "%s(%s)" dependency: %s!',[dependency.fImplementation.ClassName,dependency.Name,e.Message]);
  291. end;
  292. end;
  293. end;
  294. constructor TIocContainer.Create;
  295. begin
  296. fLogger := nil;
  297. fRegistrator := TIocRegistrator.Create;
  298. fInjector := TIocInjector.Create;
  299. fResolver := TIocResolver.Create(fRegistrator,fInjector);
  300. end;
  301. destructor TIocContainer.Destroy;
  302. begin
  303. fInjector.Free;
  304. fResolver.Free;
  305. fRegistrator.Free;
  306. fLogger := nil;
  307. inherited;
  308. end;
  309. function TIocContainer.IsRegistered<TInterface, TImplementation>(const aName: string): Boolean;
  310. begin
  311. Result := fRegistrator.IsRegistered<TInterface,TImplementation>(aName);
  312. end;
  313. function TIocContainer.IsRegistered<TInterface>(const aName: string): Boolean;
  314. begin
  315. Result := fRegistrator.IsRegistered<TInterface>(aName);
  316. end;
  317. function TIocContainer.RegisterType<TInterface, TImplementation>(const aName: string): TIocRegistration<TImplementation>;
  318. begin
  319. Result := fRegistrator.RegisterType<TInterface, TImplementation>(aName);
  320. end;
  321. function TIocContainer.RegisterType(aInterface: PTypeInfo; aImplementation: TClass; const aName: string): TIocRegistration;
  322. begin
  323. Result := fRegistrator.RegisterType(aInterface,aImplementation,aName);
  324. end;
  325. procedure TIocContainer.Unregister<TInterface>(const aName : string = '');
  326. begin
  327. fRegistrator.Unregister<TInterface>(aName);
  328. end;
  329. procedure TIocContainer.Unregister(aInterface: PTypeInfo; const aName : string = '');
  330. begin
  331. fRegistrator.Unregister(aInterface, aName);
  332. end;
  333. function TIocContainer.RegisterInstance<T>(const aName: string): TIocRegistration<T>;
  334. begin
  335. Result := fRegistrator.RegisterInstance<T>(aName);
  336. end;
  337. function TIocContainer.RegisterTypedFactory<TFactoryInterface,TFactoryType>(const aName: string): TIocRegistration<TTypedFactory<TFactoryType>>;
  338. begin
  339. Result := fRegistrator.RegisterType<TFactoryInterface,TTypedFactory<TFactoryType>>(aName).DelegateTo(function : TTypedFactory<TFactoryType>
  340. begin
  341. Result := TTypedFactory<TFactoryType>.Create(TypeInfo(TFactoryInterface),fResolver);
  342. end);
  343. end;
  344. function TIocContainer.RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
  345. begin
  346. Result := fRegistrator.RegisterInstance(aTypeInfo,aName);
  347. end;
  348. function TIocContainer.RegisterInstance<TInterface>(aInstance: TInterface; const aName: string): TIocRegistration;
  349. begin
  350. Result := fRegistrator.RegisterInstance<TInterface>(aInstance,aName);
  351. end;
  352. function TIocContainer.RegisterOptions<T>(aOptions: TOptions): TIocRegistration<T>;
  353. begin
  354. Result := fRegistrator.RegisterOptions<T>(aOptions).AsSingleton;
  355. end;
  356. function TIocContainer.RegisterOptions<T>(aOptions: TConfigureOptionsProc<T>): TIocRegistration<T>;
  357. var
  358. options : T;
  359. begin
  360. options := T.Create;
  361. aOptions(options);
  362. Result := Self.RegisterOptions<T>(options);
  363. end;
  364. function TIocContainer.RegisterSimpleFactory<TInterface, TImplementation>(const aName: string): TIocRegistration;
  365. begin
  366. Result := fRegistrator.RegisterInstance<IFactory<TInterface>>(TSimpleFactory<TInterface,TImplementation>.Create(fResolver),aName).AsSingleton;
  367. end;
  368. function TIocContainer.Resolve(aServiceType: PTypeInfo; const aName: string): TValue;
  369. begin
  370. Result := fResolver.Resolve(aServiceType,aName);
  371. end;
  372. function TIocContainer.Resolve<T>(const aName : string = ''): T;
  373. begin
  374. Result := fResolver.Resolve<T>(aName);
  375. end;
  376. function TIocContainer.ResolveAll<T>(const aName : string = ''): TList<T>;
  377. begin
  378. Result := fResolver.ResolveAll<T>(aName);
  379. end;
  380. { TIocRegistrator }
  381. constructor TIocRegistrator.Create;
  382. begin
  383. fDependencies := TDictionary<string,TIocRegistration>.Create;
  384. fDependencyOrder := TList<TIocRegistration>.Create;
  385. end;
  386. destructor TIocRegistrator.Destroy;
  387. var
  388. i : Integer;
  389. regs : TArray<TIocRegistration>;
  390. begin
  391. for i := fDependencyOrder.Count-1 downto 0 do
  392. begin
  393. if fDependencyOrder[i] <> nil then
  394. begin
  395. //free singleton instances not interfaced
  396. if (fDependencyOrder[i] is TIocRegistrationInstance) and
  397. (TIocRegistrationInstance(fDependencyOrder[i]).IsSingleton) then
  398. TIocRegistrationInstance(fDependencyOrder[i]).Instance.Free
  399. else
  400. //free singleton instances interfaced
  401. if (fDependencyOrder[i] is TIocRegistrationInterface) and
  402. (TIocRegistrationInterface(fDependencyOrder[i]).IsSingleton) and
  403. (Assigned(TIocRegistrationInterface(fDependencyOrder[i]).Instance)) then
  404. TIocRegistrationInterface(fDependencyOrder[i]).Instance._Release;
  405. fDependencyOrder[i].Free;
  406. end;
  407. end;
  408. fDependencies.Free;
  409. fDependencyOrder.Free;
  410. inherited;
  411. end;
  412. function TIocRegistrator.GetKey(aPInfo : PTypeInfo; const aName : string = ''): string;
  413. begin
  414. {$IFDEF NEXTGEN}
  415. {$IFDEF DELPHISYDNEY_UP}
  416. Result := string(aPInfo.Name);
  417. {$ELSE}
  418. Result := aPInfo .Name.ToString;
  419. {$ENDIF}
  420. {$ELSE}
  421. Result := string(aPInfo.Name);
  422. {$ENDIF}
  423. if not aName.IsEmpty then Result := Result + '.' + aName.ToLower;
  424. end;
  425. function TIocRegistrator.IsRegistered<TInterface, TImplementation>(const aName: string): Boolean;
  426. var
  427. key : string;
  428. reg : TIocRegistration;
  429. begin
  430. Result := False;
  431. key := GetKey(TypeInfo(TInterface),aName);
  432. if fDependencies.TryGetValue(key,reg) then
  433. begin
  434. if reg.&Implementation = TImplementation then Result := True;
  435. end
  436. end;
  437. function TIocRegistrator.IsRegistered<T>(const aName: string): Boolean;
  438. var
  439. key : string;
  440. reg : TIocRegistration;
  441. begin
  442. Result := False;
  443. key := GetKey(TypeInfo(T),aName);
  444. if fDependencies.TryGetValue(key,reg) then
  445. begin
  446. if reg is TIocRegistrationInterface then Result := True
  447. else if (reg is TIocRegistrationInstance) {and (TIocRegistrationInterface(reg).Instance <> nil)} then Result := True;
  448. end
  449. end;
  450. function TIocRegistrator.RegisterInstance<T>(const aName: string): TIocRegistration<T>;
  451. var
  452. reg : TIocRegistration;
  453. begin
  454. reg := RegisterInstance(TypeInfo(T),aName);
  455. Result := TIocRegistration<T>.Create(reg);
  456. end;
  457. function TIocRegistrator.RegisterInstance<TInterface>(aInstance: TInterface; const aName: string): TIocRegistration;
  458. var
  459. key : string;
  460. tpinfo : PTypeInfo;
  461. begin
  462. tpinfo := TypeInfo(TInterface);
  463. key := GetKey(tpinfo,aName);
  464. if fDependencies.TryGetValue(key,Result) then
  465. begin
  466. if Result.&Implementation = tpinfo.TypeData.ClassType then raise EIocRegisterError.Create('Implementation is already registered!');
  467. end
  468. else
  469. begin
  470. Result := TIocRegistrationInterface.Create(aName);
  471. Result.IntfInfo := tpinfo;
  472. TIocRegistrationInterface(Result).Instance := aInstance;
  473. //reg.Instance := T.Create;
  474. fDependencies.Add(key,Result);
  475. fDependencyOrder.Add(Result);
  476. end;
  477. end;
  478. function TIocRegistrator.RegisterInstance(aTypeInfo : PTypeInfo; const aName : string = '') : TIocRegistration;
  479. var
  480. key : string;
  481. begin
  482. key := GetKey(aTypeInfo,aName);
  483. if fDependencies.TryGetValue(key,Result) then
  484. begin
  485. if Result.&Implementation = aTypeInfo.TypeData.ClassType then raise EIocRegisterError.Create('Implementation is already registered!');
  486. end
  487. else
  488. begin
  489. Result := TIocRegistrationInstance.Create(aName);
  490. Result.IntfInfo := aTypeInfo;
  491. Result.&Implementation := aTypeInfo.TypeData.ClassType;
  492. //reg.Instance := T.Create;
  493. fDependencies.Add(key,Result);
  494. fDependencyOrder.Add(Result);
  495. end;
  496. end;
  497. function TIocRegistrator.RegisterOptions<T>(aOptions: T): TIocRegistration<T>;
  498. var
  499. pInfo : PTypeInfo;
  500. key : string;
  501. reg : TIocRegistration;
  502. begin
  503. pInfo := TypeInfo(IOptions<T>);
  504. key := GetKey(pInfo,'');
  505. if fDependencies.TryGetValue(key,reg) then
  506. begin
  507. if reg.&Implementation = aOptions.ClassType then raise EIocRegisterError.Create('Implementation for this interface is already registered!');
  508. end
  509. else
  510. begin
  511. reg := TIocRegistrationInterface.Create('');
  512. reg.IntfInfo := pInfo;
  513. reg.&Implementation := aOptions.ClassType;
  514. TIocRegistrationInterface(reg).Instance := TOptionValue<T>.Create(aOptions);
  515. fDependencies.Add(key,reg);
  516. fDependencyOrder.Add(reg);
  517. end;
  518. Result := TIocRegistration<T>.Create(reg);
  519. end;
  520. function TIocRegistrator.RegisterType<TInterface, TImplementation>(const aName: string): TIocRegistration<TImplementation>;
  521. var
  522. reg : TIocRegistration;
  523. begin
  524. reg := RegisterType(TypeInfo(TInterface),TImplementation,aName);
  525. Result := TIocRegistration<TImplementation>.Create(reg);
  526. end;
  527. function TIocRegistrator.RegisterType(aTypeInfo : PTypeInfo; aImplementation : TClass; const aName : string = '') : TIocRegistration;
  528. var
  529. key : string;
  530. begin
  531. key := GetKey(aTypeInfo,aName);
  532. if fDependencies.TryGetValue(key,Result) then
  533. begin
  534. if Result.&Implementation = aImplementation then raise EIocRegisterError.Create('Implementation for this interface is already registered!')
  535. else Key := key + '#' + TGUID.NewGuid.ToString;
  536. end;
  537. Result := TIocRegistrationInterface.Create(aName);
  538. Result.IntfInfo := aTypeInfo;
  539. Result.&Implementation := aImplementation;
  540. fDependencies.Add(key,Result);
  541. fDependencyOrder.Add(Result);
  542. end;
  543. procedure TIocRegistrator.Unregister<TInterface>(const aName : string);
  544. begin
  545. Unregister(TypeInfo(TInterface), aName);
  546. end;
  547. procedure TIocRegistrator.Unregister(aTypeInfo : PTypeInfo; const aName : string);
  548. var
  549. key: string;
  550. vValue: TIocRegistration;
  551. begin
  552. key := GetKey(aTypeInfo, aName);
  553. if fDependencies.TryGetValue(key,vValue) then
  554. begin
  555. if (vValue.IntfInfo = aTypeInfo) and (vValue.Name = aName) then
  556. begin
  557. if fDependencyOrder.Contains(vValue) then
  558. fDependencyOrder.Remove(vValue);
  559. fDependencies.Remove(key);
  560. vValue.Free;
  561. end;
  562. end;
  563. end;
  564. { TIocResolver }
  565. constructor TIocResolver.Create(aRegistrator : TIocRegistrator; aInjector : TIocInjector);
  566. begin
  567. fRegistrator := aRegistrator;
  568. fInjector := aInjector;
  569. end;
  570. function TIocResolver.CreateInstance(aClass: TClass): TValue;
  571. var
  572. ctx : TRttiContext;
  573. rtype : TRttiType;
  574. rmethod : TRttiMethod;
  575. rParam : TRttiParameter;
  576. value : TValue;
  577. values : TArray<TValue>;
  578. att: TCustomAttribute;
  579. attname: string;
  580. begin
  581. Result := nil;
  582. rtype := ctx.GetType(aClass);
  583. if rtype = nil then Exit;
  584. for rmethod in TRttiInstanceType(rtype).GetMethods do
  585. begin
  586. if rmethod.IsConstructor then
  587. begin
  588. //if create don't have parameters
  589. if Length(rmethod.GetParameters) = 0 then
  590. begin
  591. Result := rmethod.Invoke(TRttiInstanceType(rtype).MetaclassType,[]);
  592. Break;
  593. end
  594. else
  595. begin
  596. for rParam in rmethod.GetParameters do
  597. begin
  598. attname := EmptyStr;
  599. for att in rParam.GetAttributes do
  600. begin
  601. if att is Name then
  602. begin
  603. attname := Name(att).Name;
  604. Break;
  605. end;
  606. end;
  607. value := Resolve(rParam.ParamType.Handle, attname);
  608. values := values + [value];
  609. end;
  610. Result := rmethod.Invoke(TRttiInstanceType(rtype).MetaclassType,values);
  611. Break;
  612. end;
  613. end;
  614. end;
  615. end;
  616. function TIocResolver.Resolve(aServiceType: PTypeInfo; const aName : string = ''): TValue;
  617. var
  618. key : string;
  619. reg : TIocRegistration;
  620. intf : IInterface;
  621. begin
  622. Result := nil;
  623. reg := nil;
  624. key := fRegistrator.GetKey(aServiceType,aName);
  625. {$IFDEF DEBUG_IOC}
  626. TDebugger.Trace(Self,'Resolving dependency: %s',[key]);
  627. {$ENDIF}
  628. if not fRegistrator.Dependencies.TryGetValue(key,reg) then raise EIocResolverError.CreateFmt('Type "%s" not registered for IOC!',[aServiceType.Name]);
  629. //if is singleton return already instance if exists
  630. if reg.IsSingleton then
  631. begin
  632. if reg is TIocRegistrationInterface then
  633. begin
  634. if TIocRegistrationInterface(reg).Instance <> nil then
  635. begin
  636. if TIocRegistrationInterface(reg).Instance.QueryInterface(GetTypeData(aServiceType).Guid,intf) <> 0 then raise EIocResolverError.CreateFmt('Implementation for "%s" not registered!',[aServiceType.Name]);
  637. TValue.Make(@intf,aServiceType,Result);
  638. {$IFDEF DEBUG_IOC}
  639. TDebugger.Trace(Self,'Resolved dependency: %s',[reg.fIntfInfo.Name]);
  640. {$ENDIF}
  641. Exit;
  642. end;
  643. end
  644. else
  645. begin
  646. if TIocRegistrationInstance(reg).Instance <> nil then
  647. begin
  648. Result := TIocRegistrationInstance(reg).Instance;
  649. {$IFDEF DEBUG_IOC}
  650. TDebugger.Trace(Self,'Resolved dependency: %s',[reg.fIntfInfo.Name]);
  651. {$ENDIF}
  652. Exit;
  653. end;
  654. end;
  655. end;
  656. //instance not created yet
  657. if reg.&Implementation = nil then raise EIocResolverError.CreateFmt('Implemention for "%s" not defined!',[aServiceType.Name]);
  658. //use activator if assigned
  659. if reg is TIocRegistrationInterface then
  660. begin
  661. {$IFDEF DEBUG_IOC}
  662. TDebugger.Trace(Self,'Building dependency: %s',[reg.fIntfInfo.Name]);
  663. {$ENDIF}
  664. if Assigned(reg.ActivatorDelegate) then TIocRegistrationInterface(reg).Instance := reg.ActivatorDelegate().AsInterface
  665. else TIocRegistrationInterface(reg).Instance := CreateInstance(reg.&Implementation).AsInterface;
  666. if (TIocRegistrationInterface(reg).Instance = nil) or (TIocRegistrationInterface(reg).Instance.QueryInterface(GetTypeData(aServiceType).Guid,intf) <> 0) then raise EIocResolverError.CreateFmt('Implementation for "%s" not registered!',[aServiceType.Name]);
  667. TValue.Make(@intf,aServiceType,Result);
  668. end
  669. else
  670. begin
  671. {$IFDEF DEBUG_IOC}
  672. TDebugger.Trace(Self,'Building dependency: %s',[reg.fIntfInfo.Name]);
  673. {$ENDIF}
  674. if Assigned(reg.ActivatorDelegate) then TIocRegistrationInstance(reg).Instance := reg.ActivatorDelegate().AsObject
  675. else
  676. begin
  677. TIocRegistrationInstance(reg).Instance := CreateInstance(reg.&Implementation).AsObject;
  678. end;
  679. Result := TIocRegistrationInstance(reg).Instance;
  680. end;
  681. {$IFDEF DEBUG_IOC}
  682. TDebugger.Trace(Self,'Built dependency: %s',[reg.fIntfInfo.Name]);
  683. {$ENDIF}
  684. end;
  685. function TIocResolver.Resolve<T>(const aName : string = ''): T;
  686. var
  687. pInfo : PTypeInfo;
  688. begin
  689. Result := Default(T);
  690. pInfo := TypeInfo(T);
  691. Result := Resolve(pInfo,aName).AsType<T>;
  692. end;
  693. function TIocResolver.ResolveAll<T>(const aName : string = '') : TList<T>;
  694. var
  695. pInfo : PTypeInfo;
  696. reg : TIocRegistration;
  697. begin
  698. Result := TList<T>.Create;
  699. pInfo := TypeInfo(T);
  700. for reg in fRegistrator.fDependencyOrder do
  701. begin
  702. if reg.IntfInfo = pInfo then Self.Resolve(pInfo,aName);
  703. end;
  704. end;
  705. { TIocRegistration<T> }
  706. function TIocRegistration<T>.AsScoped: TIocRegistration<T>;
  707. begin
  708. Result := Self;
  709. fRegistration.AsScoped;
  710. end;
  711. function TIocRegistration<T>.AsSingleton: TIocRegistration<T>;
  712. begin
  713. Result := Self;
  714. fRegistration.AsSingleton;
  715. end;
  716. function TIocRegistration<T>.AsTransient: TIocRegistration<T>;
  717. begin
  718. Result := Self;
  719. fRegistration.AsTransient;
  720. end;
  721. constructor TIocRegistration<T>.Create(aRegistration: TIocRegistration);
  722. begin
  723. fRegistration := aRegistration;
  724. end;
  725. function TIocRegistration<T>.DelegateTo(aDelegate: TActivatorDelegate<T>): TIocRegistration<T>;
  726. begin
  727. Result := Self;
  728. fRegistration.ActivatorDelegate := function: TValue
  729. begin
  730. Result := TValue.From<T>(aDelegate);
  731. end;
  732. end;
  733. { TTypedFactory<T> }
  734. constructor TTypedFactory<T>.Create(PIID: PTypeInfo; aResolver : TIocResolver);
  735. begin
  736. inherited Create(PIID, DoInvoke);
  737. fResolver := aResolver;
  738. end;
  739. procedure TTypedFactory<T>.DoInvoke(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue);
  740. begin
  741. if CompareText(Method.Name,'New') <> 0 then raise Exception.Create('TTypedFactory needs a method "New"');
  742. Result := fResolver.CreateInstance(TClass(T)).AsType<T>;
  743. end;
  744. { TIocServiceLocator }
  745. class function TIocServiceLocator.GetService<T> : T;
  746. begin
  747. Result := GlobalContainer.Resolve<T>;
  748. end;
  749. class function TIocServiceLocator.TryToGetService<T>(aService : T) : Boolean;
  750. begin
  751. Result := GlobalContainer.IsRegistered<T>('');
  752. if Result then aService := GlobalContainer.Resolve<T>;
  753. end;
  754. { TSimpleFactory<T> }
  755. constructor TSimpleFactory<T>.Create(aResolver: TIocResolver);
  756. begin
  757. fResolver := aResolver;
  758. end;
  759. function TSimpleFactory<T>.New: T;
  760. begin
  761. Result := fResolver.CreateInstance(TClass(T)).AsType<T>;
  762. end;
  763. { TSimpleFactory<TInterface, TImplementation> }
  764. constructor TSimpleFactory<TInterface, TImplementation>.Create(aResolver: TIocResolver);
  765. begin
  766. fResolver := aResolver;
  767. end;
  768. function TSimpleFactory<TInterface, TImplementation>.New: TInterface;
  769. begin
  770. Result := fResolver.CreateInstance(TClass(TImplementation)).AsType<TInterface>;
  771. end;
  772. { Name }
  773. constructor Name.Create(aName: string);
  774. begin
  775. fName := aName;
  776. end;
  777. end.