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
IPresenterandIRepositoryinterfaces are left unimplemented for theOrderHeadermodel - the presenter is only exposing aRepositoryproperty... which somewhat smells. - The
OrderHeaderPresenter, while physically decoupled from theExcludedOrdersPresenter, is still functionally coupled with it - theFindCommandis prompting the user for an order number to be excluded, which is what needs to happen, but theOrderHeaderPresentershouldn'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?
