Context
I'm working on a little project that consists in a series of Microsoft Excel add-ins (.xlam). The code being submitted for review here, is located in the Reflection project:
Feel free to comment on the project architecture, but I'm mostly interested in the Reflection.LinqEnumerable class.
Linq?
Ok not exactly linq, but very much inspired by System.Linq.Enumerable, and only made possible with the Reflection.Delegate class. I'm working on a Grouping class that will enable adding a GroupBy method in there... but for now these are the members of the LinqEnumerable class:
The Object Explorer displays a mini-documentation for the selected method because I've added hidden VB_Description attributes for every public method.
Here's the whole class, with the attributes:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
Dim equatable As IEquatable
If TypeOf value Is IEquatable Then
Set equatable = value
EquateReferenceTypes = equatable.Equals(other)
Else
EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
EquateValueTypes = (value = other)
End Function
Friend Sub Add(ParamArray values())
Dim valuesArray() As Variant
valuesArray = values
AddArray valuesArray
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
AddArray values.ToArray
End Sub
Friend Sub AddArray(values() As Variant)
Dim value As Variant, i As Long
For i = LBound(values) To UBound(values)
encapsulated.Add values(i)
Next
End Sub
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
If IsObject(encapsulated(index)) Then
Set Item = encapsulated(index)
Else
Item = encapsulated(index)
End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
Count = encapsulated.Count
End Property
Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
Contains = (IndexOf(value) <> -1)
End Function
Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In encapsulated
If Not result.Contains(value) Then result.Add value
Next
Set Distinct = result
End Function
Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In encapsulated
If Not values.Contains(value) Then result.Add value
Next
Set Except = result
End Function
Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."
If Count = 0 Then Exit Function
If IsObject(Item(1)) Then
Set First = Item(1)
Else
First = Item(1)
End If
End Function
Public Function FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."
Dim result As New LinqEnumerable
result.AddArray values
Set FromArray = result
End Function
Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In values
result.Add value
Next
Set FromCollection = result
End Function
Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
Dim result As LinqEnumerable
Set result = LinqEnumerable.FromArray(value.ToArray)
Set FromEnumerable = result
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In values
result.Add value
Next
Set FromList = result
End Function
Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."
Dim result As LinqEnumerable
If index > Count Then Err.Raise 9
Dim lastIndex As Long
lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)
Set result = New LinqEnumerable
Dim i As Long
For i = index To lastIndex
result.Add Item(i)
Next
Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."
Dim found As Boolean
Dim isRef As Boolean
If Count = 0 Then IndexOf = -1: Exit Function
Dim i As Long
For i = 1 To Count
If IsObject(Item(i)) Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then IndexOf = i: Exit Function
Next
IndexOf = -1
End Function
Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."
If Count = 0 Then Exit Function
If IsObject(Item(Count)) Then
Set Last = Item(Count)
Else
Last = Item(Count)
End If
End Function
Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."
Dim found As Boolean
Dim isRef As Boolean
LastIndexOf = -1
If Count = 0 Then Exit Function
Dim i As Long
For i = 1 To Count
If IsObject(Item(i)) Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then LastIndexOf = i
Next
End Function
Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."
Dim result() As Variant
ReDim result(1 To Count)
Dim i As Long
If Count = 0 Then Exit Function
For i = 1 To Count
If IsObject(Item(i)) Then
Set result(i) = Item(i)
Else
result(i) = Item(i)
End If
Next
ToArray = result
End Function
Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."
Dim result As New Scripting.Dictionary
Dim value As Variant
For Each value In encapsulated
If valueSelector Is Nothing Then
result.Add keySelector.Execute(value), value
Else
result.Add keySelector.Execute(value), valueSelector.Execute(value)
End If
Next
Set ToDictionary = result
End Function
Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."
Dim result As New VBA.Collection
Dim value As Variant
For Each value In encapsulated
result.Add value
Next
Set ToCollection = result
End Function
Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."
Dim result As System.List
Set result = List.Create
result.AddArray Me.ToArray
Set ToList = result
End Function
Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."
Dim result As LinqEnumerable
Dim element As Variant
For Each element In encapsulated
If TypeName(element) = value Then result.Add element
Next
Set OfTypeName = result
End Function
Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."
Dim result As New LinqEnumerable
Dim element As Variant
For Each element In encapsulated
result.Add selector.Execute(element)
Next
Set SelectValues = result
End Function
Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."
Dim result As New LinqEnumerable
Dim element As Variant
For Each element In encapsulated
'verbose, but works with anything that supports a For Each loop
Dim subList As Variant
Set subList = selector.Execute(element)
Dim subElement As Variant
For Each subElement In subList
result.Add subElement
Next
Next
Set SelectMany = result
End Function
Public Function Aggregate(ByVal accumulator As Delegate) As Variant
Attribute Aggregate.VB_Description = "Applies an accumulator function over a sequence."
Dim result As Variant
Dim isFirst As Boolean
Dim value As Variant
For Each value In encapsulated
If isFirst Then
result = value
isFirst = False
Else
result = accumulator.Execute(result, value)
End If
Next
Aggregate = result
End Function
Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."
Dim result As New LinqEnumerable
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then result.Add element
Next
Set Where = result
End Function
Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
If IsObject(element) Then
Set FirstWhere = element
Else
FirstWhere = element
End If
Exit Function
End If
Next
End Function
Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."
Dim result As Variant
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
If IsObject(element) Then
Set result = element
Else
result = element
End If
End If
Next
If IsObject(result) Then
Set LastWhere = result
Else
LastWhere = result
End If
End Function
Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."
Dim result As Long
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then result = result + 1
Next
CountIf = result
End Function
Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."
Dim element As Variant
For Each element In encapsulated
If Not predicate.Execute(element) Then
Exit Function
End If
Next
AllItems = True
End Function
Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
AnyItem = True
Exit Function
End If
Next
End Function
Note that due to language constraints I had to make some compromises:
- The overload of
Firsttaking a predicate parameter was renamed toFirstWhere; same with theLastoverload, renamed toLastWhere- that's because VBA doesn't support overloading, obviously. Selectwas renamed toSelectValues, because "Select" is a reserved keyword.OfTypewas renamed to the here-more-accurateOfTypeName, since the function is really comparing type names; type comparison is possible in VBA, but not with value types - it's simpler to just take a type name and verify that instead.
So, is this LINQ - Language-INtegrated Query for VBA? Not sure... but this is definitely a number of steps away from the plain old vanilla Collection class.
Example
Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")
Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
.Aggregate(accumulator)
Produces this output:
fox brown quick the
System.Linq.Enumerablecan be implemented now.Enumerable.Wherein VBA was impossible for me, just 2 days ago. \$\endgroup\$Application.Runor the UDF hack \$\endgroup\$AddressOfwill get an additional over-the-top bounty. \$\endgroup\$