Skip to content

Instantly share code, notes, and snippets.

@jcheng5
Last active January 8, 2019 16:55
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jcheng5/b1c87bb416f6153643cd0470ac756231 to your computer and use it in GitHub Desktop.
Save jcheng5/b1c87bb416f6153643cd0470ac756231 to your computer and use it in GitHub Desktop.
Promise API, Part 2: Promise Domains

Promise Domains

(This is a departure from Promises/A+ spec. It's needed to support the use of promises with Shiny, especially reactivity, but also seems like it'd be useful for logging, profiling, error handling...)

There are some places in R and in Shiny especially, where it's very useful to set up changes to the environment temporarily, execute some user-provided code, and then change the environment back to its original state.

For one example, consider the capture.output function. This won't work:

capture.output({
  download_data(url) %>%
    then(function(resp) {
      read.csv(text=rawToChar(resp$content))
    }) %>%
    then(function(df) {
      print(df)
    })
})

because the print statement won't happen until long after capture.output has returned. How can we intercept and modify the behavior inside of the user-provided expression—without requiring a lot of boilerplate from the user?

Introducing domains

Shiny uses a concept called "domains", which was inspired by a mechanism by the same name from Node.js. Sadly, their use of domains had a number of problems and they have long since soft-deprecated the feature, though no suitable replacement has yet surfaced, to my knowledge.

I use "domain" to refer to context or state that gets implicitly passed between functions that are related but do not have a simple parent-child relationship on the call stack. Once a function belongs to a domain, no matter where or when it is invoked it will have access to that domain. And usually, creating a new function from within a domain will implicitly add the new function to the domain.

In the previous paragraph I used the word "function" but actually I'm referring to something more general. For Shiny's reactive domains, the objects in question are reactive expressions and observers. These objects belong to the domain that was active at the time they were constructed. And when they execute their code bodies, they activate the domain they belong to, so any other reactives/observers that are constructed during their execution will inherit their domain.

Now we want to do the same thing with promises. Each time callbacks are attached to a promise, the currently active promise domains are given a chance to wrap (a.k.a. decorate, a.k.a. intercept) the callbacks. (Unlike Shiny reactive domains, which only allow a single domain to be active at any given moment, multiple promise domains can be active simultaneously.)

The promise domain must provide methods that wrap the onFulfilled/onRejected callback invocations. These methods are called wrapOnFulfilled and wrapOnRejected.

Here's what the promise domain constructor looks like, along with no-op versions of wrapOnFulfilled and wrapOnRejected (it's basically identity, but I've made it more verbose so it's more obvious how you would tweak these decorator arguments to do something actually useful):

new_promise_domain <- function(
  wrapOnFulfilled = function(onFulfilled) {
    function(value) {
      onFulfilled(value)
    }
  },
  wrapOnRejected = function(onRejected) {
    function(reason) {
      onRejected(reason)
    }
  },
  # ... is to add arbitrary state to your promise domain;
  # useful for returning side-effecty results to whomever
  # created the domain.
  ...
)

Example

With the help of a custom promise domain, we can write capture_output_async, which can capture the output of a chain like the above; the return value of capture_output_async is a promise of a string. (Remember, async operations are infectious; once we call one, we generally need to become one.)

capture_output_async <- function(expr, width = getOption("width")) {
  domain <- new_capture_output_promise_domain()
  withPromiseDomain(domain, expr) %>%
    then(function(value) { domain$result() }) %>%
    finally(function() { domain$close() })
}

new_capture_output_promise_domain <- function() {
  conn <- textConnection(NULL, "w")
 
  new_promise_domain(
    # Required args; called back by promise implementation
    # at the time that `then()` is called (NOT at the time
    # that a promise is fulfilled/rejected).
    wrapOnFulfilled = function(onFulfilled) {
      function(value) {
        capture.output(onFulfilled(value), file = conn, append = TRUE)
      }
    },
    wrapOnRejected = function(onRejected) {
      function(reason) {
        capture.output(onRejected(value), file = conn, append = TRUE)
      }
    },
    # Specific to renderPrintAsync
    result = function() {
      textConnectionValue(conn)
    },
    close = function() {
      close(conn)
    }
  )
}

Here's another example of a promise domain, this one is for making sure that an entire promise chain writes to the same graphics device.

createGraphicsDevicePromiseDomain <- function(which = dev.cur()) {
  new_promise_domain(
    wrapOnFulfilled = function(onFulfilled) {
      function(value) {
        old <- dev.cur()
        dev.set(which)
        on.exit(dev.set(old))

        onFulfilled(value)
      }
    },
    wrapOnRejected = function(onRejected) {
      function(reason) {
        old <- dev.cur()
        dev.set(which)
        on.exit(dev.set(old))

        onRejected(reason)
      }
    }
  )
}

# Usage
png("image.png")
plot.new()
dv <- dev.cur()
with_promise_domain(createGraphicsDevicePromiseDomain(dv), {
  download_data() %>%
    then(function(df) {
      ggplot(df, aes(speed, dist)) + geom_point()
    })
}) %>% finally(function() { dev.off(dv) })
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment