I am supporting CandidateX

CandidateX is a startup that focuses on creating inclusion-focused hiring solutions, designed to increase access to job opportunities for underestimated talent. Check them out if you have a few minutes to spare. They need visibility!

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