• 1

• 75.5k
• 18
• 194
• 467

Still pursuing the white rabbit, I had an IPresenter interface implementation featuring this method:

Private Sub ExecuteAddCommand()
 
 Dim orderNumber As String
 If Not RequestUserInput(prompt:=GetResourceString("PromptExcludedOrderNumberMessageText"), _
 title:=GetResourceString("AddPromptTitle"), _
 outResult:=orderNumber, _
 default:=0) _
 Then
 Exit Sub
 End If
 
 'tight coupling...
 Dim orderRepo As IRepository
 Set orderRepo = New OrderHeaderRepository
 
 Dim values As New Dictionary
 values.Add "number", orderNumber
 
 Dim orderModel As New SqlResult
 orderModel.AddFieldName "Number"
 
 Dim order As SqlResultRow
 Set order = orderRepo.NewItem(orderModel, values)
 
 Dim orderId As Long
 orderId = orderRepo.FindId(order)
 
 If orderId = 0 Then
 MsgBox StringFormat(GetResourceString("InvalidOrderNumberMessageText"), orderNumber), _
 vbExclamation, _
 GetResourceString("InvalidOrderNumberTitle")
 Exit Sub
 End If
 
 Dim reason As String
 If Not RequestUserInput(prompt:=GetResourceString("AddExcludedOrderMessageText"), _
 title:=GetResourceString("AddPromptTitle"), _
 outResult:=reason, _
 default:=GetResourceString("DefaultExcludedOrderReason")) _
 Then
 Exit Sub
 End If
 
 Repository.Add NewExcludedOrder(orderHeaderId:=orderId, reason:=reason)
 IPresenter_ExecuteCommand RefreshCommand
End Sub

The problem is that, out of 12 implementations so far, it was the only one with such tight coupling - for every single other case, it made sense to implement a "child" presenter with its own repository.

The tightly coupled code works, but can't be tested offline, which was the entire point/purpose of going down the rabbit hole with implementing MVP and Repository patterns in VBA. I had to do something about it.

So I added a FindCommand to the CommandType enum, and implemented an OrderHeaderPresenter:

Option Explicit
Private Type tPresenter
 MasterId As Long
 Repository As IRepository
 DetailsPresenter As IPresenter
 View As IView
End Type
Private this As tPresenter
Implements IPresenter
Private Function NewOrderHeader(Optional ByVal id As Long = 0, Optional ByVal number As String = vbNullString) As SqlResultRow
 
 Dim result As SqlResultRow
 
 Dim values As New Dictionary
 values.Add "id", id
 values.Add "number", number
 
 Dim orderModel As New SqlResult
 orderModel.AddFieldName "id"
 orderModel.AddFieldName "number"
 
 Set result = Repository.NewItem(orderModel, values)
 Set NewOrderHeader = result
 
End Function
Public Property Get Repository() As IRepository
 Set Repository = this.Repository
End Property
Public Property Set Repository(ByVal value As IRepository)
 Set this.Repository = value
End Property
Private Function IPresenter_CanExecuteCommand(ByVal commandId As CommandType) As Boolean
 If commandId = FindCommand Then IPresenter_CanExecuteCommand = True
End Function
Private Property Set IPresenter_DetailsPresenter(ByVal value As IPresenter)
'not implemented
End Property
Private Property Get IPresenter_DetailsPresenter() As IPresenter
'not implemented
End Property
Private Function IPresenter_ExecuteCommand(ByVal commandId As CommandType) As Variant
 
 Select Case commandId
 
 Case CommandType.FindCommand
 IPresenter_ExecuteCommand = ExecuteFindCommand
 
 Case Else
 'not implemented
 
 End Select
 
End Function
Private Function ExecuteFindCommand() As Long
 
 Dim orderNumber As String
 If Not RequestUserInput(prompt:=GetResourceString("PromptExcludedOrderNumberMessageText"), _
 title:=GetResourceString("AddPromptTitle"), _
 outResult:=orderNumber, _
 default:=0) _
 Then
 Exit Function
 End If
 
 Dim order As SqlResultRow
 Set order = NewOrderHeader(number:=orderNumber)
 
 Dim orderId As Long
 orderId = Repository.FindId(order)
 
 If orderId = 0 Then
 MsgBox StringFormat(GetResourceString("InvalidOrderNumberMessageText"), orderNumber), _
 vbExclamation, _
 GetResourceString("InvalidOrderNumberTitle")
 Exit Function
 End If
 
 ExecuteFindCommand = orderId
 
