{ *************************************************************************** Copyright (c) 2016-2022 Kike Pérez Unit : Quick.Collections Description : Generic Collections Author : Kike Pérez Version : 1.2 Created : 07/03/2020 Modified : 27/01/2022 This file is part of QuickLib: https://github.com/exilon/QuickLib *************************************************************************** Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. *************************************************************************** } unit Quick.Collections; {$i QuickLib.inc} interface uses System.SysUtils, TypInfo, System.Types, System.Generics.Defaults, System.Generics.Collections, Quick.Linq; type IListBase = interface ['{9A9B2DB9-14E4-49DD-A628-F84F50539F41}'] function GetList: TArray; function GetCapacity: Integer; procedure SetCapacity(Value: Integer); overload; function GetCount : Integer; procedure SetCount(Value: Integer); function GetItem(Index: Integer): T; procedure SetItem(Index: Integer; const Value: T); function GetEnumerator : TEnumerator; function Add(const Value: T): Integer; procedure AddRange(const Values: array of T); overload; procedure AddRange(const Collection: IEnumerable); overload; procedure AddRange(const Collection: TEnumerable); overload; procedure Insert(Index: Integer; const Value: T); procedure InsertRange(Index: Integer; const Values: array of T; Count: Integer); overload; procedure InsertRange(Index: Integer; const Values: array of T); overload; procedure InsertRange(Index: Integer; const Collection: IEnumerable); overload; procedure InsertRange(Index: Integer; const Collection: TEnumerable); overload; function Remove(const Value: T): Integer; function RemoveItem(const Value: T; Direction: TDirection): Integer; procedure Delete(Index: Integer); procedure DeleteRange(AIndex, ACount: Integer); function ExtractItem(const Value: T; Direction: TDirection): T; function Extract(const Value: T): T; function ExtractAt(Index: Integer): T; procedure Exchange(Index1, Index2: Integer); procedure Move(CurIndex, NewIndex: Integer); function First: T; function Last: T; procedure Clear; function Contains(const Value: T): Boolean; function IndexOf(const Value: T): Integer; function IndexOfItem(const Value: T; Direction: TDirection): Integer; function LastIndexOf(const Value: T): Integer; procedure Reverse; procedure Sort; overload; procedure Sort(const AComparer: IComparer); overload; function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; procedure TrimExcess; function ToArray: TArray; procedure FromList(const aList : TList); procedure FromArray(const aArray: TArray); function ToList : TList; property Capacity: Integer read GetCapacity write SetCapacity; property Count: Integer read GetCount write SetCount; property Items[Index: Integer]: T read GetItem write SetItem; default; property List: TArray read GetList; function Any : Boolean; overload; end; IList = interface(IListBase) ['{78952BD5-7D15-42BB-ADCB-2F835DF879A0}'] function Any(const aMatchString : string; aUseRegEx : Boolean) : Boolean; overload; function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; function Where(const aMatchString : string; aUseRegEx : Boolean) : ILinqArray; overload; function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery; overload; function Where(const aWhereClause: string): ILinqQuery; overload; {$IFNDEF FPC} function Where(aPredicate : TPredicate) : ILinqQuery; overload; {$ENDIF} end; IObjectList = interface(IListBase) ['{7380847B-9F94-4FB8-8B73-DC8ACAFF1729}'] function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery; overload; function Where(const aWhereClause: string): ILinqQuery; overload; function Where(aPredicate : TPredicate): ILinqQuery; overload; end; TxList = class(TInterfacedObject,IList) private type arrayofT = array of T; private fList : TList; function GetList: TArray; function GetCapacity: Integer; procedure SetCapacity(Value: Integer); overload; function GetCount : Integer; procedure SetCount(Value: Integer); function GetItem(Index: Integer): T; procedure SetItem(Index: Integer; const Value: T); function GetEnumerator : TEnumerator; public constructor Create; destructor Destroy; override; function Add(const Value: T): Integer; inline; procedure AddRange(const Values: array of T); overload; procedure AddRange(const Collection: IEnumerable); overload; inline; procedure AddRange(const Collection: TEnumerable); overload; procedure Insert(Index: Integer; const Value: T); inline; procedure InsertRange(Index: Integer; const Values: array of T; Count: Integer); overload; procedure InsertRange(Index: Integer; const Values: array of T); overload; procedure InsertRange(Index: Integer; const Collection: IEnumerable); overload; procedure InsertRange(Index: Integer; const Collection: TEnumerable); overload; function Remove(const Value: T): Integer; inline; function RemoveItem(const Value: T; Direction: TDirection): Integer; inline; procedure Delete(Index: Integer); inline; procedure DeleteRange(AIndex, ACount: Integer); inline; function ExtractItem(const Value: T; Direction: TDirection): T; inline; function Extract(const Value: T): T; inline; function ExtractAt(Index: Integer): T; inline; procedure Exchange(Index1, Index2: Integer); inline; procedure Move(CurIndex, NewIndex: Integer); inline; function First: T; inline; function Last: T; inline; procedure Clear; inline; function Contains(const Value: T): Boolean; inline; function IndexOf(const Value: T): Integer; inline; function IndexOfItem(const Value: T; Direction: TDirection): Integer; inline; function LastIndexOf(const Value: T): Integer; inline; procedure Reverse; inline; procedure Sort; overload; inline; procedure Sort(const AComparer: IComparer); overload; inline; function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; inline; function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; inline; procedure TrimExcess; inline; function ToArray: TArray; inline; property Capacity: Integer read GetCapacity write SetCapacity; property Count: Integer read GetCount write SetCount; property Items[Index: Integer]: T read GetItem write SetItem; default; property List: arrayofT read GetList; procedure FromList(const aList : TList); procedure FromArray(const aArray: TArray); function ToList : TList; function Any : Boolean; overload; virtual; function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery; overload; function Where(const aWhereClause: string): ILinqQuery; overload; function Any(const aMatchString : string; aUseRegEx : Boolean) : Boolean; overload; function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; virtual; function Where(const aMatchString : string; aUseRegEx : Boolean) : ILinqArray; overload; {$IFNDEF FPC} function Where(aPredicate : TPredicate) : ILinqQuery; overload; {$ENDIF} end; TxObjectList = class(TxList,IObjectList) private fOwnsObjects : Boolean; procedure InternalOnNotify(Sender: TObject; const Item: T; Action: TCollectionNotification); public constructor Create(aOwnedObjects : Boolean = True); destructor Destroy; override; function Any(const aWhereClause : string; aValues : array of const) : Boolean; overload; override; function Where(const aWhereClause : string; aWhereValues : array of const) : ILinqQuery; overload; function Where(const aWhereClause: string): ILinqQuery; overload; function Where(aPredicate : TPredicate): ILinqQuery; overload; end; ECollectionError = class(Exception); ECollectionNotSupported = class(Exception); implementation { TXList } constructor TxList.Create; begin fList := TList.Create; end; destructor TxList.Destroy; begin fList.Free; inherited; end; function TxList.Add(const Value: T): Integer; begin Result := fList.Add(Value); end; procedure TxList.AddRange(const Values: array of T); begin fList.AddRange(Values); end; procedure TxList.AddRange(const Collection: IEnumerable); begin fList.AddRange(Collection); end; procedure TxList.AddRange(const Collection: TEnumerable); begin fList.AddRange(Collection); end; function TxList.Any(const aMatchString: string; aUseRegEx: Boolean): Boolean; begin Result := Where(aMatchString,aUseRegEx).Any; end; function TxList.Any: Boolean; begin Result := fList.Count > 0; end; function TxList.BinarySearch(const Item: T; out Index: Integer): Boolean; begin Result := fList.BinarySearch(Item,Index); end; function TxList.BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; begin Result := fList.BinarySearch(Item,Index,AComparer); end; procedure TxList.Clear; begin fList.Clear; end; function TxList.Contains(const Value: T): Boolean; begin Result := fList.Contains(Value); end; procedure TxList.Delete(Index: Integer); begin fList.Delete(Index); end; procedure TxList.DeleteRange(AIndex, ACount: Integer); begin fList.DeleteRange(aIndex,aCount); end; procedure TxList.Exchange(Index1, Index2: Integer); begin fList.Exchange(Index1,Index2); end; function TxList.Extract(const Value: T): T; begin Result := fList.Extract(Value); end; function TxList.ExtractAt(Index: Integer): T; begin {$If Defined(FPC) OR Defined(DELPHIRX102_UP)} Result := fList.ExtractAt(Index); {$ELSE} Result := fList.Extract(fList[Index]); {$ENDIF} end; function TxList.ExtractItem(const Value: T; Direction: TDirection): T; begin Result := fList.ExtractItem(Value,Direction); end; function TxList.First: T; begin if fList.Count > 0 then Result := fList.First else Result := default(T); end; procedure TxList.FromList(const aList: TList); var value : T; begin fList.Capacity := aList.Count; for value in aList do fList.Add(value); end; procedure TxList.FromArray(const aArray: TArray); var value : T; begin fList.Capacity := High(aArray); for value in aArray do fList.Add(value); end; function TxList.GetCapacity: Integer; begin Result := fList.Capacity; end; function TxList.GetCount: Integer; begin Result := fList.Count; end; function TxList.GetEnumerator: TEnumerator; begin Result := fList.GetEnumerator; end; function TxList.GetItem(Index: Integer): T; begin Result := fList.Items[Index]; end; function TxList.GetList: TArray; begin Result := fList.ToArray; end; function TxList.IndexOf(const Value: T): Integer; begin Result := fList.IndexOf(Value); end; function TxList.IndexOfItem(const Value: T; Direction: TDirection): Integer; begin Result := fList.IndexOfItem(Value,Direction); end; procedure TxList.Insert(Index: Integer; const Value: T); begin fList.Insert(Index,Value); end; procedure TxList.InsertRange(Index: Integer; const Collection: IEnumerable); begin fList.InsertRange(Index,Collection); end; procedure TxList.InsertRange(Index: Integer; const Collection: TEnumerable); begin fList.InsertRange(index,Collection); end; procedure TxList.InsertRange(Index: Integer; const Values: array of T; Count: Integer); begin {$If Defined(FPC) OR Defined(DELPHIRX102_UP)} fList.InsertRange(Index,Values,Count); {$ELSE} fList.InsertRange(Index,Values); {$ENDIF} end; procedure TxList.InsertRange(Index: Integer; const Values: array of T); begin fList.InsertRange(index,Values); end; function TxList.Last: T; begin if fList.Count > 0 then Result := fList.Last else Result := default(T) end; function TxList.LastIndexOf(const Value: T): Integer; begin Result := fList.LastIndexOf(Value); end; procedure TxList.Move(CurIndex, NewIndex: Integer); begin fList.Move(CurIndex,NewIndex); end; function TxList.Remove(const Value: T): Integer; begin Result := fList.Remove(Value); end; function TxList.RemoveItem(const Value: T; Direction: TDirection): Integer; begin Result := fList.RemoveItem(Value,Direction); end; procedure TxList.Reverse; begin fList.Reverse; end; procedure TxList.SetCapacity(Value: Integer); begin fList.Capacity := Value; end; procedure TxList.SetCount(Value: Integer); begin fList.Count := Value; end; procedure TxList.SetItem(Index: Integer; const Value: T); begin fList.Items[Index] := Value; end; procedure TxList.Sort(const AComparer: IComparer); begin fList.Sort(AComparer); end; procedure TxList.Sort; begin fList.Sort; end; function TxList.ToArray: TArray; begin Result := fList.ToArray; end; function TxList.ToList: TList; var value : T; begin Result := TList.Create; Result.Capacity := fList.Count; for value in fList do Result.Add(value); end; procedure TxList.TrimExcess; begin fList.TrimExcess; end; function TxList.Where(const aMatchString: string; aUseRegEx: Boolean): ILinqArray; begin {$IFDEF DELPHIRX104_UP} Result := TLinqArray.Create(fList.PList^); {$ELSE} Result := TLinqArray.Create(fList.ToArray); {$ENDIF} Result.Where(aMatchString, aUseRegEx); end; function TxList.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery; begin if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList.Where only supports classes. Use MatchString overload method instead!'); Result := TLinqQuery.Create(TObjectList(Self.fList)).Where(aWhereClause,aWhereValues) as ILinqQuery; end; function TxList.Where(const aWhereClause: string): ILinqQuery; begin if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList.Where only supports classes. Use MatchString overload method instead!'); Result := TLinqQuery.Create(TObjectList(Self.fList)).Where(aWhereClause) as ILinqQuery; end; function TxList.Where(aPredicate: TPredicate): ILinqQuery; begin if PTypeInfo(typeInfo(T)).Kind <> tkClass then raise ECollectionNotSupported.Create('TXList.Where only supports classes. Use MatchString overload method instead!'); Result := TLinqQuery.Create(TObjectList(Self.fList)).Where(TPredicate(aPredicate)) as ILinqQuery; end; function TxList.Any(const aWhereClause: string; aValues: array of const): Boolean; begin Result := Where(aWhereClause,aValues).Count > 0; end; { TXObjectList } function TxObjectList.Any(const aWhereClause: string; aValues: array of const): Boolean; var query : ILinqQuery; begin query := TLinqQuery.Create(Self.fList); Result := query.Where(aWhereClause,aValues).Count > 0; end; constructor TxObjectList.Create(aOwnedObjects: Boolean = True); begin inherited Create; fOwnsObjects := aOwnedObjects; fList.OnNotify := InternalOnNotify; end; destructor TxObjectList.Destroy; begin inherited; end; procedure TxObjectList.InternalOnNotify(Sender: TObject; const Item: T; Action: TCollectionNotification); begin if (fOwnsObjects) and (Action = TCollectionNotification.cnRemoved) then begin if Assigned(Item) then Item.DisposeOf; //if PTypeInfo(typeInfo(T)).Kind = tkClass then //PObject(@Item).DisposeOf; end; end; function TxObjectList.Where(const aWhereClause: string): ILinqQuery; begin Result := TLinqQuery.Create(Self.fList).Where(aWhereClause); end; function TxObjectList.Where(const aWhereClause: string; aWhereValues: array of const): ILinqQuery; begin Result := TLinqQuery.Create(Self.fList).Where(aWhereClause,aWhereValues); end; function TxObjectList.Where(aPredicate: TPredicate): ILinqQuery; begin Result := TLinqQuery.Create(Self.fList).Where(aPredicate); end; end.