Quick.Collections.pas 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531
  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. if fList.Count > 0 then Result := fList.First
  258. else Result := default(T);
  259. end;
  260. procedure TxList<T>.FromList(const aList: TList<T>);
  261. var
  262. value : T;
  263. begin
  264. fList.Capacity := aList.Count;
  265. for value in aList do fList.Add(value);
  266. end;
  267. procedure TxList<T>.FromArray(const aArray: TArray<T>);
  268. var
  269. value : T;
  270. begin
  271. fList.Capacity := High(aArray);
  272. for value in aArray do fList.Add(value);
  273. end;
  274. function TxList<T>.GetCapacity: Integer;
  275. begin
  276. Result := fList.Capacity;
  277. end;
  278. function TxList<T>.GetCount: Integer;
  279. begin
  280. Result := fList.Count;
  281. end;
  282. function TxList<T>.GetEnumerator: TEnumerator<T>;
  283. begin
  284. Result := fList.GetEnumerator;
  285. end;
  286. function TxList<T>.GetItem(Index: Integer): T;
  287. begin
  288. Result := fList.Items[Index];
  289. end;
  290. function TxList<T>.GetList: TArray<T>;
  291. begin
  292. Result := fList.ToArray;
  293. end;
  294. function TxList<T>.IndexOf(const Value: T): Integer;
  295. begin
  296. Result := fList.IndexOf(Value);
  297. end;
  298. function TxList<T>.IndexOfItem(const Value: T; Direction: TDirection): Integer;
  299. begin
  300. Result := fList.IndexOfItem(Value,Direction);
  301. end;
  302. procedure TxList<T>.Insert(Index: Integer; const Value: T);
  303. begin
  304. fList.Insert(Index,Value);
  305. end;
  306. procedure TxList<T>.InsertRange(Index: Integer; const Collection: IEnumerable<T>);
  307. begin
  308. fList.InsertRange(Index,Collection);
  309. end;
  310. procedure TxList<T>.InsertRange(Index: Integer; const Collection: TEnumerable<T>);
  311. begin
  312. fList.InsertRange(index,Collection);
  313. end;
  314. procedure TxList<T>.InsertRange(Index: Integer; const Values: array of T; Count: Integer);
  315. begin
  316. fList.InsertRange(Index,Values,Count);
  317. end;
  318. procedure TxList<T>.InsertRange(Index: Integer; const Values: array of T);
  319. begin
  320. fList.InsertRange(index,Values);
  321. end;
  322. function TxList<T>.Last: T;
  323. begin
  324. if fList.Count > 0 then Result := fList.Last
  325. else Result := default(T)
  326. end;
  327. function TxList<T>.LastIndexOf(const Value: T): Integer;
  328. begin
  329. Result := fList.LastIndexOf(Value);
  330. end;
  331. procedure TxList<T>.Move(CurIndex, NewIndex: Integer);
  332. begin
  333. fList.Move(CurIndex,NewIndex);
  334. end;
  335. function TxList<T>.Remove(const Value: T): Integer;
  336. begin
  337. Result := fList.Remove(Value);
  338. end;
  339. function TxList<T>.RemoveItem(const Value: T; Direction: TDirection): Integer;
  340. begin
  341. Result := fList.RemoveItem(Value,Direction);
  342. end;
  343. procedure TxList<T>.Reverse;
  344. begin
  345. fList.Reverse;
  346. end;
  347. procedure TxList<T>.SetCapacity(Value: Integer);
  348. begin
  349. fList.Capacity := Value;
  350. end;
  351. procedure TxList<T>.SetCount(Value: Integer);
  352. begin
  353. fList.Count := Value;
  354. end;
  355. procedure TxList<T>.SetItem(Index: Integer; const Value: T);
  356. begin
  357. fList.Items[Index] := Value;
  358. end;
  359. procedure TxList<T>.Sort(const AComparer: IComparer<T>);
  360. begin
  361. fList.Sort(AComparer);
  362. end;
  363. procedure TxList<T>.Sort;
  364. begin
  365. fList.Sort;
  366. end;
  367. function TxList<T>.ToArray: TArray<T>;
  368. begin
  369. Result := fList.ToArray;
  370. end;
  371. function TxList<T>.ToList: TList<T>;
  372. var
  373. value : T;
  374. begin
  375. Result := TList<T>.Create;
  376. Result.Capacity := fList.Count;
  377. for value in fList do Result.Add(value);
  378. end;
  379. procedure TxList<T>.TrimExcess;
  380. begin
  381. fList.TrimExcess;
  382. end;
  383. function TxList<T>.Where(const aMatchString: string; aUseRegEx: Boolean): ILinqArray<T>;
  384. begin
  385. Result := TLinqArray<T>.Create(fList.ToArray);
  386. Result.Where(aMatchString, aUseRegEx);
  387. end;
  388. function TxList<T>.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery<T>;
  389. begin
  390. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  391. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(aWhereClause,aWhereValues) as ILinqQuery<T>;
  392. end;
  393. function TxList<T>.Where(const aWhereClause: string): ILinqQuery<T>;
  394. begin
  395. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  396. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(aWhereClause) as ILinqQuery<T>;
  397. end;
  398. function TxList<T>.Where(aPredicate: TPredicate<T>): ILinqQuery<T>;
  399. begin
  400. if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList<T>.Where only supports classes. Use MatchString overload method instead!');
  401. Result := TLinqQuery<TObject>.Create(TObjectList<TObject>(Self.fList)).Where(TPredicate<TObject>(aPredicate)) as ILinqQuery<T>;
  402. end;
  403. function TxList<T>.Any(const aWhereClause: string; aValues: array of const): Boolean;
  404. begin
  405. Result := Where(aWhereClause,aValues).Count > 0;
  406. end;
  407. { TXObjectList<T> }
  408. function TxObjectList<T>.Any(const aWhereClause: string; aValues: array of const): Boolean;
  409. var
  410. query : ILinqQuery<T>;
  411. begin
  412. query := TLinqQuery<T>.Create(Self.fList);
  413. Result := query.Where(aWhereClause,aValues).Count > 0;
  414. end;
  415. constructor TxObjectList<T>.Create(aOwnedObjects: Boolean = True);
  416. begin
  417. inherited Create;
  418. fOwnsObjects := aOwnedObjects;
  419. fList.OnNotify := InternalOnNotify;
  420. end;
  421. destructor TxObjectList<T>.Destroy;
  422. begin
  423. inherited;
  424. end;
  425. procedure TxObjectList<T>.InternalOnNotify(Sender: TObject; const Item: T; Action: TCollectionNotification);
  426. begin
  427. if (fOwnsObjects) and (Action = TCollectionNotification.cnRemoved) then
  428. begin
  429. if Assigned(Item) then Item.DisposeOf;
  430. //if PTypeInfo(typeInfo(T)).Kind = tkClass then
  431. //PObject(@Item).DisposeOf;
  432. end;
  433. end;
  434. function TxObjectList<T>.Where(const aWhereClause: string): ILinqQuery<T>;
  435. begin
  436. Result := TLinqQuery<T>.Create(Self.fList).Where(aWhereClause);
  437. end;
  438. function TxObjectList<T>.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery<T>;
  439. begin
  440. Result := TLinqQuery<T>.Create(Self.fList).Where(aWhereClause,aWhereValues);
  441. end;
  442. function TxObjectList<T>.Where(aPredicate: TPredicate<T>): ILinqQuery<T>;
  443. begin
  444. Result := TLinqQuery<T>.Create(Self.fList).Where(aPredicate);
  445. end;
  446. end.