Return to Question

###Examples

Examples

Predeclared Class: TwoWayMapping

Predeclared Class: TwoWayMapping

'@Folder("Operator Framework.Common")
'@IgnoreModule IndexedDefaultMemberAccess: It's fine for collections I think
Option Explicit
'@PredeclaredId
Private Type mappingData
 AtoB As New Dictionary 'Use dictionary as this allows any item as key, not just strings as with collections
 BtoA As New Dictionary 'Auto-instantiate so we don't need growMapping to worry about whether the map was initialised
End Type
Public Enum gtMappingErrors
 [_ErrBase] = 1 'set to a different value for each class in a project
 mismatchedLengthError = vbObjectError + [_ErrBase]
 setsNotIterableError
 valueNotInMapError
End Enum
Private this As mappingData
Public Function Create(ByVal iterableA As Variant, ByVal iterableB As Variant) As TwoWayMapping
 With New TwoWayMapping
 .growMapping iterableA, iterableB
 Set Create = .Self
 End With
End Function
Friend Property Get Self() As TwoWayMapping
 Set Self = Me
End Property
'@Description("Create key - value pairs mapping items from A to B (and vice-versa) based on each item's index within the collection. iterableA and iterableB should be ordered iterables of equal length. Adds to existing mapping")
Public Sub growMapping(ByVal iterableA As Variant, ByVal iterableB As Variant)
 Const errorSourceName As String = "growMapping" 'CHECK
 
 'need data to be in some form that can be indexed, as For..Each only operates on one at a time
 On Error GoTo readIterableFail
 Dim aValues As Collection
 Set aValues = collectionFromIterable(iterableA)
 
 Dim bValues As Collection
 Set bValues = collectionFromIterable(iterableB)
 
 On Error GoTo cleanFail
 If aValues.Count <> bValues.Count Then raiseError mismatchedLengthError, errorSourceName
 
 Dim i As Long
 For i = 1 To aValues.Count
 this.AtoB.Add aValues(i), bValues(i)
 this.BtoA.Add bValues(i), aValues(i)
 Next i
 Debug.Print 1 / 0
 Exit Sub
 
readIterableFail:
 Const objectNotIterableError As Long = 438 'object does not support method
 Const typeNotIterableError As Long = 13 'type mismatch
 Select Case Err.Number
 Case objectNotIterableError, typeNotIterableError
 raiseError setsNotIterableError, errorSourceName
 
 Case Else
 raiseError Err.Number, errorSourceName
 
 End Select
 Resume 'comment out error raising and break here to debug
 
cleanFail:
 raiseError Err.Number, errorSourceName
 Resume 'comment out error raising and break here to debug
 
End Sub
Private Property Get collectionFromIterable(ByVal iterable As Variant) As Collection
 Dim item As Variant
 Dim result As New Collection 'auto-instantiate so we always return a valid collection, even if no members
 For Each item In iterable
 result.Add item
 Next item
 Set collectionFromIterable = result
End Property
Public Property Get AfromB(ByVal bValue As Variant) As Variant
 Const errorSourceName As String = "AfromB" 'CHECK
 If this.BtoA.Exists(bValue) Then
 Assign(AfromB) = this.BtoA(bValue)
 Else
 raiseError valueNotInMapError, errorSourceName
 End If
End Property
Public Property Get BfromA(ByVal aValue As Variant) As Variant
 Const errorSourceName As String = "BfromA" 'CHECK
 If this.AtoB.Exists(aValue) Then 'without this check, aValue is silently added to the dictionary which is probably not what we want
 Assign(BfromA) = this.AtoB(aValue)
 Else
 raiseError valueNotInMapError, errorSourceName
 End If
End Property
Private Sub raiseError(ByVal errNum As gtMappingErrors, Optional ByVal sourceMethod As String = vbNullString)
 Select Case errNum 'overwrite description with custom error text - case else would be keep default and rethrow error
 Case gtMappingErrors.mismatchedLengthError
 Err.Description = "iterableA and iterableB must have a 1 to 1 correspondence (i.e. must have the same length)"
 
 Case gtMappingErrors.setsNotIterableError
 Err.Description = "One of iterableA and iterableB is not iterable. For single values, wrap in Array()"
 
 Case gtMappingErrors.valueNotInMapError
 Err.Description = "That value cannot be found in the map, ensure it is of the same data type as the original keys"
 
 End Select
 'REVIEW: does Source actually do anything?
 Err.Raise errNum, Source:=IIf(sourceMethod = vbNullString, TypeName(Me), printf("{0}.{1}", TypeName(Me), sourceMethod))
End Sub

