Quick.Collections.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529
  1. { ***************************************************************************
  2. Copyright (c) 2016-2020 Kike Pérez
  3. Unit : Quick.Collections
  4. Description : Generic Collections
  5. Author : Kike Pérez
  6. Version : 1.2
  7. Created : 07/03/2020
  8. Modified : 07/04/2020
  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.Collections;
  22. {$i QuickLib.inc}
  23. interface
  24. uses
  25. System.SysUtils,
  26. TypInfo,
  27. System.Types,
  28. System.Generics.Defaults,
  29. System.Generics.Collections,
  30. Quick.Linq;
  31. type
  32. IListBase<T> = interface
  33. ['{9A9B2DB9-14E4-49DD-A628-F84F50539F41}']
  34. function GetList: TArray<T>;
  35. function GetCapacity: Integer;
  36. procedure SetCapacity(Value: Integer); overload;
  37. function GetCount : Integer;
  38. procedure SetCount(Value: Integer);
  39. function GetItem(Index: Integer): T;
  40. procedure SetItem(Index: Integer; const Value: T);
  41. function GetEnumerator : TEnumerator<T>;
  42. function Add(const Value: T): Integer;
  43. procedure AddRange(const Values: array of T); overload;
  44. procedure AddRange(const Collection: IEnumerable<T>); overload;
  45. procedure AddRange(const Collection: TEnumerable<T>); overload;
  46. procedure Insert(Index: Integer; const Value: T);
  47. procedure InsertRange(Index: Integer; const Values: array of T; Count: Integer); overload;
  48. procedure InsertRange(Index: Integer; const Values: array of T); overload;
  49. procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
  50. procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
  51. function Remove(const Value: T): Integer;
  52. function RemoveItem(const Value: T; Direction: TDirection): Integer;
  53. procedure Delete(Index: Integer);
  54. procedure DeleteRange(AIndex, ACount: Integer);
  55. function ExtractItem(const Value: T; Direction: TDirection): T;
  56. function Extract(const Value: T): T;
  57. function ExtractAt(Index: Integer): T;
  58. procedure Exchange(Index1, Index2: Integer);
  59. procedure Move(CurIndex, NewIndex: Integer);
  60. function First: T;
  61. function Last: T;
  62. procedure Clear;
  63. function Contains(const Value: T): Boolean;
  64. function IndexOf(const Value: T): Integer;
  65. function IndexOfItem(const Value: T; Direction: TDirection): Integer;
  66. function LastIndexOf(const Value: T): Integer;
  67. procedure Reverse;
  68. procedure Sort; overload;
  69. procedure Sort(const AComparer: IComparer<T>); overload;
  70. function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
  71. function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
  72. procedure TrimExcess;
  73. function ToArray: TArray<T>;
  74. procedure FromList(const aList : TList<T>);
  75. procedure FromArray(const aArray: TArray<T>);
  76. function ToList : TList<T>;
  77. property Capacity: Integer read GetCapacity write SetCapacity;
  78. property Count: Integer read GetCount write SetCount;
  79. property Items[Index: Integer]: T read GetItem write SetItem; default;
  80. property List: TArray<T> read GetList;
  81. function Any : Boolean; overload;
  82. end;
  83. IList<T> = interface(IListBase<T>)
  84. ['{78952BD5-7D15-42BB-ADCB-2F835DF879A0}']
  85. function Any(const aMatchString : string; aUseRegEx : Boolean) : Boolean; overload;
  86. function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload;
  87. function Where(const aMatchString : string; aUseRegEx : Boolean) : ILinqArray<T>; overload;
  88. function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery<T>; overload;
  89. function Where(const aWhereClause: string): ILinqQuery<T>; overload;
  90. {$IFNDEF FPC}
  91. function Where(aPredicate : TPredicate<T>) : ILinqQuery<T>; overload;
  92. {$ENDIF}
  93. end;
  94. IObjectList<T : class> = interface(IListBase<T>)
  95. ['{7380847B-9F94-4FB8-8B73-DC8ACAFF1729}']
  96. function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload;
  97. function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery<T>; overload;
  98. function Where(const aWhereClause: string): ILinqQuery<T>; overload;
  99. function Where(aPredicate : TPredicate<T>): ILinqQuery<T>; overload;
  100. end;
  101. TxList<T> = class(TInterfacedObject,IList<T>)
  102. private type
  103. arrayofT = array of T;
  104. private
  105. fList : TList<T>;
  106. function GetList: TArray<T>;
  107. function GetCapacity: Integer;
  108. procedure SetCapacity(Value: Integer); overload;
  109. function GetCount : Integer;
  110. procedure SetCount(Value: Integer);
  111. function GetItem(Index: Integer): T;
  112. procedure SetItem(Index: Integer; const Value: T);
  113. function GetEnumerator : TEnumerator<T>;
  114. public
  115. constructor Create;
  116. destructor Destroy; override;
  117. function Add(const Value: T): Integer; inline;
  118. procedure AddRange(const Values: array of T); overload;
  119. procedure AddRange(const Collection: IEnumerable<T>); overload; inline;
  120. procedure AddRange(const Collection: TEnumerable<T>); overload;
  121. procedure Insert(Index: Integer; const Value: T); inline;
  122. procedure InsertRange(Index: Integer; const Values: array of T; Count: Integer); overload;
  123. procedure InsertRange(Index: Integer; const Values: array of T); overload;
  124. procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
  125. procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
  126. function Remove(const Value: T): Integer; inline;
  127. function RemoveItem(const Value: T; Direction: TDirection): Integer; inline;
  128. procedure Delete(Index: Integer); inline;
  129. procedure DeleteRange(AIndex, ACount: Integer); inline;
  130. function ExtractItem(const Value: T; Direction: TDirection): T; inline;
  131. function Extract(const Value: T): T; inline;
  132. function ExtractAt(Index: Integer): T; inline;
  133. procedure Exchange(Index1, Index2: Integer); inline;
  134. procedure Move(CurIndex, NewIndex: Integer); inline;
  135. function First: T; inline;
  136. function Last: T; inline;
  137. procedure Clear; inline;
  138. function Contains(const Value: T): Boolean; inline;
  139. function IndexOf(const Value: T): Integer; inline;
  140. function IndexOfItem(const Value: T; Direction: TDirection): Integer; inline;
  141. function LastIndexOf(const Value: T): Integer; inline;
  142. procedure Reverse; inline;
  143. procedure Sort; overload; inline;
  144. procedure Sort(const AComparer: IComparer<T>); overload; inline;
  145. function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; inline;
  146. function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload; inline;
  147. procedure TrimExcess; inline;
  148. function ToArray: TArray<T>; inline;
  149. property Capacity: Integer read GetCapacity write SetCapacity;
  150. property Count: Integer read GetCount write SetCount;
  151. property Items[Index: Integer]: T read GetItem write SetItem; default;
  152. property List: arrayofT read GetList;
  153. procedure FromList(const aList : TList<T>);
  154. procedure FromArray(const aArray: TArray<T>);
  155. function ToList : TList<T>;
  156. function Any : Boolean; overload; virtual;
  157. function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery<T>; overload;
  158. function Where(const aWhereClause: string): ILinqQuery<T>; overload;
  159. function Any(const aMatchString : string; aUseRegEx : Boolean) : Boolean; overload;
  160. function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; virtual;
  161. function Where(const aMatchString : string; aUseRegEx : Boolean) : ILinqArray<T>; overload;
  162. {$IFNDEF FPC}
  163. function Where(aPredicate : TPredicate<T>) : ILinqQuery<T>; overload;
  164. {$ENDIF}
  165. end;
  166. TxObjectList<T : class> = class(TxList<T>,IObjectList<T>)
  167. private
  168. fOwnsObjects : Boolean;
  169. procedure InternalOnNotify(Sender: TObject; const Item: T; Action: TCollectionNotification);
  170. public
  171. constructor Create(aOwnedObjects : Boolean = True);
  172. destructor Destroy; override;
  173. function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; override;
  174. function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery<T>; overload;
  175. function Where(const aWhereClause: string): ILinqQuery<T>; overload;
  176. function Where(aPredicate : TPredicate<T>): ILinqQuery<T>; overload;
  177. end;
  178. ECollectionError = class(Exception);
  179. ECollectionNotSupported = class(Exception);
  180. implementation
  181. { TXList<T> }
  182. constructor TxList<T>.Create;
  183. begin
  184. fList := TList<T>.Create;
  185. end;
  186. destructor TxList<T>.Destroy;
  187. begin
  188. fList.Free;
  189. inherited;
  190. end;
  191. function TxList<T>.Add(const Value: T): Integer;
  192. begin
  193. Result := fList.Add(Value);
  194. end;
  195. procedure TxList<T>.AddRange(const Values: array of T);
  196. begin
  197. fList.AddRange(Values);
  198. end;
  199. procedure TxList<T>.AddRange(const Collection: IEnumerable<T>);
  200. begin
  201. fList.AddRange(Collection);
  202. end;
  203. procedure TxList<T>.AddRange(const Collection: TEnumerable<T>);
  204. begin
  205. fList.AddRange(Collection);
  206. end;
  207. function TxList<T>.Any(const aMatchString: string; aUseRegEx: Boolean): Boolean;
  208. begin
  209. Result := Where(aMatchString,aUseRegEx).Any;
  210. end;
  211. function TxList<T>.Any: Boolean;
  212. begin
  213. Result := fList.Count > 0;
  214. end;
  215. function TxList<T>.BinarySearch(const Item: T; out Index: Integer): Boolean;
  216. begin
  217. Result := fList.BinarySearch(Item,Index);
  218. end;
  219. function TxList<T>.BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean;
  220. begin
  221. Result := fList.BinarySearch(Item,Index,AComparer);
  222. end;
  223. procedure TxList<T>.Clear;
  224. begin
  225. fList.Clear;
  226. end;
  227. function TxList<T>.Contains(const Value: T): Boolean;
  228. begin
  229. Result := fList.Contains(Value);
  230. end;
  231. procedure TxList<T>.Delete(Index: Integer);
  232. begin
  233. fList.Delete(Index);
  234. end;
  235. procedure TxList<T>.DeleteRange(AIndex, ACount: Integer);
  236. begin
  237. fList.DeleteRange(aIndex,aCount);
  238. end;
  239. procedure TxList<T>.Exchange(Index1, Index2: Integer);
  240. begin
  241. fList.Exchange(Index1,Index2);
  242. end;
  243. function TxList<T>.Extract(const Value: T): T;
  244. begin
  245. Result := fList.Extract(Value);
  246. end;
  247. function TxList<T>.ExtractAt(Index: Integer): T;
  248. begin
  249. Result := fList.ExtractAt(Index);
  250. end;
  251. function TxList<T>.ExtractItem(const Value: T; Direction: TDirection): T;
  252. begin
  253. Result := fList.ExtractItem(Value,Direction);
  254. end;
  255. function TxList<T>.First: T;
  256. begin
  257. Result := fList.First;
  258. end;
  259. procedure TxList<T>.FromList(const aList: TList<T>);
  260. var
  261. value : T;
  262. begin
  263. fList.Capacity := aList.Count;
  264. for value in aList do fList.Add(value);
  265. end;
  266. procedure TxList<T>.FromArray(const aArray: TArray<T>);
  267. var
  268. value : T;
  269. begin
  270. fList.Capacity := High(aArray);
  271. for value in aArray do fList.Add(value);
  272. end;
  273. function TxList<T>.GetCapacity: Integer;
  274. begin
  275. Result := fList.Capacity;
  276. end;
  277. function TxList<T>.GetCount: Integer;
  278. begin
  279. Result := fList.Count;
  280. end;
  281. function TxList<T>.GetEnumerator: TEnumerator<T>;
  282. begin
  283. Result := fList.GetEnumerator;
  284. end;
  285. function TxList<T>.GetItem(Index: Integer): T;
  286. begin
  287. Result := fList.Items[Index];
  288. end;
  289. function TxList<T>.GetList: TArray<T>;
  290. begin
  291. Result := fList.ToArray;
  292. end;
  293. function TxList<T>.IndexOf(const Value: T): Integer;
  294. begin
  295. Result := fList.IndexOf(Value);
  296. end;
  297. function TxList<T>.IndexOfItem(const Value: T; Direction: TDirection): Integer;
  298. begin
  299. Result := fList.IndexOfItem(Value,Direction);
  300. end;
  301. procedure TxList<T>.Insert(Index: Integer; const Value: T);
  302. begin
  303. fList.Insert(Index,Value);
  304. end;
  305. procedure TxList<T>.InsertRange(Index: Integer; const Collection: IEnumerable<T>);
  306. begin
  307. fList.InsertRange(Index,Collection);
  308. end;
  309. procedure TxList<T>.InsertRange(Index: Integer; const Collection: TEnumerable<T>);
  310. begin
  311. fList.InsertRange(index,Collection);
  312. end;
  313. procedure TxList<T>.InsertRange(Index: Integer; const Values: array of T; Count: Integer);
  314. begin
  315. fList.InsertRange(Index,Values,Count);
  316. end;
  317. procedure TxList<T>.InsertRange(Index: Integer; const Values: array of T);
  318. begin
  319. fList.InsertRange(index,Values);
  320. end;
  321. function TxList<T>.Last: T;
  322. begin
  323. Result := fList.Last;
  324. end;
  325. function TxList<T>.LastIndexOf(const Value: T): Integer;
  326. begin
  327. Result := fList.LastIndexOf(Value);
  328. end;
  329. procedure TxList<T>.Move(CurIndex, NewIndex: Integer);
  330. begin
  331. fList.Move(CurIndex,NewIndex);
  332. end;
  333. function TxList<T>.Remove(const Value: T): Integer;
  334. begin
  335. Result := fList.Remove(Value);
  336. end;
  337. function TxList<T>.RemoveItem(const Value: T; Direction: TDirection): Integer;
  338. begin
  339. Result := fList.RemoveItem(Value,Direction);
  340. end;
  341. procedure TxList<T>.Reverse;
  342. begin
  343. fList.Reverse;
  344. end;
  345. procedure TxList<T>.SetCapacity(Value: Integer);
  346. begin
  347. fList.Capacity := Value;
  348. end;
  349. procedure TxList<T>.SetCount(Value: Integer);
  350. begin
  351. fList.Count := Value;
  352. end;
  353. procedure TxList<T>.SetItem(Index: Integer; const Value: T);
  354. begin
  355. fList.Items[Index] := Value;
  356. end;
  357. procedure TxList<T>.Sort(const AComparer: IComparer<T>);
  358. begin
  359. fList.Sort(AComparer);
  360. end;
  361. procedure TxList<T>.Sort;
  362. begin
  363. fList.Sort;
  364. end;
  365. function TxList<T>.ToArray: TArray<T>;
  366. begin
  367. Result := fList.ToArray;
  368. end;
  369. function TxList<T>.ToList: TList<T>;
  370. var
  371. value : T;
  372. begin
  373. Result := TList<T>.Create;
  374. Result.Capacity := fList.Count;
  375. for value in fList do Result.Add(value);
  376. end;
  377. procedure TxList<T>.TrimExcess;
  378. begin
  379. fList.TrimExcess;
  380. end;
  381. function TxList<T>.Where(const aMatchString: string; aUseRegEx: Boolean): ILinqArray<T>;
  382. begin
  383. Result := TLinqArray<T>.Create(fList.ToArray);
  384. Result.Where(aMatchString, aUseRegEx);
  385. end;
  386. function TxList<T>.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery<T>;
  387. begin
  388. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  389. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(aWhereClause,aWhereValues) as ILinqQuery<T>;
  390. end;
  391. function TxList<T>.Where(const aWhereClause: string): ILinqQuery<T>;
  392. begin
  393. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  394. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(aWhereClause) as ILinqQuery<T>;
  395. end;
  396. function TxList<T>.Where(aPredicate: TPredicate<T>): ILinqQuery<T>;
  397. begin
  398. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  399. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(TPredicate<TObject>(aPredicate)) as ILinqQuery<T>;
  400. end;
  401. function TxList<T>.Any(const aWhereClause: string; aValues: array of const): Boolean;
  402. begin
  403. Result := Where(aWhereClause,aValues).Count > 0;
  404. end;
  405. { TXObjectList<T> }
  406. function TxObjectList<T>.Any(const aWhereClause: string; aValues: array of const): Boolean;
  407. var
  408. query : ILinqQuery<T>;
  409. begin
  410. query := TLinqQuery<T>.Create(Self.fList);
  411. Result := query.Where(aWhereClause,aValues).Count > 0;
  412. end;
  413. constructor TxObjectList<T>.Create(aOwnedObjects: Boolean = True);
  414. begin
  415. inherited Create;
  416. fOwnsObjects := aOwnedObjects;
  417. fList.OnNotify := InternalOnNotify;
  418. end;
  419. destructor TxObjectList<T>.Destroy;
  420. begin
  421. inherited;
  422. end;
  423. procedure TxObjectList<T>.InternalOnNotify(Sender: TObject; const Item: T; Action: TCollectionNotification);
  424. begin
  425. if (fOwnsObjects) and (Action = TCollectionNotification.cnRemoved) then
  426. begin
  427. if Assigned(Item) then Item.DisposeOf;
  428. //if PTypeInfo(typeInfo(T)).Kind = tkClass then
  429. //PObject(@Item).DisposeOf;
  430. end;
  431. end;
  432. function TxObjectList<T>.Where(const aWhereClause: string): ILinqQuery<T>;
  433. begin
  434. Result := TLinqQuery<T>.Create(Self.fList).Where(aWhereClause);
  435. end;
  436. function TxObjectList<T>.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery<T>;
  437. begin
  438. Result := TLinqQuery<T>.Create(Self.fList).Where(aWhereClause,aWhereValues);
  439. end;
  440. function TxObjectList<T>.Where(aPredicate: TPredicate<T>): ILinqQuery<T>;
  441. begin
  442. Result := TLinqQuery<T>.Create(Self.fList).Where(aPredicate);
  443. end;
  444. end.