End Function
Private Property Let IPresenter_MasterId(ByVal value As Long)
 this.MasterId = value
End Property
Private Property Get IPresenter_MasterId() As Long
 IPresenter_MasterId = this.MasterId
End Property
Private Property Set IPresenter_Repository(ByVal value As IRepository)
 Set Repository = value
End Property
Private Property Get IPresenter_Repository() As IRepository
 Set IPresenter_Repository = Repository
End Property
Private Sub IPresenter_Show()
'not implemented
End Sub
Private Property Set IPresenter_View(ByVal value As IView)
'not implemented
End Property
Private Property Get IPresenter_View() As IView
'not implemented
End Property

For this to work, I had to change IPresenter.ExecuteCommand from a Sub to a Function returning a Variant, so that commands like Find and Search can return an object or a value.

And that allowed me to refactor my coupled presenter method to this:

Private Sub ExecuteAddCommand()
 
 Dim orderId As Long
 orderId = this.DetailsPresenter.ExecuteCommand(FindCommand)
 
 If orderId = 0 Then Exit Sub
 
 Dim reason As String
 If Not RequestUserInput(prompt:=GetResourceString("AddExcludedOrderMessageText"), _
 title:=GetResourceString("AddPromptTitle"), _
 outResult:=reason, _
 default:=GetResourceString("DefaultExcludedOrderReason")) _
 Then
 Exit Sub
 End If
 
 Repository.Add NewExcludedOrder(orderHeaderId:=orderId, reason:=reason)
 IPresenter_ExecuteCommand RefreshCommand
End Sub

Here's the OrderHeaderRepository implementation, which partly explains the holes in the presenter implementation:

Option Explicit
Private cmd As New SqlCommand
Private Const selectString As String = "SELECT Id, Number, OrderDate, OrderTypeId, SeasonId FROM Planning.OrderHeaders"
Implements IRepository
Private Sub IRepository_Add(ByVal value As SqlResultRow)
'not implemented
End Sub
Private Function IRepository_Count() As Long
 IRepository_Count = RepositoryImpl.Count("Planning.OrderHeaders")
End Function
Private Function IRepository_FindId(ByVal naturalKey As SqlResultRow) As Long
 Dim sql As String
 sql = "SELECT Id FROM Planning.OrderHeaders WHERE Number = ?;"
 
 Dim result As Long
 'todo: find out why query won't return a value with a string parameter.
 ' underlying db table column is a varchar, doesn't make sense to CLng() here.
 result = cmd.QuickSelectSingleValue(sql, CLng(naturalKey("number")))
 
 IRepository_FindId = IIf(IsEmpty(result), 0, result)
End Function
Private Function IRepository_GetAll() As SqlResult
'not implemented. too many results to efficiently process in a SqlResult.
End Function
Private Function IRepository_GetById(ByVal id As Long) As SqlResultRow
 Set IRepository_GetById = RepositoryImpl.GetById(selectString, id)
End Function
Private Function IRepository_NewItem(ByVal Model As SqlResult, ByVal values As Scripting.IDictionary) As SqlResultRow
 Set IRepository_NewItem = RepositoryImpl.NewItem(Model, values)
End Function
Private Sub IRepository_Remove(ByVal id As Long)
'not implemented
End Sub
Private Function IRepository_Search(ByVal terms As SqlResultRow) As SqlResult
'not implemented. possibly too many results to efficiently process with a SqlResult.
End Function
Private Sub IRepository_Update(ByVal id As Long, ByVal value As SqlResultRow)
'not implemented
End Sub

A few things annoy me slightly:

• Most of both IPresenter and IRepository interfaces are left unimplemented for the OrderHeader model - the presenter is only exposing a Repository property... which somewhat smells.
• The OrderHeaderPresenter, while physically decoupled from the ExcludedOrdersPresenter, is still functionally coupled with it - the FindCommand is prompting the user for an order number to be excluded, which is what needs to happen, but the OrderHeaderPresenter shouldn't be using resources meant to be used in another implementation. Or should I just change that string to read something more generic, like "Please enter an order number:"?

Anything else sticks out? Any recommendations?