How does this look? Where can my comments be improved, or the functionality be made better - are there any methods missing? Is the error handling alright? What about organisation of code within the module?

'@Folder("Operator Framework.Common")
'@IgnoreModule IndexedDefaultMemberAccess: It's fine for collections I think
Option Explicit
'@PredeclaredId
Private Type mappingData
 AtoB As New Dictionary 'Use dictionary as this allows any item as key, not just strings as with collections
 BtoA As New Dictionary 'Auto-instantiate so we don't need growMapping to worry about whether the map was initialised
End Type
Public Enum gtMappingErrors
 [_ErrBase] = 1 'set to a different value for each class in a project
 mismatchedLengthError = vbObjectError + [_ErrBase]
 setsNotIterableError
 valueNotInMapError
End Enum
Private this As mappingData
Public Function Create(ByVal iterableA As Variant, ByVal iterableB As Variant) As TwoWayMapping
 With New TwoWayMapping
 .growMapping iterableA, iterableB
 Set Create = .Self
 End With
End Function
Friend Property Get Self() As TwoWayMapping
 Set Self = Me
End Property
'@Description("Create key - value pairs mapping items from A to B (and vice-versa) based on each item's index within the collection. iterableA and iterableB should be ordered iterables of equal length. Adds to existing mapping")
Public Sub growMapping(ByVal iterableA As Variant, ByVal iterableB As Variant)
 Const errorSourceName As String = "growMapping" 'CHECK
 
 'need data to be in some form that can be indexed, as For..Each only operates on one at a time
 On Error GoTo readIterableFail
 Dim aValues As Collection
 Set aValues = collectionFromIterable(iterableA)
 
 Dim bValues As Collection
 Set bValues = collectionFromIterable(iterableB)
 
 On Error GoTo cleanFail
 If aValues.Count <> bValues.Count Then raiseError mismatchedLengthError, errorSourceName
 
 Dim i As Long
 For i = 1 To aValues.Count
 this.AtoB.Add aValues(i), bValues(i)
 this.BtoA.Add bValues(i), aValues(i)
 Next i
 Exit Sub
 
readIterableFail:
 Const objectNotIterableError As Long = 438 'object does not support method
 Const typeNotIterableError As Long = 13 'type mismatch
 Select Case Err.Number
 Case objectNotIterableError, typeNotIterableError
 raiseError setsNotIterableError, errorSourceName
 
 Case Else
 raiseError Err.Number, errorSourceName
 
 End Select
 Resume 'comment out error raising and break here to debug
 
cleanFail:
 raiseError Err.Number, errorSourceName
 Resume 'comment out error raising and break here to debug
 
End Sub
Private Property Get collectionFromIterable(ByVal iterable As Variant) As Collection
 Dim item As Variant
 Dim result As New Collection 'auto-instantiate so we always return a valid collection, even if no members
 For Each item In iterable
 result.Add item
 Next item
 Set collectionFromIterable = result
End Property
Public Property Get AfromB(ByVal bValue As Variant) As Variant
 Const errorSourceName As String = "AfromB" 'CHECK
 If this.BtoA.Exists(bValue) Then
 Assign(AfromB) = this.BtoA(bValue)
 Else
 raiseError valueNotInMapError, errorSourceName
 End If
End Property
Public Property Get BfromA(ByVal aValue As Variant) As Variant
 Const errorSourceName As String = "BfromA" 'CHECK
 If this.AtoB.Exists(aValue) Then 'without this check, aValue is silently added to the dictionary which is probably not what we want
 Assign(BfromA) = this.AtoB(aValue)
 Else
 raiseError valueNotInMapError, errorSourceName
 End If
End Property
Private Sub raiseError(ByVal errNum As gtMappingErrors, Optional ByVal sourceMethod As String = vbNullString)
 Select Case errNum 'overwrite description with custom error text - case else would be keep default and rethrow error
 Case gtMappingErrors.mismatchedLengthError
 Err.Description = "iterableA and iterableB must have a 1 to 1 correspondence (i.e. must have the same length)"
 
 Case gtMappingErrors.setsNotIterableError
 Err.Description = "One of iterableA and iterableB is not iterable. For single values, wrap in Array()"
 
 Case gtMappingErrors.valueNotInMapError
 Err.Description = "That value cannot be found in the map, ensure it is of the same data type as the original keys"
 
 End Select
 'REVIEW: does Source actually do anything?
 Err.Raise errNum, Source:=IIf(sourceMethod = vbNullString, TypeName(Me), printf("{0}.{1}", TypeName(Me), sourceMethod))
End Sub

How does this look? Where can my comments be improved, or the functionality made better - are there any methods missing? Is the error handling alright? What about organisation of code within the module?