Here’s how the promise framework is implemented. This is kind of extreme VBA and Excel is very unforgiving. If you are playing around with this, I advise saving often.
cDeferred versus cPromise
These two classes tend to be used interchangeably in some of my descriptions, but they are quite different. In my VBA implementation, a promise is a property of a deferred. A deferred is used to signal status and record the data to be passed following some action, whereas a promise is the messenger of that status. Generally speaking deferreds are accessed by the performer of the action just once, and are about sending a signal. Promises are used to react to the resolution of an action and are about receiving a signal. A typical app might look like this in pseudo code, where the ‘process’ class would take care of doing something with data retrieved asynchronously. sub asyncdata asyncdata.done(process,"store").fail(process,"error")end sub
function asyncdata set defer = new cDeferred getsomedata(defer)end function sub getsomedata(defer) data = getthedata
if (somerror) then defer.reject(someerror) else defer.resolve(data) endif end sub
cDeferred class
The deferred object is the parent of the cPromise class. The main interface members of the cDeferred class are
- .resolve ( array(data) )
this is called to signal the promise that it can execute its .done() method. It is recommended that data is encapsulated in an array so that extra items can be added later, and to protect the messenger classes from needing to worry about data typing. Self reference is returned for chaining.
- .reject( array(errorData) )
this is called to signal the promise that it can execute its .fail() method. It is recommended that data is encapsulated in an array so that extra items can be added later, and to protect the messenger classes from needing to worry about data typing. Self reference is returned for chaining. Each of these signal their .promise by raising a .completed( array(data) ) event, which .promise is listening for. Option Explicit' this is vba hack of a jquery $.Deferred()Private pPromise As cPromisePrivate pStatus As Long' this will be raised when resolved/rejected to coerce promise executionPublic Event completed(data As Variant)Public Property Get isResolved() As Boolean isResolved = (pStatus = 1)End PropertyPublic Property Get isRejected() As Boolean isRejected = (pStatus = 2)End PropertyPublic Property Get isCompleted() As Boolean isCompleted = isRejected Or isResolvedEnd PropertyPublic Property Get promise() As cPromise Set promise = pPromiseEnd PropertyPrivate Function complete(data As Variant) As cDeferred ' the data can be a series of arguments promise.setData (data) Set complete = Me ' alert promise we've been completed RaiseEvent completed(data)End FunctionPublic Function resolve(data As Variant) As cDeferred ' all is good - will execite promise.done() pStatus = 1 Set resolve = complete(data)End FunctionPublic Function reject(data As Variant) As cDeferred ' all is bad - will execute promise.fail() pStatus = 2 Set reject = complete(data)End FunctionPublic Sub tearDown(Optional a As Variant) promise.tearDown Set pPromise = NothingEnd SubPrivate Sub class_initialize() Set pPromise = New cPromise promise.init Me pStatus = 0End Sub
cPromise class
The cPromise object is the child of the cDeferred class. A completed event in its parent cDeferred class will provoke an execute of either the queue of actions in the .done() queue or in the .fail() queue. The main interface members of the cPromise class are
- .done (callback As Object, method As String, Optional defer As cDeferred = Nothing, Optional args As Variant)
This adds execution of callback.method(data, defer, args) to the .done() queue, waiting for a .resolve() signal from its parent cDeferred. If .done() is called after the promise is resolved, it will execute calback.method(data,defer,args) immediately. Items are removed from the queue immediately on execution, so will only be executed once and strictly in sequence. Self reference is returned for chaining.
- .fail (callback As Object, method As String, Optional defer As cDeferred = Nothing, Optional args As Variant)
This adds execution of callback.method(errorData, defer, args) to the .fail() queue, waiting for a .reject() signal from its parent cDeferred. If .fail() is called after the promise is resolved, it will execute calback.method(data,defer,args) immediately. Items are removed from the queue immediately on execution, so will only be executed once and strictly in sequence.Self reference is returned for chaining. Option Explicit' we are going to be alerted by events going on in the parent objectPrivate WithEvents pDeferred As cDeferred' these are things to do when completedPrivate pSucceeds As CollectionPrivate pFails As CollectionPrivate pWhens As Collection' this is the data that arrives when resolved/rejectedPrivate pData As VariantPublic Function init(parent As cDeferred) As cPromise Set pDeferred = parent Set init = MeEnd Function' data arguments are unknown in quantity/typePublic Function setData(arr As Variant) As cPromise pData = arr Set setData = MeEnd FunctionPublic Property Get deferred() As cDeferred Set deferred = pDeferredEnd Property' retrieve the argumentsPublic Function getData() As Variant getData = pDataEnd Function' we are being asked to record an action to take on either success or failurePrivate Function queueUp(coll As Collection, _ callback As Object, method As String, _ Optional defer As cDeferred = Nothing, _ Optional args As Variant) As cPromise Dim cb As cCallback Set cb = New cCallback ' add to the list of things that need to be done when resolved coll.add cb.init(callback, method, defer, args) ' do them all in case already resolved execute Set queueUp = MeEnd Function' queueUp a failure actionPublic Function fail(callback As Object, method As String, _ Optional defer As cDeferred = Nothing, _ Optional args As Variant) As cPromise Set fail = queueUp(pFails, callback, method, defer, args)End Function' queueUp a success actionPublic Function done(callback As Object, method As String, _ Optional defer As cDeferred = Nothing, _ Optional args As Variant) As cPromise Set done = queueUp(pSucceeds, callback, method, defer, args)End Function' do anything in the queuePrivate Sub execute() ' do the successes If pDeferred.isResolved Then flush pSucceeds ' and the failures If pDeferred.isRejected Then flush pFails ' resolve any completed whens dealWithWhens End SubPrivate Sub flush(coll As Collection) Dim cb As cCallback, n As Long, i As Long ' destroy the callback after execution so it only happens once ' n = coll.Count For i = 1 To n Set cb = coll(1) CallByName cb.callback, cb.method, VbMethod, getData, cb.defer, cb.args coll.remove (1) cb.tearDown Next i End SubPublic Property Get whens() As Collection Set whens = pWhensEnd PropertyPrivate Sub class_initialize() Set pSucceeds = New Collection Set pFails = New Collection Set pWhens = New CollectionEnd SubPublic Sub tearDown(Optional a As Variant) Dim act As cCallback For Each act In pSucceeds act.tearDown Next act Set pSucceeds = Nothing For Each act In pFails act.tearDown Next act Set pFails = Nothing Set pDeferred = NothingEnd SubPrivate Sub pDeferred_completed(a As Variant) ' do anything queued ' this event is called when deferred is resolved/rejected execute 'End SubPrivate Sub dealWithWhens() ' may be part of some whens Dim w As cWhen For Each w In pWhens w.completed Next wEnd Sub
cWhen class
The cWhen class is not normally called directly, but rather through the when() function. The interface to when is
- when( array(promises,…) ,array(promises,..),…)
All promises is in all arrays need to be resolved or rejected for the promise that is returned by when to get either resolved or rejected. If any promise fails, the promise returned will be rejected. All promises need to be resolved successfully for the when.promise to be resolved. As a convenience, the data associated with the last promise in all arrays is passed to the .done() or .fail() method of when.promise
when returns a cPromise, which means that you can chain .done() or .fail() to a when() function.
Public Function when(ParamArray arr() As Variant) As cPromise' kind of like jquery $.when() Dim i As Long, n As Long, combinedPromises As Variant, j As Long n = 0' the paramarray is an array of arrays of promises. combining then into one list For i = LBound(arr) To UBound(arr) n = n - LBound(arr(i)) + UBound(arr(i)) + 1 Next i ReDim combinedPromises(0 To n - 1) n = LBound(combinedPromises) For i = LBound(arr) To UBound(arr) For j = LBound(arr(i)) To UBound(arr(i)) Set combinedPromises(n) = arr(i)(j) n = n + 1 Next j Next i ' now process a long list of whens Dim w As cWhen Set w = New cWhen Set when = w.when(combinedPromises)End Function cWhen Option ExplicitPrivate pDeferred As cDeferredPrivate pPromises As CollectionPublic Function when(arrayOfPromises As Variant) As cPromise ' we need to listen to each of the promises mention in array ' when all are done we can resolve Dim i As Long, p As cPromise, d As cDeferred Set pDeferred = New cDeferred For i = LBound(arrayOfPromises) To UBound(arrayOfPromises) ' each promise can belong to a collection of whens Set p = arrayOfPromises(i) p.whens.add Me pPromises.add p Next i Set when = pDeferred.promise()End FunctionPublic Sub completed() ' this will be called as a promise is executed. ' when all in the collection are done. we can resolve this Dim p As cPromise, f As Long, lp As cPromise f = 0 For Each p In pPromises ' they all have to be completed Set lp = p If (Not p.deferred.isCompleted) Then Exit Sub If (p.deferred.isRejected) Then f = f + 1 Next p ' all have been done, so resolve or reject it ' what gets passed is the data belongnig to the last promise If f = 0 Then pDeferred.resolve (lp.getData) Else pDeferred.reject (Array("when rejected with " & f & " failures")) End IfEnd SubPrivate Sub class_initialize() Set pDeferred = New cDeferred Set pPromises = New CollectionEnd SubPublic Function tearDown() Dim i As Long, p As cPromise, n As Long pDeferred.tearDown Set pDeferred = Nothing n = pPromises.Count For i = 1 To n Set p = pPromises(i) Set p = Nothing pPromises.remove (1) Next i Set pPromises = NothingEnd Function
cDeferredRegister class
In order to avoid dropping out of memory, out of scope variable are referenced in a public register. This class is normally accessed through these functions.
- keepInRegister(o As Object, Optional oName As String = vbNullString, Optional oType As String = vbNullString) As Object
This adds an object reference with the given name and type. The name and type are only used for later listing and debugging. Self reference is returned for chaining.
- clearRegister()
Removes all register items and attempts to execute a tearDown class if they have one. Should be called when all aync activity is ended, and as very first call in a fresh session.
- register.list
Can be useful for debugging. It will produce a list like this.
register.list
these items are being kept in memory
248811352 cProcessData
266750400 cEventTimer
266749920 cBackoff
264238376 cHttpDeferredHelper
358537424 cHttpDeferred
schema cJobject
266750592 cEventTimer
266750496 cBackoff
264239816 cHttpDeferredHelper
269075400 cHttpDeferred
One of the trickiest things is to get the arguments right for reject,resolve,done and fail. If you get that wrong, the error will show here in the cPromise() class
CallByName cb.callback, cb.method, VbMethod, getData, cb.defer, cb.args To identify which object is being called, inspect ObjPtr(cb.callback) which will be one of the addresses returned by register.list , and cb.Method which will be a string with the name of the method within the class. Option ExplicitPublic register As cDeferredRegisterPublic Function keepInRegister(o As Object, Optional oName As String = vbNullString, _ Optional oType As String = vbNullString) As Object Set keepInRegister = keepSafe(register, o, oName, oType)End Function Public Function keepSafe(reg As cDeferredRegister, _ o As Variant, Optional oName As String = vbNullString, _ Optional oType As String = vbNullString) As Object If register Is Nothing Then Set register = New cDeferredRegister Set keepSafe = reg.register(o, oName, oType)End FunctionPublic Function clearRegister() As cDeferredRegister If register Is Nothing Then Set register = New cDeferredRegister register.tearDownEnd Function
cDeferredRegister
Option Explicit' when doing asynchronous things, local variables can go out of scope and be garbage collected' the purpose of this class is to register an interest in local variables so they dont' and instance of this class should be declared at module level so it stays in scope when your proc exits' doing it this way avoids lots of global variablesPrivate pInterests As CollectionPublic Sub list(Optional data As Variant, _ Optional defer As cDeferred, Optional args As Variant) Dim x As cRegisterItem, i As Long Debug.Print "these items are being kept in memory" For i = 1 To pInterests.Count Set x = pInterests(i) Debug.Print x.oName, x.oType Next iEnd SubPublic Sub tearDown(Optional data As Variant, _ Optional defer As cDeferred, Optional args As Variant) Dim c As Variant, n As Long, i As Long, x As cRegisterItem n = pInterests.Count For i = 1 To n Set x = pInterests(1) Set c = x.ob tryToTearDown c Set c = Nothing pInterests.remove (1) Set x = Nothing Next iEnd SubPublic Function register(o As Variant, Optional oName As String = vbNullString, _ Optional oType As String = "unknown type") As Variant Dim x As cRegisterItem Set x = New cRegisterItem If oName = vbNullString Then If IsObject(o) Then oName = CStr(ObjPtr(o)) Else oName = CStr(ObjPtr(x)) End If End If x.init o, oName, oType pInterests.add x, oName Set register = xEnd FunctionPrivate Function tryToTearDown(c As Variant) As Boolean ' this will try to execute a teardown if it has one On Error GoTo failed c.tearDown tryToTearDown = True Exit Function failed: tryToTearDown = False End FunctionPrivate Sub class_initialize() Set pInterests = New CollectionEnd Sub Since this is in the early stages of development the code is in a separate workbook (promises.xlsm) and can be downloaded here