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.
Here's how the cDeferred versus cPromiseThese 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) asyncdata = defer.promise() end function sub getsomedata(defer) data = getthedata if (somerror) then defer.reject(someerror) else defer.resolve(data) endif end sub cDeferred classThe deferred object is the parent of the cPromise class. The main interface members of the cDeferred class are
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 cPromise Private pStatus As Long ' this will be raised when resolved/rejected to coerce promise execution Public Event completed(data As Variant) Public Property Get isResolved() As Boolean isResolved = (pStatus = 1) End Property Public Property Get isRejected() As Boolean isRejected = (pStatus = 2) End Property Public Property Get isCompleted() As Boolean isCompleted = isRejected Or isResolved End Property Public Property Get promise() As cPromise Set promise = pPromise End Property Private 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 Function Public Function resolve(data As Variant) As cDeferred ' all is good - will execite promise.done() pStatus = 1 Set resolve = complete(data) End Function Public Function reject(data As Variant) As cDeferred ' all is bad - will execute promise.fail() pStatus = 2 Set reject = complete(data) End Function Public Sub tearDown(Optional a As Variant) promise.tearDown Set pPromise = Nothing End Sub Private Sub class_initialize() Set pPromise = New cPromise promise.init Me pStatus = 0 End Sub cPromise classThe 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
Option Explicit ' we are going to be alerted by events going on in the parent object Private WithEvents pDeferred As cDeferred ' these are things to do when completed Private pSucceeds As Collection Private pFails As Collection Private pWhens As Collection ' this is the data that arrives when resolved/rejected Private pData As Variant Public Function init(parent As cDeferred) As cPromise Set pDeferred = parent Set init = Me End Function ' data arguments are unknown in quantity/type Public Function setData(arr As Variant) As cPromise pData = arr Set setData = Me End Function Public Property Get deferred() As cDeferred Set deferred = pDeferred End Property ' retrieve the arguments Public Function getData() As Variant getData = pData End Function ' we are being asked to record an action to take on either success or failure Private 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 = Me End Function ' queueUp a failure action Public 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 action Public 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 queue Private 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 Sub Private 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 Sub Public Property Get whens() As Collection Set whens = pWhens End Property Private Sub class_initialize() Set pSucceeds = New Collection Set pFails = New Collection Set pWhens = New Collection End Sub Public 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 = Nothing End Sub Private Sub pDeferred_completed(a As Variant) ' do anything queued ' this event is called when deferred is resolved/rejected execute ' End Sub Private Sub dealWithWhens() ' may be part of some whens Dim w As cWhen For Each w In pWhens w.completed Next w End Sub cWhen classThe cWhen class is not normally called directly, but rather through the when() function. The interface to when is
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 Explicit Private pDeferred As cDeferred Private pPromises As Collection Public 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 Function Public 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 If End Sub Private Sub class_initialize() Set pDeferred = New cDeferred Set pPromises = New Collection End Sub Public 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 = Nothing End Function cDeferredRegister classIn 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.
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.
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.
Can be useful for debugging. It will produce a list like this. register.listthese items are being kept in memory248811352 cProcessData266750400 cEventTimer266749920 cBackoff264238376 cHttpDeferredHelper358537424 cHttpDeferredschema cJobject266750592 cEventTimer266750496 cBackoff264239816 cHttpDeferredHelper269075400 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 Explicit Public register As cDeferredRegister Public 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 Function Public Function clearRegister() As cDeferredRegister If register Is Nothing Then Set register = New cDeferredRegister register.tearDown End 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 variables Private pInterests As Collection Public 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 i End Sub Public 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 i End Sub Public 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 = x End Function Private 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 Function Private Sub class_initialize() Set pInterests = New Collection End Sub Since this is in the early stages of development the code is in a separate workbook (promises.xlsm) and can be downloaded here For help and more information join our forum,follow the blog or follow me on twitter . |
Services > Desktop Liberation - the definitive resource for Google Apps Script and Microsoft Office automation > Classes > Promises in VBA >