YARPI: Yet Another Repository Pattern Implementation

Question

Following-up on this post, I wanted to be able to put a copy of that Excel workbook on a USB key and take it home to keep working on the code a bit (there's more than just one or two tables to maintain, so I'll have about a dozen forms when I'm done)... but to be able to test every functionality of my CRUD app without actually hitting the database, I had to get the abstraction level much higher than the typical vba "macro". Guess what abstraction first came to my mind.

^{(comments added for reviewers' convenience, they're not in the actual code)}

IRepository class module

Option Explicit
Public Function GetById(ByVal id As Long) As SqlResultRow
 'because, all my tables have an Id primary key.
End Function
Public Function GetAll() As SqlResult
End Function
Public Function Count() As Long
End Function
Public Sub Add(ByVal value As SqlResultRow)
End Sub
Public Sub Remove(ByVal id As Long)
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
End Sub
Public Function NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
 'creates a new item, out of a Scripting.Dictionary containing field names & values.
 'model: contains the field names.
 'values: field names as key, field values for values.
End Function

---

Before going directly into an implementation of that interface, you need to know a little bit about the classes involved here, if you haven't seen this post (Materializing any ADODB Query) and this post (Creating ADODB Parameters on the fly), they're the foundation that led to this.

About SqlResult & SqlResultRow

All QuickXxxxx methods in the SqlCommand class iterate and consume the ADODB recordset, and take care of opening/closing the connections and the recordset. Because the results have already been iterated when the method returns, the data ends up iterated twice - once in SqlCommand (iterating the recordset), and once in the client code (iterating the DTO's). It's a tradeoff for abstraction and readability, and works very well with smaller datasets. For larger results the class exposes an equivalent API that lets the client deal with the connection, and returns an ADODB.Recordset.

SqlResultRow

The SqlResultRow class is essentially a generic DTO that allows accessing its values by index or by name, like this:

Dim description As String
description = row("description")

The value obtained keeps its type, so if the database has Description (the (削除) indexer (削除ここまで) Item default property is not not case-sensitive) as a VARCHAR(50), then TypeName(row("description")) returns String.

SqlResult

This class encapsulates a List (code here) of SqlResultRow objects, and knows about the column names. Its NewEnum member has a special attribute that makes the type work with a For Each loop, so client code can do this:

sql = "SELECT Foo, DateInserted FROM FooBar WHERE DateInserted > ?;"
Set result = cmd.QuickExecute(sql, Now - 30)
For Each row In result
 Debug.Print row.ToString ' prints a CSV list of the row's values
Next

The delimiter used by ToString is configurable: setting result.ValueSeparator = "|" before entering the loop will cause all rows to use | as a delimiter. If it's not specified, it defaults to a comma.

---

Enough (削除) talk (削除ここまで) context, here's an implementation:

CustomerGroupRepository class module

Option Explicit
Private cmd As New SqlCommand
Implements IRepository
Public Function NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
 
 Dim result As New SqlResultRow
 
 Dim items() As String
 ReDim items(LBound(values.items) To UBound(values.items))
 
 Dim i As Integer
 For i = LBound(values.items) To UBound(values.items)
 items(i) = values.items(i)
 Next
 
 Set NewItem = result.Mock(model, items)
 
End Function
Public Sub Add(ByVal value As SqlResultRow)
 
 Dim sql As String
 sql = "INSERT INTO Planning.CustomerGroups (Description, DateInserted) VALUES (?, ?);"
 
 cmd.QuickExecuteNonQuery sql, value("description"), Now
 
End Sub
Public Function GetAll() As SqlResult
 Dim sql As String
 sql = "SELECT Id, Description FROM Planning.CustomerGroups ORDER BY Id;"
 
 Set GetAll = cmd.QuickExecute(sql)
 
End Function
Public Function GetById(ByVal id As Long) As SqlResultRow
 Dim sql As String
 sql = "SELECT Id, Description FROM Planning.CustomerGroups WHERE Id = ?;"
 
 Set GetById = cmd.QuickSelectFirstRow(sql, id)
 
End Function
Public Sub Remove(ByVal id As Long)
 
 Dim sql As String
 sql = "DELETE FROM Planning.CustomerGroups WHERE Id = ?;"
 
 cmd.QuickExecuteNonQuery sql, id
 
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
 
 Dim sql As String
 sql = "UPDATE Planning.CustomerGroups SET Description = ?, DateUpdated = ? WHERE Id = ?;"
 
 cmd.QuickExecuteNonQuery sql, value("description"), Now, value("id")
 
End Sub
Public Function Count() As Long
 
 Dim sql As String
 sql = "SELECT COUNT(*) FROM Planning.CustomerGroups;"
 
 Count = cmd.QuickSelectSingleValue(sql)
 
End Function
Private Sub IRepository_Add(ByVal value As SqlResultRow)
 Add value
End Sub
Private Function IRepository_Count() As Long
 IRepository_Count = Count
End Function
Private Function IRepository_GetAll() As SqlResult
 Set IRepository_GetAll = GetAll
End Function
Private Function IRepository_GetById(ByVal id As Long) As SqlResultRow
 Set IRepository_GetById = GetById(id)
End Function
Private Function IRepository_NewItem(ByVal model As SqlResult, ByVal values As Scripting.IDictionary) As SqlResultRow
 Set IRepository_NewItem = NewItem(model, values)
End Function
Private Sub IRepository_Remove(ByVal id As Long)
 Remove id
End Sub
Private Sub IRepository_Update(ByVal id As Long, ByVal value As SqlResultRow)
 Update id, value
End Sub

---

MockRepository class module

By property-injecting a mock implementation of this IRepository interface into a Presenter, I can run the UI and test every feature, without hitting the database - and I can work offline on implementing the other features.

Here's the mock implementation in question:

Option Explicit
Private FieldNames As List
Private Items As List
Implements IRepository
Implements IStringRepresentable
Public Sub SetModel(model As SqlResult)
 
 Set FieldNames = model.FieldNames
 Set Items = New List
 
 Dim row As SqlResultRow
 For Each row In model
 Items.Add row
 Next
 
End Sub
Private Function MockSqlResult() As SqlResult
 
 Dim result As New SqlResult
 
 Dim name As Variant
 For Each name In FieldNames
 result.AddFieldName name
 Next
 
 Dim row As SqlResultRow
 For Each row In Items
 result.AddValue row
 Next
 
 Set MockSqlResult = result
 
End Function
Public Function Create(model As SqlResult) As MockRepository
 
 Dim result As New MockRepository
 result.SetModel model
 
 Set Create = result
End Function
Public Sub Add(ByVal value As SqlResultRow)
 
 Dim newId As Long
 newId = Items.Count + 1
 If Items.Last("id") <= newId Then
 newId = Items.Last("id") + 1
 End If
 
 value("id") = newId
 Items.Add value
 
End Sub
Public Function GetAll() As SqlResult
 Set GetAll = MockSqlResult
End Function
Public Function GetById(ByVal id As Long) As SqlResultRow
 Set GetById = Items(id)
 Dim row As SqlResultRow
 For Each row In Items
 If row("id") = id Then
 Set GetById = row
 Exit Function
 End If
 Next
End Function
Public Sub Remove(ByVal id As Long)
 Items.Remove GetById(id)
End Sub
Public Sub Update(ByVal id As Long, ByVal value As SqlResultRow)
 
 Dim row As SqlResultRow
 Set row = GetById(id)
 
 Dim i As Integer
 For i = 1 To value.FieldCount
 If LCase(FieldNames(i)) <> "id" Then
 row(i - 1) = value(i - 1)
 End If
 Next
 
End Sub
Public Function Count() As Long
 Count = Items.Count
End Function
Public Function NewItem(ByVal values As Dictionary) As SqlResultRow
 
 Dim result As New SqlResultRow
 Dim i As Integer
 
 Dim model As New SqlResult
 For i = LBound(values.Keys) To UBound(values.Keys)
 model.AddFieldName values.Keys(i)
 Next
 
 For i = LBound(values.Items) To UBound(values.Items)
 result.AddValue values.Items(i)
 Next
 
 Set result.ParentResult = model
 Set NewItem = result
 
End Function
Public Function ToString() As String
 Dim result As String
 
 Dim Item As IStringRepresentable
 For Each Item In Items
 result = result & Item.ToString & vbNewLine
 Next
 
 ToString = result
End Function
Private Sub IRepository_Add(ByVal value As SqlResultRow)
 Add value
End Sub
Private Function IRepository_Count() As Long
 IRepository_Count = Count
End Function
Private Function IRepository_GetAll() As SqlResult
 Set IRepository_GetAll = GetAll
End Function
Private Function IRepository_GetById(ByVal id As Long) As SqlResultRow
 Set IRepository_GetById = Items(id)
End Function
Private Sub IRepository_Remove(ByVal id As Long)
 Remove id
End Sub
Private Sub IRepository_Update(ByVal id As Long, ByVal value As SqlResultRow)
 Update id, value
End Sub
Private Function IRepository_NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
 Set IRepository_NewItem = NewItem(values)
End Function
Private Function IStringRepresentable_ToString() As String
 IStringRepresentable_ToString = ToString
End Function

---

Writing the above allowed me to write a TestModule that would bring up the UI and behave the same as with the MySQL backend - the idea isn't to write unit tests, it's just to be able to test/run it without the database, and it works like this:

TestModule code module

Option Explicit
Public Sub TestMaintainCustomerGroups()
 
 Dim CustomerGroups As New MockRepository
 Set CustomerGroups = CustomerGroups.Create(GetMockCustomerGroupsModel)
 
 Dim Customers As New MockRepository
 Set Customers = Customers.Create(GetMockCustomersModel)
 
 Dim presenter As New CustomerGroupsPresenter
 Set presenter.CustomerGroupsRepo = CustomerGroups
 Set presenter.CustomersRepo = Customers
 
 presenter.Show
 
End Sub
Private Function GetMockCustomerGroupsModel() As SqlResult
 Dim model As New SqlResult
 model.AddFieldName "Id"
 model.AddFieldName "Description"
 
 Dim row As SqlResultRow
 Dim i As Integer
 For i = 1 To 10
 
 Set row = New SqlResultRow
 Set row.ParentResult = model
 
 row.AddValue i
 row.AddValue "Test" & i
 
 model.AddValue row
 
 Next
 Set GetMockCustomerGroupsModel = model
End Function
Private Function GetMockCustomersModel() As SqlResult
 Dim model As New SqlResult
 model.AddFieldName "Id"
 model.AddFieldName "Code"
 model.AddFieldName "Name"
 model.AddFieldName "CustomerGroupId"
 
 Dim row As SqlResultRow
 Dim i As Integer
 For i = 1 To 10
 
 Set row = New SqlResultRow
 Set row.ParentResult = model
 
 row.AddValue i
 row.AddValue 1000 + i
 row.AddValue "Customer" & i
 row.AddValue 1
 
 model.AddValue row
 
 Next
 Set GetMockCustomersModel = model
End Function

I think we can call this dependency-injection in vba!

• RubberDuck: Did you have any particular concerns about the code?
• Mathieu Guindon: @ckuhn203 Not really, I think this is probably the best OOP-like VBA code I've ever written ;) ...just asking for a peer review / criticism, all comments welcome!

Answer 1

I think this is pretty much done. You have great naming. No glaring bugs as far as I can tell. It's clear and concise. Very OOP, which is impressive given the language. Even the high level design seems pretty darn tight. (I know very little about dependency injection though. I could have missed something that would be obvious to someone else.)

I just can't find anything to pick apart. Well done. Thank you for helping me make the case that VBA is a legitimate programming language in the right hands.

• RubberDuck: Ok, now post a selfie and prove me wrong.
• Vogel612: "legitimate hands" - you and him, huh?
• RubberDuck: Nah. Just himm @Vogel612. I'm a just a hack getting the job done.
• Mathieu Guindon: ...but that would be overkill IMO. Unless you say "we've come this far, might as well go all the way down the rabbit hole"...
• RubberDuck: I said that doing this was overkill. Go ahead and see how far down the rabbit hole goes. =;)-

Answer 2

The NewItem implementation in the CustomerGroupsRepository has something weird going on:

Set NewItem = result.Mock(model, items)

Why add a Mock method to the SqlResultRow type? The SqlResultRow worked fine before, it shouldn't have been modified to accomodate the IRepository implementations. In fact, the NewItem implementation could be written like this:

Public Function NewItem(ByVal model As SqlResult, ByVal values As Dictionary) As SqlResultRow
 Dim result As New SqlResultRow
 Set result.ParentResult = model
 Dim Items() As String
 ReDim Items(LBound(values.Items) To UBound(values.Items))
 Dim i As Integer
 For i = LBound(values.Items) To UBound(values.Items)
 Items(i) = values.Items(i)
 Next
 Set NewItem = result
End Function

Also the name CustomerGroupsRepository isn't ideal, it should be CustomerGroupRepository.

The IStringRepresentable interface is just metadata, it brings nothing really useful to the table - the story would be different if inheritance and polymorphism were supported by the language though, so this:

Dim Item As IStringRepresentable
For Each Item In Items
 result = result & Item.ToString & vbNewLine
Next

Is a useless abstraction, since it is already known that Items is a List<SqlResultRow>: the class is already coupled with SqlResultRow, so IStringRepresentable isn't buying anything.

Rest looks [very] good to me.