├── .Rbuildignore ├── .github ├── .gitignore ├── CODE_OF_CONDUCT.md └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── domains.R ├── first_type.R ├── function_type.R ├── future_promise.R ├── is_something.R ├── methods.R ├── pipe.R ├── promise.R ├── promises-package.R ├── staticimports.R ├── then.R └── utils.R ├── README.md ├── _pkgdown.yml ├── cran-comments.md ├── index.md ├── inst └── WORDLIST ├── man ├── WorkQueue.Rd ├── figures │ ├── lifecycle-archived.svg │ ├── lifecycle-defunct.svg │ ├── lifecycle-deprecated.svg │ ├── lifecycle-experimental.svg │ ├── lifecycle-maturing.svg │ ├── lifecycle-questioning.svg │ ├── lifecycle-stable.svg │ └── lifecycle-superseded.svg ├── future_promise.Rd ├── is.promise.Rd ├── pipes.Rd ├── promise.Rd ├── promise_all.Rd ├── promise_map.Rd ├── promise_reduce.Rd ├── promise_resolve.Rd ├── promises-package.Rd ├── reexports.Rd ├── resolve.Rd ├── then.Rd └── with_promise_domain.Rd ├── promises.Rproj ├── revdep ├── .gitignore ├── README.md ├── cran.md ├── failures.md └── problems.md ├── src ├── RcppExports.cpp └── promise_task.cpp ├── tests ├── spelling.R ├── testthat.R └── testthat │ ├── common.R │ ├── test-aplus-2-1.R │ ├── test-aplus-2-2.R │ ├── test-aplus-2-3.R │ ├── test-combining.R │ ├── test-cpp.R │ ├── test-domains.R │ ├── test-methods.R │ ├── test-visibility.R │ └── test-zzz-future_promise.R └── vignettes ├── case-study-downloaders.png ├── case-study-gantt-aligned.png ├── case-study-gantt-async.png ├── case-study-gantt-async2.png ├── case-study-gantt1.png ├── case-study-gantt2.png ├── case-study-gantt3.png ├── case-study-react.png ├── case-study-tab1.png ├── case-study-tab2.png ├── case-study-tab3.png ├── case-study-tab4.png ├── case-study-tab5.png ├── future_promise ├── blocked_future_promise.png ├── future.png ├── future_promise_vignette.key └── plots.R ├── promises_01_motivation.Rmd ├── promises_02_intro.Rmd ├── promises_03_overview.Rmd ├── promises_04_futures.Rmd ├── promises_05_future_promise.Rmd ├── promises_06_shiny.Rmd ├── promises_07_combining.Rmd └── promises_08_casestudy.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^_pkgdown\.yml$ 4 | ^docs$ 5 | ^index.md$ 6 | ^\.github$ 7 | ^cran-comments\.md$ 8 | ^revdep$ 9 | ^doc$ 10 | ^Meta$ 11 | 12 | ^vignettes/future_promise/.*\.key$ 13 | ^vignettes/future_promise/.*\.R$ 14 | ^CRAN-RELEASE$ 15 | ^LICENSE\.md$ 16 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at codeofconduct@posit.co. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/rstudio/shiny-workflows 2 | # 3 | # NOTE: This Shiny team GHA workflow is overkill for most R packages. 4 | # For most R packages it is better to use https://github.com/r-lib/actions 5 | on: 6 | push: 7 | branches: [main, rc-**] 8 | pull_request: 9 | schedule: 10 | - cron: "0 8 * * 1" # every monday 11 | 12 | name: Package checks 13 | 14 | jobs: 15 | website: 16 | uses: rstudio/shiny-workflows/.github/workflows/website.yaml@v1 17 | with: 18 | check-title: false 19 | routine: 20 | uses: rstudio/shiny-workflows/.github/workflows/routine.yaml@v1 21 | with: 22 | format-r-code: true 23 | R-CMD-check: 24 | uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1 25 | R-CMD-check-with-dont-test: 26 | uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1 27 | with: 28 | extra-check-args: '"--run-donttest"' 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.so 6 | *.o 7 | inst/doc 8 | doc 9 | Meta 10 | docs 11 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: promises 3 | Title: Abstractions for Promise-Based Asynchronous Programming 4 | Version: 1.3.2.9000 5 | Authors@R: c( 6 | person("Joe", "Cheng", , "joe@posit.co", role = c("aut", "cre")), 7 | person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "03wc8by49")) 8 | ) 9 | Description: Provides fundamental abstractions for doing asynchronous 10 | programming in R using promises. Asynchronous programming is useful 11 | for allowing a single R process to orchestrate multiple tasks in the 12 | background while also attending to something else. Semantics are 13 | similar to 'JavaScript' promises, but with a syntax that is idiomatic 14 | R. 15 | License: MIT + file LICENSE 16 | URL: https://rstudio.github.io/promises/, 17 | https://github.com/rstudio/promises 18 | BugReports: https://github.com/rstudio/promises/issues 19 | Imports: 20 | fastmap (>= 1.1.0), 21 | later, 22 | magrittr (>= 1.5), 23 | R6, 24 | Rcpp, 25 | rlang, 26 | stats 27 | Suggests: 28 | future (>= 1.21.0), 29 | knitr, 30 | purrr, 31 | rmarkdown, 32 | spelling, 33 | testthat (>= 3.0.0), 34 | vembedr 35 | LinkingTo: 36 | later, 37 | Rcpp 38 | VignetteBuilder: 39 | knitr 40 | Config/Needs/website: rsconnect, tidyverse/tidytemplate 41 | Config/testthat/edition: 3 42 | Config/usethis/last-upkeep: 2025-05-27 43 | Encoding: UTF-8 44 | Language: en-US 45 | Roxygen: list(markdown = TRUE) 46 | RoxygenNote: 7.3.2 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2025 2 | COPYRIGHT HOLDER: promises authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2025 promises authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.promise,Future) 4 | S3method(as.promise,default) 5 | S3method(as.promise,promise) 6 | S3method(format,promise) 7 | S3method(is.promising,Future) 8 | S3method(is.promising,default) 9 | S3method(is.promising,promise) 10 | S3method(print,promise) 11 | export("%...!%") 12 | export("%...>%") 13 | export("%...T!%") 14 | export("%...T>%") 15 | export("%>%") 16 | export("%T>%") 17 | export(as.promise) 18 | export(catch) 19 | export(finally) 20 | export(future_promise) 21 | export(future_promise_queue) 22 | export(is.promise) 23 | export(is.promising) 24 | export(new_promise_domain) 25 | export(promise) 26 | export(promise_all) 27 | export(promise_map) 28 | export(promise_race) 29 | export(promise_reduce) 30 | export(promise_reject) 31 | export(promise_resolve) 32 | export(then) 33 | export(with_promise_domain) 34 | import(R6) 35 | import(later) 36 | importFrom(Rcpp,evalCpp) 37 | importFrom(magrittr,"%>%") 38 | importFrom(magrittr,"%T>%") 39 | useDynLib(promises) 40 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # promises (development version) 2 | 3 | * Changed the way we create future objects to stay compatible with new versions of `{future}`. Apparently the way we were doing it was never idiomatic and only worked by accident. (#121) 4 | 5 | * Fixed #122: Use `future::future(..., lazy = TRUE)` to avoid manual capturing of state within `future_promise` (Thank you, @HenrikBengtsson! #123) 6 | 7 | # promises 1.3.2 8 | 9 | * Fixed bug introduced in 1.3.1, where promise domains that are active at promise resolution time stay active during handler callback, even if they weren't active when the handler was registered. This was causing stack overflow for long promise chains with many active promise domains. (#115) 10 | 11 | 12 | # promises 1.3.1 13 | 14 | * Fixed bug where promise domains were forgotten when handlers were registered from within other handlers. (#110) 15 | 16 | 17 | # promises 1.3.0 18 | 19 | * `is.promising` is now an S3 method. (#104) 20 | 21 | 22 | # promises 1.2.1 23 | 24 | * `future_promise()` received a speed improvement when submitting many requests with a minimal number of `{future}` workers. If `future_promise()` runs out of available `{future}` workers, then `future_promise()` will preemptively return for the remainder of the current `{later}` execution. While it is possible for `{future}` to finish a job before submitting all of the `future_promise()` requests, the time saved by not asking `{future}`'s worker availability will be faster overall than if a few jobs were submitted early. (#78) 25 | 26 | * Fixed #86: `future_promise()` spuriously reports unhandled errors. (#90) 27 | 28 | * Move `{fastmap}` from `Suggests` to `Imports` for better `{renv}` discovery. (#87) 29 | 30 | 31 | # promises 1.2.0.1 32 | 33 | * Added `future_promise()` which returns a `promise` that executes the expression using `future::future()`. `future_promise()` should (typically) be a drop-in replacement for any `future::future()` function call. `future_promise()` will not execute `future` work faster than `future::future()`, but `future_promise()` will only submit `future` jobs if a worker is available. If no workers are available, `future_promise()` will hold the expression information in a `promise` until a worker does become available to better take advantage of computing resources available to the main R session. For more information, please see the [`future_promise()` article](https://rstudio.github.io/promises/articles/future_promise.html). (#62) 34 | 35 | * Added visibility support for `Promise$then(onFulfilled)`. (#59) 36 | 37 | # promises 1.1.1 38 | 39 | * Fix handling of FutureErrors during `future::resolved()` and `future::value()` by discarding the corrupt future. (#37) 40 | 41 | 42 | # promises 1.1.0 43 | 44 | * Fixed #49: `promise_all()` previously did not handle `NULL` values correctly. (#50)) 45 | 46 | * `new_promise_domain` now takes a `wrapOnFinally` argument, which can be used to intercept registration of `finally()`. Previous versions treated `finally` as passing the same callback to `then(onFulfilled=..., onRejected=...)`, and ignoring the result; for backward compatibility, promise domains will still treat `finally` that way by default (i.e. if `wrapOnFinally` is `NULL`, then `finally` will result in `wrapOnFulfilled` and `wrapOnRejected` being called, but if `wrapOnFinally` is provided then only `wrapOnFinally` will be called). (#43) 47 | 48 | 49 | # promises 1.0.1 50 | 51 | * Initial CRAN release 52 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | asyncFib <- function(resolve, reject, x) { 5 | invisible(.Call('_promises_asyncFib', PACKAGE = 'promises', resolve, reject, x)) 6 | } 7 | 8 | -------------------------------------------------------------------------------- /R/domains.R: -------------------------------------------------------------------------------- 1 | tryCatch <- function(expr, ..., finally) { 2 | base::tryCatch( 3 | withCallingHandlers( 4 | expr, 5 | error = function(e) { 6 | promiseDomain$onError(e) 7 | } 8 | ), 9 | ..., 10 | finally = finally 11 | ) 12 | } 13 | 14 | spliceOnFinally <- function(onFinally) { 15 | list( 16 | onFulfilled = finallyToFulfilled(onFinally), 17 | onRejected = finallyToRejected(onFinally) 18 | ) 19 | } 20 | 21 | finallyToFulfilled <- function(onFinally) { 22 | force(onFinally) 23 | function(value, .visible) { 24 | onFinally() 25 | if (.visible) value else invisible(value) 26 | } 27 | } 28 | 29 | finallyToRejected <- function(onFinally) { 30 | force(onFinally) 31 | function(reason) { 32 | onFinally() 33 | stop(reason) 34 | } 35 | } 36 | 37 | promiseDomain <- list( 38 | onThen = function(onFulfilled, onRejected, onFinally) { 39 | force(onFulfilled) 40 | force(onRejected) 41 | force(onFinally) 42 | 43 | # Verify that if onFinally is non-NULL, onFulfilled and onRejected are NULL 44 | if ( 45 | !is.null(onFinally) && (!is.null(onFulfilled) || !is.null(onRejected)) 46 | ) { 47 | stop( 48 | "A single `then` call cannot combine `onFinally` with `onFulfilled`/`onRejected`" 49 | ) 50 | } 51 | 52 | domain <- current_promise_domain() 53 | 54 | shouldWrapFinally <- !is.null(onFinally) && 55 | !is.null(domain) && 56 | !is.null(domain$wrapOnFinally) 57 | 58 | newOnFinally <- if (shouldWrapFinally) { 59 | domain$wrapOnFinally(onFinally) 60 | } else { 61 | onFinally 62 | } 63 | 64 | if (!is.null(newOnFinally)) { 65 | spliced <- spliceOnFinally(newOnFinally) 66 | onFulfilled <- spliced$onFulfilled 67 | onRejected <- spliced$onRejected 68 | } 69 | 70 | shouldWrapFulfilled <- !is.null(onFulfilled) && 71 | !is.null(domain) && 72 | !shouldWrapFinally 73 | shouldWrapRejected <- !is.null(onRejected) && 74 | !is.null(domain) && 75 | !shouldWrapFinally 76 | 77 | results <- list( 78 | onFulfilled = if (shouldWrapFulfilled) 79 | domain$wrapOnFulfilled(onFulfilled) else onFulfilled, 80 | onRejected = if (shouldWrapRejected) 81 | domain$wrapOnRejected(onRejected) else onRejected 82 | ) 83 | results <- results[!vapply(results, is.null, logical(1))] 84 | # If there's a domain, ensure that before any callback is invoked, we 85 | # reenter the domain. This is important for this kind of code: 86 | # 87 | # with_promise_domain(domain, { 88 | # async_sleep(0.1) %...>% { 89 | # async_sleep(0.1) %...>% { 90 | # # Without re-entry, this would be outside the domain! 91 | # } 92 | # } 93 | # }) 94 | # 95 | # It's important to reenter even if domain is NULL. In that case, we need to 96 | # ensure that the current domain is set to NULL while the callback executes. 97 | results <- lapply(results, wrap_callback_reenter, domain = domain) 98 | results 99 | }, 100 | onError = function(error) { 101 | domain <- current_promise_domain() 102 | if (is.null(domain)) return() 103 | domain$onError(error) 104 | } 105 | ) 106 | 107 | wrap_callback_reenter <- function(callback, domain) { 108 | force(callback) 109 | force(domain) 110 | 111 | wrapper <- function(...) { 112 | # replace = TRUE because we don't care what the current domain is; we're 113 | # (temporarily) putting the world back to the way it was when the callback 114 | # was bound to a promise. 115 | reenter_promise_domain(domain, callback(...), replace = TRUE) 116 | } 117 | 118 | # There are parts of this package that will inspect formals() to see if 119 | # there's a `.visible` parameter in the callback. So it's important to have 120 | # the returned wrapper have the same formals as the original callback. 121 | wrap_with_signature(wrapper, formals(callback)) 122 | } 123 | 124 | wrap_with_signature <- function(func, formal_args) { 125 | # func must have a `...` signature 126 | stopifnot("..." %in% names(formals(func))) 127 | 128 | args <- names(formal_args) 129 | recall <- rlang::call2( 130 | func, 131 | !!!rlang::set_names(lapply(args, as.symbol), args) 132 | ) 133 | 134 | rlang::new_function(formal_args, recall) 135 | } 136 | 137 | globals <- new.env(parent = emptyenv()) 138 | 139 | current_promise_domain <- function() { 140 | globals$domain 141 | } 142 | 143 | #' Promise domains 144 | #' 145 | #' Promise domains are used to temporarily set up custom environments that 146 | #' intercept and influence the registration of callbacks. Create new promise 147 | #' domain objects using `new_promise_domain`, and temporarily activate a promise 148 | #' domain object (for the duration of evaluating a given expression) using 149 | #' `with_promise_domain`. 150 | #' 151 | #' While `with_promise_domain` is on the call stack, any calls to [then()] (or 152 | #' higher level functions or operators, like [catch()] or the various [pipes]) 153 | #' will belong to the promise domain. In addition, when a `then` callback that 154 | #' belongs to a promise domain is invoked, then any new calls to `then` will 155 | #' also belong to that promise domain. In other words, a promise domain 156 | #' "infects" not only the immediate calls to `then`, but also to "nested" calls 157 | #' to `then`. 158 | #' 159 | #' For more background, read the 160 | #' [original design doc](https://gist.github.com/jcheng5/b1c87bb416f6153643cd0470ac756231). 161 | #' 162 | #' For examples, see the source code of the Shiny package, which uses promise 163 | #' domains extensively to manage graphics devices and reactivity. 164 | #' 165 | #' @param domain A promise domain object to install while `expr` is evaluated. 166 | #' @param expr Any R expression, to be evaluated under the influence of 167 | #' `domain`. 168 | #' @param replace If `FALSE`, then the effect of the `domain` will be added 169 | #' to the effect of any currently active promise domain(s). If `TRUE`, then 170 | #' the current promise domain(s) will be ignored for the duration of the 171 | #' `with_promise_domain` call. 172 | #' 173 | #' @export 174 | with_promise_domain <- function(domain, expr, replace = FALSE) { 175 | oldval <- current_promise_domain() 176 | if (replace) globals$domain <- domain else 177 | globals$domain <- compose_domains(oldval, domain) 178 | on.exit(globals$domain <- oldval) 179 | 180 | if (!is.null(domain)) domain$wrapSync(expr) else force(expr) 181 | } 182 | 183 | # Like with_promise_domain, but doesn't include the wrapSync call. 184 | reenter_promise_domain <- function(domain, expr, replace) { 185 | oldval <- current_promise_domain() 186 | if (replace) globals$domain <- domain else 187 | globals$domain <- compose_domains(oldval, domain) 188 | on.exit(globals$domain <- oldval) 189 | 190 | force(expr) 191 | } 192 | 193 | #' @param wrapOnFulfilled A function that takes a single argument: a function 194 | #' that was passed as an `onFulfilled` argument to [then()]. The 195 | #' `wrapOnFulfilled` function should return a function that is suitable for 196 | #' `onFulfilled` duty. 197 | #' @param wrapOnRejected A function that takes a single argument: a function 198 | #' that was passed as an `onRejected` argument to [then()]. The 199 | #' `wrapOnRejected` function should return a function that is suitable for 200 | #' `onRejected` duty. 201 | #' @param wrapSync A function that takes a single argument: a (lazily evaluated) 202 | #' expression that the function should [force()]. This expression represents 203 | #' the `expr` argument passed to [with_promise_domain()]; `wrapSync` allows 204 | #' the domain to manipulate the environment before/after `expr` is evaluated. 205 | #' @param onError A function that takes a single argument: an error. `onError` 206 | #' will be called whenever an exception occurs in a domain (that isn't caught 207 | #' by a `tryCatch`). Providing an `onError` callback doesn't cause errors to 208 | #' be caught, necessarily; instead, `onError` callbacks behave like calling 209 | #' handlers. 210 | #' @param ... Arbitrary named values that will become elements of the promise 211 | #' domain object, and can be accessed as items in an environment (i.e. using 212 | #' `[[` or `$`). 213 | #' @param wrapOnFinally A function that takes a single argument: a function 214 | #' that was passed as an `onFinally` argument to [then()]. The 215 | #' `wrapOnFinally` function should return a function that is suitable for 216 | #' `onFinally` duty. If `wrapOnFinally` is `NULL` (the default), then the 217 | #' domain will use both `wrapOnFulfilled` and `wrapOnRejected` to wrap the 218 | #' `onFinally`. If it's important to distinguish between normal 219 | #' fulfillment/rejection handlers and finally handlers, then be sure to 220 | #' provide `wrapOnFinally`, even if it's just [base::identity()]. 221 | #' @rdname with_promise_domain 222 | #' @export 223 | new_promise_domain <- function( 224 | wrapOnFulfilled = identity, 225 | wrapOnRejected = identity, 226 | wrapSync = force, 227 | onError = force, 228 | ..., 229 | wrapOnFinally = NULL 230 | ) { 231 | list2env( 232 | list( 233 | wrapOnFulfilled = wrapOnFulfilled, 234 | wrapOnRejected = wrapOnRejected, 235 | wrapOnFinally = wrapOnFinally, 236 | wrapSync = wrapSync, 237 | onError = onError, 238 | ... 239 | ), 240 | parent = emptyenv() 241 | ) 242 | } 243 | 244 | 245 | compose_domains <- function(base, new) { 246 | if (is.null(base)) { 247 | return(new) 248 | } 249 | 250 | list( 251 | wrapOnFulfilled = function(onFulfilled) { 252 | # Force eager evaluation of base$wrapOnFulfilled(onFulfilled) 253 | base <- base$wrapOnFulfilled(onFulfilled) 254 | new$wrapOnFulfilled(base) 255 | }, 256 | wrapOnRejected = function(onRejected) { 257 | # Force eager evaluation of base$wrapOnRejected(onRejected) 258 | base <- base$wrapOnRejected(onRejected) 259 | new$wrapOnRejected(base) 260 | }, 261 | # Only include the new wrapSync, assuming that we've already applied the 262 | # base domain's wrapSync. This assumption won't hold if we either export 263 | # compose_domains in the future, or if we use it in cases where the base 264 | # domain isn't currently active. 265 | wrapSync = new$wrapSync, 266 | onError = function(e) { 267 | base$onError(e) 268 | new$onError(e) 269 | } 270 | ) 271 | } 272 | 273 | without_promise_domain <- function(expr) { 274 | with_promise_domain(NULL, expr, replace = TRUE) 275 | } 276 | -------------------------------------------------------------------------------- /R/first_type.R: -------------------------------------------------------------------------------- 1 | # Determine whether an expression is of the type that needs a first argument. 2 | # 3 | # @param a non-evaluated expression. 4 | # @return logical - TRUE if expr is of "first-argument" type, FALSE otherwise. 5 | is_first <- function(expr) { 6 | !any(vapply(expr[-1L], identical, logical(1L), quote(.))) 7 | } 8 | 9 | # Prepare a magrittr rhs of "first-argument" type. 10 | # 11 | # @param a an expression which passes `is_first` 12 | # @return an expression prepared for functional sequence construction. 13 | prepare_first <- function(expr) { 14 | as.call(c(expr[[1L]], quote(.), as.list(expr[-1L]))) 15 | } 16 | -------------------------------------------------------------------------------- /R/function_type.R: -------------------------------------------------------------------------------- 1 | # Determine whether an expression counts as a function in a magrittr chain. 2 | # 3 | # @param a non-evaluated expression. 4 | # @return logical - TRUE if expr represents a function, FALSE otherwise. 5 | is_function <- function(expr) { 6 | is.symbol(expr) || is.function(expr) 7 | } 8 | 9 | # Prepare a magrittr rhs of funtion type 10 | # 11 | # @param a an expression which passes `is_function` 12 | # @return an expression prepared for functional sequence construction. 13 | prepare_function <- function(f) { 14 | as.call(list(f, quote(.))) 15 | } 16 | 17 | is_lambda <- function(expr) { 18 | is.call(expr) && identical(expr[[1L]], quote(`function`)) 19 | } 20 | -------------------------------------------------------------------------------- /R/is_something.R: -------------------------------------------------------------------------------- 1 | # Check whether a symbol is a valid magrittr pipe. 2 | # 3 | # @param pipe A quoted symbol 4 | # @return logical - TRUE if a valid magrittr pipe, FALSE otherwise. 5 | is_pipe <- function(pipe) { 6 | identical(pipe, quote(`%>%`)) || 7 | identical(pipe, quote(`%T>%`)) || 8 | identical(pipe, quote(`%<>%`)) || 9 | identical(pipe, quote(`%$%`)) 10 | } 11 | 12 | # Determine whether an non-evaluated call is parenthesized 13 | # 14 | # @param a non-evaluated expression 15 | # @retun logical - TRUE if expression is parenthesized, FALSE otherwise. 16 | is_parenthesized <- function(expr) { 17 | is.call(expr) && identical(expr[[1L]], quote(`(`)) 18 | } 19 | 20 | # Check whether a pipe is a tee. 21 | # 22 | # @param pipe A (quoted) pipe 23 | # @return logical - TRUE if pipe is a tee, FALSE otherwise. 24 | is_tee <- function(pipe) { 25 | identical(pipe, quote(`%T>%`)) 26 | } 27 | 28 | # Check whether a pipe is the dollar pipe. 29 | # 30 | # @param pipe A (quoted) pipe 31 | # @return logical - TRUE if pipe is the dollar pipe, FALSE otherwise. 32 | is_dollar <- function(pipe) { 33 | identical(pipe, quote(`%$%`)) 34 | } 35 | 36 | # Check whether a pipe is the compound assignment pipe operator 37 | # 38 | # @param pipe A (quoted) pipe 39 | # @return logical - TRUE if pipe is the compound assignment pipe, 40 | # otherwise FALSE. 41 | is_compound_pipe <- function(pipe) { 42 | identical(pipe, quote(`%<>%`)) 43 | } 44 | 45 | # Check whether expression is enclosed in curly braces. 46 | # 47 | # @param expr An expression to be tested. 48 | # @return logical - TRUE if expr is enclosed in `{`, FALSE otherwise. 49 | is_funexpr <- function(expr) { 50 | is.call(expr) && identical(expr[[1L]], quote(`{`)) 51 | } 52 | 53 | # Check whether expression has double or triple colons 54 | # 55 | # @param expr An expression to be tested. 56 | # @return logical - TRUE if expr contains `::` or `:::`, FALSE otherwise. 57 | is_colexpr <- function(expr) { 58 | is.call(expr) && 59 | (identical(expr[[1L]], quote(`::`)) || identical(expr[[1L]], quote(`:::`))) 60 | } 61 | 62 | # Check whether a symbol is the magrittr placeholder. 63 | # 64 | # @param symbol A (quoted) symbol 65 | # @return logical - TRUE if symbol is the magrittr placeholder, FALSE otherwise. 66 | is_placeholder <- function(symbol) { 67 | identical(symbol, quote(.)) 68 | } 69 | -------------------------------------------------------------------------------- /R/methods.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | format.promise <- function(x, ...) { 3 | p <- attr(x, "promise_impl", exact = TRUE) 4 | p$format() 5 | } 6 | 7 | #' @export 8 | print.promise <- function(x, ...) { 9 | cat(paste(format(x), collapse = "\n"), "\n", sep = "") 10 | } 11 | -------------------------------------------------------------------------------- /R/pipe.R: -------------------------------------------------------------------------------- 1 | #' @importFrom magrittr %>% 2 | #' @export 3 | magrittr::"%>%" 4 | 5 | #' @importFrom magrittr %T>% 6 | #' @export 7 | magrittr::"%T>%" 8 | 9 | #' Promise pipe operators 10 | #' 11 | #' Promise-aware pipe operators, in the style of [magrittr](https://CRAN.R-project.org/package=magrittr/vignettes/magrittr.html). 12 | #' Like magrittr pipes, these operators can be used to chain together pipelines 13 | #' of promise-transforming operations. Unlike magrittr pipes, these pipes wait 14 | #' for promise resolution and pass the unwrapped value (or error) to the `rhs` 15 | #' function call. 16 | #' 17 | #' The `>` variants are for handling successful resolution, the `!` variants are 18 | #' for handling errors. The `T` variants of each return the lhs instead of the 19 | #' rhs, which is useful for pipeline steps that are used for side effects 20 | #' (printing, plotting, saving). 21 | #' 22 | #' 1. \code{promise \%...>\% func()} is equivalent to \code{promise \%>\% then(func)}. 23 | #' 2. \code{promise \%...!\% func()} is equivalent to \code{promise \%>\% catch(func)}. 24 | #' 3. \code{promise \%...T>\% func()} is equivalent to \code{promise \%T>\% then(func)}. 25 | #' 4. \code{promise \%...T!\% func()} is equivalent to \code{promise \%T>\% 26 | #' catch(func)} or \code{promise \%>\% catch(func, tee = TRUE)}. 27 | #' 28 | #' One situation where 3. and 4. above break down is when `func()` throws an 29 | #' error, or returns a promise that ultimately fails. In that case, the failure 30 | #' will be propagated by our pipe operators but not by the 31 | #' magrittr-plus-function "equivalents". 32 | #' 33 | #' For simplicity of implementation, we do not support the magrittr feature of 34 | #' using a `.` at the head of a pipeline to turn the entire pipeline into a 35 | #' function instead of an expression. 36 | #' 37 | #' @param lhs A promise object. 38 | #' @param rhs A function call using the magrittr semantics. It can return either 39 | #' a promise or non-promise value, or throw an error. 40 | #' 41 | #' @examples 42 | #' \dontrun{ 43 | #' library(future) 44 | #' plan(multisession) 45 | #' 46 | #' future_promise(cars) %...>% 47 | #' head(5) %...T>% 48 | #' print() 49 | #' 50 | #' # If the read.csv fails, resolve to NULL instead 51 | #' future_promise(read.csv("http://example.com/data.csv")) %...!% 52 | #' { NULL } 53 | #' } 54 | #' 55 | #' @return A new promise. 56 | #' 57 | #' @seealso https://rstudio.github.io/promises/articles/overview.html#using-pipes 58 | #' 59 | #' @name pipes 60 | #' @export 61 | `%...>%` <- function(lhs, rhs) { 62 | # the parent environment 63 | parent <- parent.frame() 64 | 65 | # the environment in which to evaluate pipeline 66 | env <- new.env(parent = parent) 67 | 68 | parts <- match.call() 69 | func <- pipeify_rhs(parts[[3L]], env) 70 | then(lhs, func) 71 | } 72 | 73 | #' @rdname pipes 74 | #' @export 75 | `%...T>%` <- function(lhs, rhs) { 76 | # the parent environment 77 | parent <- parent.frame() 78 | 79 | # the environment in which to evaluate pipeline 80 | env <- new.env(parent = parent) 81 | 82 | parts <- match.call() 83 | func <- pipeify_rhs(parts[[3L]], env) 84 | lhs %>% 85 | then(func) %>% 86 | then(function(value) lhs) 87 | } 88 | 89 | #' @rdname pipes 90 | #' @export 91 | `%...!%` <- function(lhs, rhs) { 92 | # the parent environment 93 | parent <- parent.frame() 94 | 95 | # the environment in which to evaluate pipeline 96 | env <- new.env(parent = parent) 97 | 98 | parts <- match.call() 99 | func <- pipeify_rhs(parts[[3L]], env) 100 | catch(lhs, func) 101 | } 102 | 103 | #' @rdname pipes 104 | #' @export 105 | `%...T!%` <- function(lhs, rhs) { 106 | # the parent environment 107 | parent <- parent.frame() 108 | 109 | # the environment in which to evaluate pipeline 110 | env <- new.env(parent = parent) 111 | 112 | parts <- match.call() 113 | func <- pipeify_rhs(parts[[3L]], env) 114 | catch(lhs, func, tee = TRUE) 115 | } 116 | 117 | has.visible <- function(func) { 118 | ".visible" %in% names(formals(func)) 119 | } 120 | 121 | pipeify_rhs <- function(rhs, env) { 122 | if (is_parenthesized(rhs)) { 123 | rhs <- eval(rhs, env, env) 124 | } 125 | 126 | rhs <- if (is_funexpr(rhs)) { 127 | rhs 128 | } else if (is_lambda(rhs)) { 129 | # We can remove this conditional if we want this behavior to be supported. 130 | # The next conditional checks for is_lambda too, and does the right thing. 131 | # Keeping the error for now in deference to magrittr pipe behavior. 132 | stop("Anonymous functions must be parenthesized") 133 | } else if (is_function(rhs) || is_colexpr(rhs) || is_lambda(rhs)) { 134 | # This block diverges from magrittr because we have an optional .visible 135 | # argument that can be passed to the function. If the function takes a 136 | # parameter called .visible then we will pass it, otherwise no. 137 | 138 | real_rhs <- if (is.function(rhs)) { 139 | rhs 140 | } else { 141 | eval(rhs, env, env) 142 | } 143 | 144 | if (has.visible(real_rhs)) { 145 | as.call(list(rhs, quote(.), .visible = quote(.visible))) 146 | } else { 147 | as.call(list(rhs, quote(.))) 148 | } 149 | } else if (is_first(rhs)) { 150 | prepare_first(rhs) 151 | } else { 152 | rhs 153 | } 154 | 155 | eval(call("function", as.pairlist(alist(. = , .visible = )), rhs), env, env) 156 | } 157 | -------------------------------------------------------------------------------- /R/promise.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib promises 2 | #' @importFrom Rcpp evalCpp 3 | #' @import later 4 | NULL 5 | 6 | #' @import R6 7 | Promise <- R6::R6Class( 8 | "Promise", 9 | private = list( 10 | state = "pending", 11 | value = NULL, 12 | visible = TRUE, 13 | publicResolveRejectCalled = FALSE, 14 | onFulfilled = list(), 15 | onRejected = list(), 16 | onFinally = list(), 17 | rejectionHandled = FALSE, 18 | 19 | # Private resolve/reject differs from public resolve/reject 20 | # in that the private versions are allowed to be called 21 | # more than once, whereas public ones no-op after the first 22 | # time they are invoked. 23 | doResolve = function(value) { 24 | val <- withVisible(value) 25 | value <- val$value 26 | visible <- val$visible 27 | 28 | if (is.promising(value)) { 29 | value <- as.promise(value) 30 | if (identical(self, attr(value, "promise_impl", exact = TRUE))) { 31 | return(private$doReject(simpleError( 32 | "Chaining cycle detected for promise" 33 | ))) 34 | } 35 | # This then() call doesn't need promise domains; semantically, it doesn't 36 | # really exist, as it's just a convenient way to implement the new promise 37 | # inhabiting the old promise's corpse. 38 | without_promise_domain({ 39 | value$then( 40 | private$doResolve, 41 | private$doReject 42 | ) 43 | }) 44 | } else { 45 | private$doResolveFinalValue(value, visible) 46 | } 47 | }, 48 | doReject = function(reason) { 49 | if (is.promising(reason)) { 50 | reason <- as.promise(reason) 51 | # This then() call doesn't need promise domains; semantically, it doesn't 52 | # really exist, as it's just a convenient way to implement the new promise 53 | # inhabiting the old promise's corpse. 54 | without_promise_domain({ 55 | reason$then( 56 | private$doResolve, 57 | private$doReject 58 | ) 59 | }) 60 | } else { 61 | private$doRejectFinalReason(reason) 62 | } 63 | }, 64 | # These "final" versions of resolve/reject are for when we've 65 | # established that the value/reason is not itself a promise. 66 | doResolveFinalValue = function(value, visible) { 67 | private$value <- value 68 | private$visible <- visible 69 | private$state <- "fulfilled" 70 | 71 | later::later(function() { 72 | lapply(private$onFulfilled, function(f) { 73 | f(private$value, private$visible) 74 | }) 75 | private$onFulfilled <- list() 76 | }) 77 | }, 78 | doRejectFinalReason = function(reason) { 79 | private$value <- reason 80 | private$state <- "rejected" 81 | 82 | later::later(function() { 83 | lapply(private$onRejected, function(f) { 84 | private$rejectionHandled <- TRUE 85 | f(private$value) 86 | }) 87 | private$onRejected <- list() 88 | 89 | later::later( 90 | ~ { 91 | if (!private$rejectionHandled) { 92 | # warning() was unreliable here 93 | cat( 94 | file = stderr(), 95 | "Unhandled promise error: ", 96 | reason$message, 97 | "\n", 98 | sep = "" 99 | ) 100 | } 101 | } 102 | ) 103 | }) 104 | } 105 | ), 106 | public = list( 107 | # "pending", "fulfilled", "rejected" 108 | status = function() { 109 | private$state 110 | }, 111 | resolve = function(value) { 112 | # Only allow this to be called once, then no-op. 113 | if (private$publicResolveRejectCalled) return(invisible()) 114 | private$publicResolveRejectCalled <- TRUE 115 | 116 | tryCatch( 117 | { 118 | # Important: Do not trigger evaluation of value before 119 | # passing to doResolve. doResolve calls withVisible() on 120 | # value, so evaluating it before that point will cause 121 | # the visibility to be lost. 122 | private$doResolve(value) 123 | }, 124 | error = function(err) { 125 | private$doReject(err) 126 | } 127 | ) 128 | 129 | invisible() 130 | }, 131 | reject = function(reason) { 132 | # Only allow this to be called once, then no-op. 133 | if (private$publicResolveRejectCalled) return(invisible()) 134 | private$publicResolveRejectCalled <- TRUE 135 | 136 | tryCatch( 137 | { 138 | force(reason) 139 | if (is.character(reason)) { 140 | reason <- simpleError(reason) 141 | } 142 | private$doReject(reason) 143 | }, 144 | error = function(err) { 145 | private$doReject(err) 146 | } 147 | ) 148 | 149 | invisible() 150 | }, 151 | then = function(onFulfilled = NULL, onRejected = NULL, onFinally = NULL) { 152 | onFulfilled <- normalizeOnFulfilled(onFulfilled) 153 | onRejected <- normalizeOnRejected(onRejected) 154 | if (!is.function(onFinally)) { 155 | onFinally <- NULL 156 | } 157 | 158 | promise2 <- promise(function(resolve, reject) { 159 | res <- promiseDomain$onThen(onFulfilled, onRejected, onFinally) 160 | 161 | if (!is.null(res)) { 162 | onFulfilled <- res$onFulfilled 163 | onRejected <- res$onRejected 164 | } 165 | 166 | handleFulfill <- function(value, visible) { 167 | if (is.function(onFulfilled)) { 168 | resolve(onFulfilled(value, visible)) 169 | } else { 170 | resolve(if (visible) value else invisible(value)) 171 | } 172 | } 173 | 174 | handleReject <- function(reason) { 175 | if (is.function(onRejected)) { 176 | # Yes, resolve, not reject. 177 | resolve(onRejected(reason)) 178 | } else { 179 | # Yes, reject, not resolve. 180 | reject(reason) 181 | } 182 | } 183 | 184 | if (private$state == "pending") { 185 | private$onFulfilled <- c( 186 | private$onFulfilled, 187 | list( 188 | handleFulfill 189 | ) 190 | ) 191 | private$onRejected <- c( 192 | private$onRejected, 193 | list( 194 | handleReject 195 | ) 196 | ) 197 | } else if (private$state == "fulfilled") { 198 | later::later(function() { 199 | handleFulfill(private$value, private$visible) 200 | }) 201 | } else if (private$state == "rejected") { 202 | later::later(function() { 203 | private$rejectionHandled <- TRUE 204 | handleReject(private$value) 205 | }) 206 | } else { 207 | stop("Unexpected state ", private$state) 208 | } 209 | }) 210 | 211 | invisible(promise2) 212 | }, 213 | catch = function(onRejected) { 214 | invisible(self$then(onRejected = onRejected)) 215 | }, 216 | finally = function(onFinally) { 217 | invisible(self$then( 218 | onFinally = onFinally 219 | )) 220 | }, 221 | format = function() { 222 | if (private$state == "pending") { 223 | "" 224 | } else { 225 | classname <- class(private$value)[[1]] 226 | if (length(classname) == 0) classname <- "" 227 | 228 | sprintf("", private$state, classname) 229 | } 230 | } 231 | ) 232 | ) 233 | 234 | normalizeOnFulfilled <- function(onFulfilled) { 235 | if (!is.function(onFulfilled)) { 236 | if (!is.null(onFulfilled)) { 237 | warning("`onFulfilled` must be a function or `NULL`") 238 | } 239 | return(NULL) 240 | } 241 | 242 | args <- formals(onFulfilled) 243 | arg_count <- length(args) 244 | 245 | if (arg_count >= 2 && names(args)[[2]] == ".visible") { 246 | onFulfilled 247 | } else if (arg_count > 0) { 248 | function(value, .visible) { 249 | if (isTRUE(.visible)) { 250 | onFulfilled(value) 251 | } else { 252 | onFulfilled(invisible(value)) 253 | } 254 | } 255 | } else { 256 | function(value, .visible) { 257 | onFulfilled() 258 | } 259 | } 260 | } 261 | 262 | normalizeOnRejected <- function(onRejected) { 263 | if (!is.function(onRejected)) { 264 | if (!is.null(onRejected)) { 265 | warning("`onRejected` must be a function or `NULL`") 266 | } 267 | return(NULL) 268 | } 269 | 270 | args <- formals(onRejected) 271 | arg_count <- length(args) 272 | 273 | if (arg_count >= 1) { 274 | onRejected 275 | } else if (arg_count == 0) { 276 | function(reason) { 277 | onRejected() 278 | } 279 | } 280 | } 281 | 282 | #' Create a new promise object 283 | #' 284 | #' `promise()` creates a new promise. A promise is a placeholder object for the 285 | #' eventual result (or error) of an asynchronous operation. This function is not 286 | #' generally needed to carry out asynchronous programming tasks; instead, it is 287 | #' intended to be used mostly by package authors who want to write asynchronous 288 | #' functions that return promises. 289 | #' 290 | #' The `action` function should be a piece of code that returns quickly, but 291 | #' initiates a potentially long-running, asynchronous task. If/when the task 292 | #' successfully completes, call `resolve(value)` where `value` is the result of 293 | #' the computation (like the return value). If the task fails, call 294 | #' `reject(reason)`, where `reason` is either an error object, or a character 295 | #' string. 296 | #' 297 | #' It's important that asynchronous tasks kicked off from `action` be coded very 298 | #' carefully--in particular, all errors must be caught and passed to `reject()`. 299 | #' Failure to do so will cause those errors to be lost, at best; and the caller 300 | #' of the asynchronous task will never receive a response (the asynchronous 301 | #' equivalent of a function call that never returns, i.e. hangs). 302 | #' 303 | #' The return value of `action` will be ignored. 304 | #' 305 | #' @param action A function with signature `function(resolve, reject)`, or a 306 | #' one-sided formula. See Details. 307 | #' 308 | #' @return A promise object (see \code{\link{then}}). 309 | #' 310 | #' @examples 311 | #' # Create a promise that resolves to a random value after 2 secs 312 | #' p1 <- promise(function(resolve, reject) { 313 | #' later::later(~resolve(runif(1)), delay = 2) 314 | #' }) 315 | #' 316 | #' p1 %...>% print() 317 | #' 318 | #' # Create a promise that errors immediately 319 | #' p2 <- promise(~{ 320 | #' reject("An error has occurred") 321 | #' }) 322 | #' then(p2, 323 | #' onFulfilled = ~message("Success"), 324 | #' onRejected = ~message("Failure") 325 | #' ) 326 | #' 327 | #' @export 328 | promise <- function(action) { 329 | if (inherits(action, "formula")) { 330 | if (length(action) != 2) { 331 | stop("'action' must be a function or one-sided formula") 332 | } 333 | } else if (is.function(action)) { 334 | if (length(formals(action)) != 2) { 335 | stop("'action' function must have two arguments") 336 | } 337 | } else { 338 | stop("Invalid action argument--must be a function or formula") 339 | } 340 | 341 | p <- Promise$new() 342 | 343 | tryCatch( 344 | { 345 | if (is.function(action)) { 346 | action(p$resolve, p$reject) 347 | } else if (inherits(action, "formula")) { 348 | eval( 349 | action[[2]], 350 | list( 351 | resolve = p$resolve, 352 | reject = p$reject, 353 | return = function(value) { 354 | warning("Can't return a value from a promise, use resolve/reject") 355 | } 356 | ), 357 | environment(action) 358 | ) 359 | } 360 | }, 361 | error = function(e) { 362 | if (p$status() == "pending") { 363 | p$reject(e) 364 | } else { 365 | # Too late to do anything useful. Just notify. 366 | warning(e) 367 | } 368 | } 369 | ) 370 | structure( 371 | list( 372 | then = p$then, 373 | catch = p$catch, 374 | finally = p$finally 375 | ), 376 | class = "promise", 377 | promise_impl = p 378 | ) 379 | } 380 | 381 | #' Create a resolved or rejected promise 382 | #' 383 | #' Helper functions to conveniently create a promise that is resolved to the 384 | #' given value (or rejected with the given reason). 385 | #' 386 | #' @param value A value, or promise, that the new promise should be resolved to. 387 | #' This expression will be lazily evaluated, and if evaluating the expression 388 | #' raises an error, then the new promise will be rejected with that error as 389 | #' the reason. 390 | #' @param reason An error message string, or error object. 391 | #' 392 | #' @examples 393 | #' promise_resolve(mtcars) %...>% 394 | #' head() %...>% 395 | #' print() 396 | #' 397 | #' promise_reject("Something went wrong") %...T!% 398 | #' { message(conditionMessage(.)) } 399 | #' 400 | #' @export 401 | promise_resolve <- function(value) { 402 | promise(~ resolve(value)) 403 | } 404 | 405 | #' @rdname promise_resolve 406 | #' @export 407 | promise_reject <- function(reason) { 408 | promise(~ reject(reason)) 409 | } 410 | 411 | #' Coerce to a promise 412 | #' 413 | #' Use `is.promise` to determine whether an R object is a promise. Use 414 | #' `as.promise` (an S3 generic method) to attempt to coerce an R object to a 415 | #' promise, and `is.promising` (another S3 generic method) to test whether 416 | #' `as.promise` is supported. This package includes support for converting 417 | #' [future::Future] objects into promises. 418 | #' 419 | #' @param x An R object to test or coerce. 420 | #' 421 | #' @return `as.promise` returns a promise object, or throws an error if the 422 | #' object cannot be converted. 423 | #' 424 | #' `is.promise` returns `TRUE` if the given value is a promise object, and 425 | #' `FALSE` otherwise. 426 | #' 427 | #' `is.promising` returns `TRUE` if the given value is a promise object or 428 | #' if it can be converted to a promise object using `as.promise`, and `FALSE` 429 | #' otherwise. 430 | #' 431 | #' @export 432 | is.promise <- function(x) { 433 | inherits(x, "promise") 434 | } 435 | 436 | #' @rdname is.promise 437 | #' @export 438 | is.promising <- function(x) { 439 | UseMethod("is.promising") 440 | } 441 | 442 | #' @export 443 | is.promising.default <- function(x) { 444 | FALSE 445 | } 446 | 447 | #' @export 448 | is.promising.promise <- function(x) { 449 | TRUE 450 | } 451 | 452 | #' @export 453 | is.promising.Future <- function(x) { 454 | TRUE 455 | } 456 | 457 | #' @rdname is.promise 458 | #' @export 459 | as.promise <- function(x) { 460 | UseMethod("as.promise", x) 461 | } 462 | 463 | #' @export 464 | as.promise.promise <- function(x) { 465 | x 466 | } 467 | 468 | #' @export 469 | as.promise.Future <- function(x) { 470 | # We want to create a promise only once for each Future object, and cache it 471 | # as an attribute. This spares us from having multiple polling loops waiting 472 | # for the same Future. 473 | 474 | cached <- attr(x, "converted_promise", exact = TRUE) 475 | if (!is.null(cached)) { 476 | return(cached) 477 | } 478 | 479 | p <- promise(function(resolve, reject) { 480 | poll_interval <- 0.1 481 | check <- function() { 482 | # timeout = 0 is important, the default waits for 200ms 483 | is_resolved <- tryCatch( 484 | { 485 | future::resolved(x, timeout = 0) 486 | }, 487 | FutureError = function(e) { 488 | reject(e) 489 | TRUE 490 | } 491 | ) 492 | if (is_resolved) { 493 | tryCatch( 494 | { 495 | result <- future::value(x, signal = TRUE) 496 | resolve(result) 497 | }, 498 | FutureError = function(e) { 499 | reject(e) 500 | TRUE 501 | }, 502 | error = function(e) { 503 | reject(e) 504 | } 505 | ) 506 | } else { 507 | later::later(check, poll_interval) 508 | } 509 | } 510 | check() 511 | }) 512 | 513 | # Store the new promise for next time 514 | attr(x, "converted_promise") <- p 515 | p 516 | } 517 | 518 | #' @export 519 | as.promise.default <- function(x) { 520 | # TODO: If x is an error or try-error, should this return a rejected promise? 521 | stop( 522 | "Don't know how to convert object of class ", 523 | class(x)[[1L]], 524 | " into a promise" 525 | ) 526 | } 527 | 528 | #' Fulfill a promise 529 | #' 530 | #' Use these functions to satisfy a promise with either success (\code{resolve}) 531 | #' or failure (\code{reject}). These functions are not exported, but rather, are 532 | #' passed as arguments to the \code{action} function you pass to a [promise] 533 | #' constructor. 534 | #' 535 | #' @param value The result from a successful calculation. 536 | #' @param reason An error or string that explains why the operation failed. 537 | #' 538 | #' @keywords internal 539 | resolve <- function(value = NULL) { 540 | stop("resolve() must be called from within a promise constructor") 541 | } 542 | 543 | #' @rdname resolve 544 | #' @keywords internal 545 | reject <- function(reason) { 546 | stop("reject() must be called from within a promise constructor") 547 | } 548 | -------------------------------------------------------------------------------- /R/promises-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | ## usethis namespace: end 6 | NULL 7 | 8 | ignore_unused_imports <- function() { 9 | fastmap::fastqueue 10 | } 11 | 12 | release_bullets <- function() { 13 | c( 14 | "Update staticimports: `staticimports::import()`" 15 | ) 16 | } 17 | -------------------------------------------------------------------------------- /R/staticimports.R: -------------------------------------------------------------------------------- 1 | # Generated by staticimports; do not edit by hand. 2 | # ====================================================================== 3 | # Imported from pkg:staticimports 4 | # ====================================================================== 5 | 6 | get_package_version <- function(pkg) { 7 | # `utils::packageVersion()` can be slow, so first try the fast path of 8 | # checking if the package is already loaded. 9 | ns <- .getNamespace(pkg) 10 | if (is.null(ns)) { 11 | utils::packageVersion(pkg) 12 | } else { 13 | as.package_version(ns$.__NAMESPACE__.$spec[["version"]]) 14 | } 15 | } 16 | 17 | is_installed <- function(pkg, version = NULL) { 18 | installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg)) 19 | 20 | if (is.null(version)) { 21 | return(installed) 22 | } 23 | 24 | if (!is.character(version) && !inherits(version, "numeric_version")) { 25 | # Avoid https://bugs.r-project.org/show_bug.cgi?id=18548 26 | alert <- if (identical(Sys.getenv("TESTTHAT"), "true")) stop else warning 27 | alert("`version` must be a character string or a `package_version` or `numeric_version` object.") 28 | 29 | version <- numeric_version(sprintf("%0.9g", version)) 30 | } 31 | 32 | installed && isTRUE(get_package_version(pkg) >= version) 33 | } 34 | 35 | # A wrapper for `system.file()`, which caches the package path because 36 | # `system.file()` can be slow. If a package is not installed, the result won't 37 | # be cached. 38 | system_file_cached <- local({ 39 | pkg_dir_cache <- character() 40 | 41 | function(..., package = "base") { 42 | if (!is.null(names(list(...)))) { 43 | stop("All arguments other than `package` must be unnamed.") 44 | } 45 | 46 | not_cached <- is.na(match(package, names(pkg_dir_cache))) 47 | if (not_cached) { 48 | pkg_dir <- system.file(package = package) 49 | if (nzchar(pkg_dir)) { 50 | pkg_dir_cache[[package]] <<- pkg_dir 51 | } 52 | } else { 53 | pkg_dir <- pkg_dir_cache[[package]] 54 | } 55 | 56 | file.path(pkg_dir, ...) 57 | } 58 | }) 59 | -------------------------------------------------------------------------------- /R/then.R: -------------------------------------------------------------------------------- 1 | #' Access the results of a promise 2 | #' 3 | #' Use the `then` function to access the eventual result of a promise (or, if the operation fails, the reason for that failure). Regardless of the state of the promise, the call to `then` is non-blocking, that is, it returns immediately; so what it does *not* do is immediately return the result value of the promise. Instead, you pass logic you want to execute to `then`, in the form of function callbacks (or formulas, see Details). If you provide an `onFulfilled` callback, it will be called upon the promise's successful resolution, with a single argument `value`: the result value. If you provide an `onRejected` callback, it will be called if the operation fails, with a single argument `reason`: the error that caused the failure. 4 | #' 5 | #' @section Formulas: 6 | #' 7 | #' For convenience, the `then()`, `catch()`, and `finally()` functions use 8 | #' [rlang::as_function()] to convert `onFulfilled`, `onRejected`, and 9 | #' `onFinally` arguments to functions. This means that you can use formulas to 10 | #' create very compact anonymous functions, using `.` to access the value (in 11 | #' the case of `onFulfilled`) or error (in the case of `onRejected`). 12 | #' 13 | #' @section Chaining promises: 14 | #' 15 | #' The first parameter of `then` is a promise; given the stated purpose of the 16 | #' function, this should be no surprise. However, what may be surprising is that 17 | #' the return value of `then` is also a (newly created) promise. This new 18 | #' promise waits for the original promise to be fulfilled or rejected, and for 19 | #' `onFulfilled` or `onRejected` to be called. The result of (or error raised 20 | #' by) calling `onFulfilled`/`onRejected` will be used to fulfill (reject) the 21 | #' new promise. 22 | #' 23 | #' ``` 24 | #' promise_a <- get_data_frame_async() 25 | #' promise_b <- then(promise_a, onFulfilled = head) 26 | #' ``` 27 | #' 28 | #' In this example, assuming `get_data_frame_async` returns a promise that 29 | #' eventually resolves to a data frame, `promise_b` will eventually resolve to 30 | #' the first 10 or fewer rows of that data frame. 31 | #' 32 | #' Note that the new promise is considered fulfilled or rejected based on 33 | #' whether `onFulfilled`/`onRejected` returns a value or throws an error, not on 34 | #' whether the original promise was fulfilled or rejected. In other words, it's 35 | #' possible to turn failure to success and success to failure. Consider this 36 | #' example, where we expect `some_async_operation` to fail, and want to consider 37 | #' it an error if it doesn't: 38 | #' 39 | #' ``` 40 | #' promise_c <- some_async_operation() 41 | #' promise_d <- then(promise_c, 42 | #' onFulfilled = function(value) { 43 | #' stop("That's strange, the operation didn't fail!") 44 | #' }, 45 | #' onRejected = function(reason) { 46 | #' # Great, the operation failed as expected 47 | #' NULL 48 | #' } 49 | #' ) 50 | #' ``` 51 | #' 52 | #' Now, `promise_d` will be rejected if `promise_c` is fulfilled, and vice 53 | #' versa. 54 | #' 55 | #' **Warning:** Be very careful not to accidentally turn failure into success, 56 | #' if your error handling code is not the last item in a chain! 57 | #' 58 | #' ``` 59 | #' some_async_operation() %>% 60 | #' catch(function(reason) { 61 | #' warning("An error occurred: ", reason) 62 | #' }) %>% 63 | #' then(function() { 64 | #' message("I guess we succeeded...?") # No! 65 | #' }) 66 | #' ``` 67 | #' 68 | #' In this example, the `catch` callback does not itself throw an error, so the 69 | #' subsequent `then` call will consider its promise fulfilled! 70 | #' 71 | #' @section Convenience functions: 72 | #' 73 | #' For readability and convenience, we provide `catch` and `finally` functions. 74 | #' 75 | #' The `catch` function is equivalent to `then`, but without the `onFulfilled` 76 | #' argument. It is typically used at the end of a promise chain to perform error 77 | #' handling/logging. 78 | #' 79 | #' The `finally` function is similar to `then`, but takes a single no-argument 80 | #' function (or formula) that will be executed upon completion of the promise, 81 | #' regardless of whether the result is success or failure. It is typically used 82 | #' at the end of a promise chain to perform cleanup tasks, like closing file 83 | #' handles or database connections. Unlike `then` and `catch`, the return value 84 | #' of `finally` is ignored; however, if an error is thrown in `finally`, that 85 | #' error will be propagated forward into the returned promise. 86 | #' 87 | #' @section Visibility: 88 | #' 89 | #' `onFulfilled` functions can optionally have a second parameter `visible`, 90 | #' which will be `FALSE` if the result value is [invisible][base::invisible()]. 91 | #' 92 | #' @param promise A promise object. The object can be in any state. 93 | #' 94 | #' @param onFulfilled A function (or a formula--see Details) that will be 95 | #' invoked if the promise value successfully resolves. When invoked, the 96 | #' function will be called with a single argument: the resolved value. 97 | #' Optionally, the function can take a second parameter `.visible` if you care 98 | #' whether the promise was resolved with a visible or invisible value. The 99 | #' function can return a value or a promise object, or can throw an error; 100 | #' these will affect the resolution of the promise object that is returned 101 | #' by `then()`. 102 | #' 103 | #' @param onRejected A function taking the argument `error` (or a formula--see 104 | #' Details). The function can return a value or a promise object, or can throw 105 | #' an error. If `onRejected` is provided and doesn't throw an error (or return 106 | #' a promise that fails) then this is the async equivalent of catching an 107 | #' error. 108 | #' 109 | #' @export 110 | then <- function(promise, onFulfilled = NULL, onRejected = NULL) { 111 | promise <- as.promise(promise) 112 | 113 | if (!is.null(onFulfilled)) onFulfilled <- rlang::as_function(onFulfilled) 114 | if (!is.null(onRejected)) onRejected <- rlang::as_function(onRejected) 115 | invisible(promise$then(onFulfilled = onFulfilled, onRejected = onRejected)) 116 | } 117 | 118 | #' @param tee If `TRUE`, ignore the return value of the callback, and use the 119 | #' original value instead. This is useful for performing operations with 120 | #' side-effects, particularly logging to the console or a file. If the 121 | #' callback itself throws an error, and `tee` is `TRUE`, that error will still 122 | #' be used to fulfill the the returned promise (in other words, `tee` only has 123 | #' an effect if the callback does not throw). 124 | #' @rdname then 125 | #' @export 126 | catch <- function(promise, onRejected, tee = FALSE) { 127 | promise <- as.promise(promise) 128 | 129 | if (!is.null(onRejected)) onRejected <- rlang::as_function(onRejected) 130 | 131 | if (!tee) { 132 | return(promise$catch(onRejected)) 133 | } else { 134 | promise$catch(function(reason) { 135 | onRejected(reason) 136 | stop(reason) 137 | }) 138 | } 139 | } 140 | 141 | #' @rdname then 142 | #' 143 | #' @param onFinally A function with no arguments, to be called when the async 144 | #' operation either succeeds or fails. Usually used for freeing resources that 145 | #' were used during async operations. 146 | #' 147 | #' @export 148 | finally <- function(promise, onFinally) { 149 | promise <- as.promise(promise) 150 | 151 | if (!is.null(onFinally)) onFinally <- rlang::as_function(onFinally) 152 | promise$finally(onFinally) 153 | } 154 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # @staticimports pkg:staticimports 2 | # is_installed 3 | 4 | #' Combine multiple promise objects 5 | #' 6 | #' Use `promise_all` to wait for multiple promise objects to all be successfully 7 | #' fulfilled. Use `promise_race` to wait for the first of multiple promise 8 | #' objects to be either fulfilled or rejected. 9 | #' 10 | #' @param ... Promise objects. Either all arguments must be named, or all 11 | #' arguments must be unnamed. If `.list` is provided, then these arguments are 12 | #' ignored. 13 | #' @param .list A list of promise objects--an alternative to `...`. 14 | #' 15 | #' @return A promise. 16 | #' 17 | #' For `promise_all`, if all of the promises were successful, the returned 18 | #' promise will resolve to a list of the promises' values; if any promise 19 | #' fails, the first error to be encountered will be used to reject the 20 | #' returned promise. 21 | #' 22 | #' For `promise_race`, the first of the promises to either fulfill or reject 23 | #' will be passed through to the returned promise. 24 | #' 25 | #' @examples 26 | #' p1 <- promise(~later::later(~resolve(1), delay = 1)) 27 | #' p2 <- promise(~later::later(~resolve(2), delay = 2)) 28 | #' 29 | #' # Resolves after 1 second, to the value: 1 30 | #' promise_race(p1, p2) %...>% { 31 | #' cat("promise_race:\n") 32 | #' str(.) 33 | #' } 34 | #' 35 | #' # Resolves after 2 seconds, to the value: list(1, 2) 36 | #' promise_all(p1, p2) %...>% { 37 | #' cat("promise_all:\n") 38 | #' str(.) 39 | #' } 40 | #' 41 | #' @export 42 | promise_all <- function(..., .list = NULL) { 43 | if (missing(.list)) { 44 | .list <- list(...) 45 | } 46 | 47 | if (length(.list) == 0) { 48 | return(promise(~ resolve(list()))) 49 | } 50 | 51 | # Verify that .list members are either all named or all unnamed 52 | nameCount <- sum(nzchar(names(.list))) 53 | if (nameCount != 0 && nameCount != length(.list)) { 54 | stop( 55 | "promise_all expects promise arguments (or list) to be either all named or all unnamed" 56 | ) 57 | } 58 | 59 | done <- list() 60 | results <- list() 61 | 62 | promise(function(resolve, reject) { 63 | keys <- if (is.null(names(.list))) { 64 | 1:length(.list) 65 | } else { 66 | names(.list) 67 | } 68 | 69 | lapply(keys, function(key) { 70 | done[[key]] <<- FALSE 71 | # Forces correct/deterministic ordering of the result list's elements 72 | results[[key]] <<- NA 73 | 74 | then( 75 | .list[[key]], 76 | onFulfilled = function(value) { 77 | # Save the result so we can return it to the user. 78 | # This weird assignment is similar to `results[[key]] <- value`, except 79 | # that it handles NULL values correctly. 80 | results[key] <<- list(value) 81 | 82 | # Record the fact that the promise was completed. 83 | done[[key]] <<- TRUE 84 | # If all of the tasks are done, resolve. 85 | if (all(as.logical(done))) { 86 | resolve(results) 87 | } 88 | }, 89 | onRejected = function(reason) { 90 | # TODO: Cancel promises that are still running 91 | reject(reason) 92 | } 93 | ) 94 | }) 95 | }) 96 | } 97 | 98 | #' @rdname promise_all 99 | #' @export 100 | promise_race <- function(..., .list = NULL) { 101 | if (missing(.list)) { 102 | .list <- list(...) 103 | } 104 | 105 | promise(function(resolve, reject) { 106 | lapply(.list, function(promise) { 107 | then(promise, resolve, reject) 108 | }) 109 | }) 110 | } 111 | 112 | #' Promise-aware lapply/map 113 | #' 114 | #' Similar to [`base::lapply()`] or [`purrr::map`], but promise-aware: the `.f` 115 | #' function is permitted to return promises, and while `lapply` returns a list, 116 | #' `promise_map` returns a promise that resolves to a similar list (of resolved 117 | #' values only, no promises). 118 | #' 119 | #' `promise_map` processes elements of `.x` serially; that is, if `.f(.x[[1]])` 120 | #' returns a promise, then `.f(.x[[2]])` will not be invoked until that promise 121 | #' is resolved. If any such promise rejects (errors), then the promise returned 122 | #' by `promise_map` immediately rejects with that err. 123 | #' 124 | #' @param .x A vector (atomic or list) or an expression object (but not a 125 | #' promise). Other objects (including classed objects) will be coerced by 126 | #' base::as.list. 127 | #' @param .f The function to be applied to each element of `.x`. The function is 128 | #' permitted, but not required, to return a promise. 129 | #' @param ... Optional arguments to `.f`. 130 | #' @return A promise that resolves to a list (of values, not promises). 131 | #' 132 | #' @examples 133 | #' # Waits x seconds, then returns x*10 134 | #' wait_this_long <- function(x) { 135 | #' promise(~later::later(~{ 136 | #' resolve(x*10) 137 | #' }, delay = x)) 138 | #' } 139 | #' 140 | #' promise_map(list(A=1, B=2, C=3), wait_this_long) %...>% 141 | #' print() 142 | #' 143 | #' @export 144 | promise_map <- function(.x, .f, ...) { 145 | .f <- match.fun(.f) 146 | if (!is.vector(.x) || is.object(.x)) .x <- as.list(.x) 147 | x_names <- names(.x) 148 | results <- vector("list", length(.x)) 149 | 150 | do_next <- function(pos) { 151 | if (pos > length(results)) { 152 | return(stats::setNames(results, x_names)) 153 | } else { 154 | # The next line may throw, that's fine, it will be caught by resolve() and 155 | # reject the promise 156 | this_result <- .f(.x[[pos]], ...) 157 | promise_resolve(this_result) %...>% 158 | (function(this_value) { 159 | results[[pos]] <<- this_value 160 | do_next(pos + 1) 161 | }) 162 | } 163 | } 164 | 165 | promise(function(resolve, reject) { 166 | resolve(do_next(1)) 167 | }) 168 | } 169 | 170 | #' Promise-aware version of Reduce 171 | #' 172 | #' Similar to [`purrr::reduce`] (left fold), but the function `.f` is permitted 173 | #' to return a promise. `promise_reduce` will wait for any returned promise to 174 | #' resolve before invoking `.f` with the next element; in other words, execution 175 | #' is serial. `.f` can return a promise as output but should never encounter a 176 | #' promise as input (unless `.x` itself is a list of promises to begin with, in 177 | #' which case the second parameter would be a promise). 178 | #' 179 | #' @param .x A vector or list to reduce. (Not a promise.) 180 | #' @param .f A function that takes two parameters. The first parameter will be 181 | #' the "result" (initially `.init`, and then set to the result of the most 182 | #' recent call to `func`), and the second parameter will be an element of `.x`. 183 | #' @param ... Other arguments to pass to `.f` 184 | #' @param .init The initial result value of the fold, passed into `.f` when it 185 | #' is first executed. 186 | #' 187 | #' @return A promise that will resolve to the result of calling `.f` on the last 188 | #' element (or `.init` if `.x` had no elements). If any invocation of `.f` 189 | #' results in an error or a rejected promise, then the overall 190 | #' `promise_reduce` promise will immediately reject with that error. 191 | #' 192 | #' @examples 193 | #' # Returns a promise for the sum of e1 + e2, with a 0.5 sec delay 194 | #' slowly_add <- function(e1, e2) { 195 | #' promise(~later::later(~resolve(e1 + e2), delay = 0.5)) 196 | #' } 197 | #' 198 | #' # Prints 55 after a little over 5 seconds 199 | #' promise_reduce(1:10, slowly_add, .init = 0) %...>% print() 200 | #' 201 | #' @export 202 | promise_reduce <- function(.x, .f, ..., .init) { 203 | p <- promise_resolve(.init) 204 | lapply(.x, function(item) { 205 | p <<- p %...>% .f(item, ...) 206 | }) 207 | p 208 | } 209 | 210 | # Placeholder to make R cmd check. 211 | # * Need purrr for docs, but don't need purrr for functionality 212 | # * Get failure if we don't include it 213 | # * Get failure if we do include it, but don't use it. So using it below. 214 | function() { 215 | purrr::reduce 216 | } 217 | 218 | # Determine if `identical(x, FALSE)` 219 | is_false <- function(x) { 220 | is.logical(x) && length(x) == 1L && !is.na(x) && !x 221 | } 222 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # promises 2 | 3 | 4 | [![R-CMD-check](https://github.com/rstudio/promises/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/rstudio/promises/actions/workflows/R-CMD-check.yaml) 5 | 6 | 7 | A promise library for R. https://rstudio.github.io/promises/ 8 | 9 | ## Installation 10 | 11 | ```r 12 | install.packages("promises") 13 | ``` 14 | 15 | To use promises with Shiny, make sure you have Shiny v1.1.0 or later. 16 | 17 | ## License 18 | 19 | MIT 20 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | 2 | url: https://rstudio.github.io/promises/ 3 | 4 | development: 5 | mode: auto 6 | 7 | template: 8 | package: tidytemplate 9 | bootstrap: 5 10 | bslib: 11 | primary: "#0088DA" # Shiny blue 12 | # https://github.com/rstudio/bslib/issues/1190 13 | navbar-bg: "#e8f6ff !important" # Shiny blue @ 92% ; https://mdigi.tools/lighten-color/#0088da 14 | 15 | reference: 16 | - title: Handling promises 17 | contents: 18 | - then 19 | - pipes 20 | - title: Combining promises 21 | contents: 22 | - promise_all 23 | - title: Functional promises 24 | contents: 25 | - promise_map 26 | - promise_reduce 27 | - title: Creating promises 28 | contents: 29 | - promise 30 | - future_promise 31 | - promise_resolve 32 | - is.promise 33 | - title: Domains 34 | contents: 35 | - with_promise_domain 36 | 37 | navbar: 38 | components: 39 | articles: 40 | text: Learning 41 | menu: 42 | - text: 1. Why use promises? 43 | href: articles/promises_01_motivation.html 44 | - text: 2. An informal intro to async programming 45 | href: articles/promises_02_intro.html 46 | - text: 3. Working with promises 47 | href: articles/promises_03_overview.html 48 | - text: 4. Launching tasks with future 49 | href: articles/promises_04_futures.html 50 | - text: 5. Advanced future and promises usage 51 | href: articles/promises_05_future_promise.html 52 | - text: 6. Using promises with Shiny 53 | href: articles/promises_06_shiny.html 54 | - text: 7. Combining promises 55 | href: articles/promises_07_combining.html 56 | - text: "8. Case study: Converting a Shiny app to async" 57 | href: articles/promises_08_casestudy.html 58 | 59 | redirects: 60 | - ["articles/motivation.html", "articles/promises_01_motivation.html"] 61 | - ["articles/intro.html", "articles/promises_02_intro.html"] 62 | - ["articles/overview.html", "articles/promises_03_overview.html"] 63 | - ["articles/futures.html", "articles/promises_04_futures.html"] 64 | - ["articles/future_promise.html", "articles/promises_05_future_promise.html"] 65 | - ["articles/shiny.html", "articles/promises_06_shiny.html"] 66 | - ["articles/combining.html", "articles/promises_07_combining.html"] 67 | - ["articles/casestudy.html", "articles/promises_08_casestudy.html"] 68 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 1 note 4 | 5 | I'm sorry to submit so soon after the last promises submission. v1.3.1 had 6 | an issue that we didn't discover until it was accepted to CRAN, where it 7 | causes certain kinds of Shiny apps that make heavy use of async to grind to 8 | a halt. 9 | -------------------------------------------------------------------------------- /index.md: -------------------------------------------------------------------------------- 1 | # Promises 2 | 3 | The promises package brings asynchronous programming capabilities to R. Asynchronous programming is a technique used by many programming languages to increase scalability and responsiveness. Traditionally, this style of programming has not been useful to R users. But the advent of R web applications like Shiny has made async programming relevant. 4 | 5 | This website provides a multi-step guide that will help familiarize you with several related concepts that are required for effective async programming. It is highly recommended that you go through the topics in order. 6 | 7 | ## Installation 8 | 9 | ```r 10 | install.packages("promises") 11 | ``` 12 | 13 | 16 | 17 | ## Contents 18 | 19 | #### [1. Why use `promises`?](articles/motivation.html) 20 | 21 | Why do we need async programming? What is it good for, and not good for? 22 | 23 | #### [2. An informal intro to async programming](articles/intro.html) 24 | 25 | Async programming can require a serious mental shift, even for veteran programmers. This document attempts to introduce the "average" R user to the topic, as gently as possible. 26 | 27 | #### [3. Working with `promises`](articles/overview.html) 28 | 29 | A more thorough exploration of the concepts behind `promises`, and the API provided by the `promises` package. 30 | 31 | #### [4. Launching tasks](articles/futures.html) 32 | 33 | A guide to the `future` package, the place where we expect most async programming in R to begin. 34 | 35 | #### [5. Advance `future` and `promises` usage](articles/future_promise.html) 36 | 37 | Leverage `promises` to make sure that `future` execution does not block the main R process. 38 | 39 | #### [5. Using promises with Shiny](articles/shiny.html) 40 | 41 | Learn how to integrate `promises` into your Shiny applications. 42 | 43 | #### [6. Combining `promises`](articles/combining.html) 44 | 45 | Functions and techniques for working with multiple `promises` simultaneously. 46 | 47 | #### [7. Case study: converting a Shiny app to async](articles/casestudy.html) 48 | 49 | Walk through the conversion of a realistic Shiny example app to async. 50 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | Async 2 | Bengtsson 3 | CMD 4 | Cheng's 5 | ETL 6 | FutureErrors 7 | Globals 8 | Hadley’s 9 | JS 10 | Lopp 11 | Multisession 12 | NSE 13 | OpenCPU 14 | PBC 15 | RServe 16 | RStudio 17 | Shiny's 18 | ShinyApps 19 | UI 20 | anonymized 21 | async 22 | backoff 23 | cloneable 24 | conf 25 | cranwhales 26 | deserialization 27 | deserialized 28 | downloaders 29 | dplyr 30 | effecty 31 | funder 32 | ggplot 33 | github 34 | globals 35 | gzipped 36 | hotspots 37 | https 38 | io 39 | labelled 40 | lapply 41 | lke 42 | magrittr 43 | magrittr's 44 | memoise 45 | multisession 46 | namespaced 47 | natively 48 | occured 49 | onRejected 50 | pre 51 | precomputation 52 | profiler 53 | profvis 54 | purrr 55 | purrr's 56 | ramped 57 | rds 58 | reactives 59 | renderers 60 | rstudio 61 | runtime’s 62 | scalability 63 | scalable 64 | shinydashboard 65 | shorthands 66 | summarizations 67 | syntaxes 68 | th 69 | this’ll 70 | tidyverse 71 | topologies 72 | totalling 73 | unevaluated 74 | unhandled 75 | users’ 76 | wc 77 | -------------------------------------------------------------------------------- /man/WorkQueue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/future_promise.R 3 | \name{WorkQueue} 4 | \alias{WorkQueue} 5 | \title{Future promise work queue} 6 | \description{ 7 | Future promise work queue 8 | 9 | Future promise work queue 10 | } 11 | \details{ 12 | #' \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 13 | 14 | An \pkg{R6} class to help with scheduling work to be completed. \code{WorkQueue} will only execute work if the \code{can_proceed()} returns \code{TRUE}. For the use case of \code{future}, \code{can_proceed()} defaults to \code{future::nbrOfFreeWorkers() > 0} which will not allow for work to be executed if a \pkg{future} worker is not available. 15 | 16 | \code{WorkQueue} will constantly try to start new work once prior work item finishes. However, if \code{can_proceed()} returns \code{FALSE} (no future workers are available) and there is more work to be done, then work is attempted later a random amount of time later using exponential backoff. The exponential backoff will cap out at 10 seconds to prevent unnecessarily large wait times. 17 | 18 | Each time \code{WorkQueue} tries to start more work, it will repeat until \code{can_proceed()} returns \code{FALSE} or there is no more work in the \code{queue}. 19 | } 20 | \section{Global event loop}{ 21 | 22 | 23 | The global loop is used by default as the internal \code{WorkQueue} "delayed check" uses a single delay check for the whole queue, rather than having each item in the queue attempt to process. 24 | This behavior might change in the future, but we are not exactly sure how at this point. 25 | 26 | If a private \code{later} loop wants to become synchronous by running until all jobs are completed but is waiting on a \code{future_promise()}, the private loop will not complete unless the global loop is allowed to move forward. 27 | 28 | However, it is possible to use a private loop inside a user-defined \code{WorkQueue} may work which can be provided directly to \code{future_promise(queue=custom_queue)}. Having a concrete example (or need) will help us understand the problem better. If you have an example, please reach out . 29 | } 30 | 31 | \seealso{ 32 | \code{\link[=future_promise_queue]{future_promise_queue()}} which returns a \code{WorkQueue} which is cached per R session. 33 | } 34 | \keyword{internal} 35 | \section{Methods}{ 36 | \subsection{Public methods}{ 37 | \itemize{ 38 | \item \href{#method-WorkQueue-new}{\code{WorkQueue$new()}} 39 | \item \href{#method-WorkQueue-schedule_work}{\code{WorkQueue$schedule_work()}} 40 | \item \href{#method-WorkQueue-clone}{\code{WorkQueue$clone()}} 41 | } 42 | } 43 | \if{html}{\out{
}} 44 | \if{html}{\out{}} 45 | \if{latex}{\out{\hypertarget{method-WorkQueue-new}{}}} 46 | \subsection{Method \code{new()}}{ 47 | Create a new \code{WorkQueue} 48 | \subsection{Usage}{ 49 | \if{html}{\out{
}}\preformatted{WorkQueue$new( 50 | can_proceed = future_worker_is_free, 51 | queue = fastmap::fastqueue(), 52 | loop = later::global_loop() 53 | )}\if{html}{\out{
}} 54 | } 55 | 56 | \subsection{Arguments}{ 57 | \if{html}{\out{
}} 58 | \describe{ 59 | \item{\code{can_proceed}}{Function that should return a logical value. If \code{TRUE} is returned, then the next scheduled work will be executed. By default, this function checks if \code{\link[future:nbrOfWorkers]{future::nbrOfFreeWorkers()} > 0}} 60 | 61 | \item{\code{queue}}{Queue object to use to store the scheduled work. By default, this is a "First In, First Out" queue using \code{\link[fastmap:fastqueue]{fastmap::fastqueue()}}. If using your own queue, it should have the methods \verb{$add(x)}, \verb{$remove()}, \verb{$size()}.} 62 | 63 | \item{\code{loop}}{\pkg{later} loop to use for calculating the next delayed check. Defaults to \code{\link[later:create_loop]{later::global_loop()}}. 64 | Schedule work} 65 | } 66 | \if{html}{\out{
}} 67 | } 68 | } 69 | \if{html}{\out{
}} 70 | \if{html}{\out{}} 71 | \if{latex}{\out{\hypertarget{method-WorkQueue-schedule_work}{}}} 72 | \subsection{Method \code{schedule_work()}}{ 73 | \subsection{Usage}{ 74 | \if{html}{\out{
}}\preformatted{WorkQueue$schedule_work(fn)}\if{html}{\out{
}} 75 | } 76 | 77 | \subsection{Arguments}{ 78 | \if{html}{\out{
}} 79 | \describe{ 80 | \item{\code{fn}}{function to execute when \code{can_proceed()} returns \code{TRUE}.} 81 | } 82 | \if{html}{\out{
}} 83 | } 84 | } 85 | \if{html}{\out{
}} 86 | \if{html}{\out{}} 87 | \if{latex}{\out{\hypertarget{method-WorkQueue-clone}{}}} 88 | \subsection{Method \code{clone()}}{ 89 | The objects of this class are cloneable with this method. 90 | \subsection{Usage}{ 91 | \if{html}{\out{
}}\preformatted{WorkQueue$clone(deep = FALSE)}\if{html}{\out{
}} 92 | } 93 | 94 | \subsection{Arguments}{ 95 | \if{html}{\out{
}} 96 | \describe{ 97 | \item{\code{deep}}{Whether to make a deep clone.} 98 | } 99 | \if{html}{\out{
}} 100 | } 101 | } 102 | } 103 | -------------------------------------------------------------------------------- /man/figures/lifecycle-archived.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclearchivedarchived -------------------------------------------------------------------------------- /man/figures/lifecycle-defunct.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecycledefunctdefunct -------------------------------------------------------------------------------- /man/figures/lifecycle-deprecated.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: deprecated 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | deprecated 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/figures/lifecycle-experimental.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: experimental 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | experimental 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/figures/lifecycle-maturing.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclematuringmaturing -------------------------------------------------------------------------------- /man/figures/lifecycle-questioning.svg: -------------------------------------------------------------------------------- 1 | lifecyclelifecyclequestioningquestioning -------------------------------------------------------------------------------- /man/figures/lifecycle-stable.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: stable 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 19 | 20 | lifecycle 21 | 22 | 25 | 26 | stable 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /man/figures/lifecycle-superseded.svg: -------------------------------------------------------------------------------- 1 | 2 | lifecycle: superseded 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | lifecycle 18 | 19 | superseded 20 | 21 | 22 | -------------------------------------------------------------------------------- /man/future_promise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/future_promise.R 3 | \name{future_promise_queue} 4 | \alias{future_promise_queue} 5 | \alias{future_promise} 6 | \title{\pkg{future} promise} 7 | \usage{ 8 | future_promise_queue() 9 | 10 | future_promise( 11 | expr = NULL, 12 | envir = parent.frame(), 13 | ..., 14 | substitute = TRUE, 15 | queue = future_promise_queue() 16 | ) 17 | } 18 | \arguments{ 19 | \item{expr}{An R expression. While the \code{expr} is eventually sent to \code{\link[future:future]{future::future()}}, please use the same precautions that you would use with regular \code{promises::promise()} expressions. \code{future_promise()} may have to hold the \code{expr} in a \code{\link[=promise]{promise()}} while waiting for a \pkg{future} worker to become available.} 20 | 21 | \item{envir}{The \link{environment} from where global objects should be 22 | identified.} 23 | 24 | \item{...}{extra parameters provided to \code{\link[future:future]{future::future()}}} 25 | 26 | \item{substitute}{If TRUE, argument \code{expr} is 27 | \code{\link[base]{substitute}()}:ed, otherwise not.} 28 | 29 | \item{queue}{A queue that is used to schedule work to be done using \code{\link[future:future]{future::future()}}. This queue defaults to \code{\link[=future_promise_queue]{future_promise_queue()}} and requires that method \code{queue$schedule_work(fn)} exist. This method should take in a function that will execute the promised \pkg{future} work.} 30 | } 31 | \value{ 32 | Unlike \code{\link[future:future]{future::future()}}, \code{future_promise()} returns a \code{\link[=promise]{promise()}} object that will eventually resolve the \pkg{future} \code{expr}. 33 | } 34 | \description{ 35 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 36 | } 37 | \details{ 38 | When submitting \pkg{future} work, \pkg{future} (by design) will block the main R session until a worker becomes available. 39 | This occurs when there is more submitted \pkg{future} work than there are available \pkg{future} workers. 40 | To counter this situation, we can create a promise to execute work using future (using \code{future_promise()}) and only begin the work if a \pkg{future} worker is available. 41 | 42 | Using \code{future_promise()} is recommended whenever a continuous runtime is used, such as with \pkg{plumber} or \pkg{shiny}. 43 | 44 | For more details and examples, please see the \href{https://rstudio.github.io/promises/articles/future_promise.html}{\code{vignette("future_promise", "promises")}} vignette. 45 | } 46 | \section{Functions}{ 47 | \itemize{ 48 | \item \code{future_promise_queue()}: Default \code{future_promise()} work queue to use. This function returns a \link{WorkQueue} that is cached per R session. 49 | 50 | \item \code{future_promise()}: Creates a \code{\link[=promise]{promise()}} that will execute the \code{expr} using \code{\link[future:future]{future::future()}}. 51 | 52 | }} 53 | \examples{ 54 | \donttest{# Relative start time 55 | start <- Sys.time() 56 | # Helper to force two `future` workers 57 | with_two_workers <- function(expr) { 58 | if (!require("future")) { 59 | message("`future` not installed") 60 | return() 61 | } 62 | old_plan <- future::plan(future::multisession(workers = 2)) 63 | on.exit({future::plan(old_plan)}, add = TRUE) 64 | start <<- Sys.time() 65 | force(expr) 66 | while(!later::loop_empty()) {Sys.sleep(0.1); later::run_now()} 67 | invisible() 68 | } 69 | # Print a status message. Ex: `"PID: XXX; 2.5s promise done"` 70 | print_msg <- function(pid, msg) { 71 | message( 72 | "PID: ", pid, "; ", 73 | round(difftime(Sys.time(), start, units = "secs"), digits = 1), "s " , 74 | msg 75 | ) 76 | } 77 | 78 | # `"promise done"` will appear after four workers are done and the main R session is not blocked 79 | # The important thing to note is the first four times will be roughly the same 80 | with_two_workers({ 81 | promise_resolve(Sys.getpid()) \%...>\% print_msg("promise done") 82 | for (i in 1:6) future::future({Sys.sleep(1); Sys.getpid()}) \%...>\% print_msg("future done") 83 | }) 84 | { 85 | #> PID: XXX; 2.5s promise done 86 | #> PID: YYY; 2.6s future done 87 | #> PID: ZZZ; 2.6s future done 88 | #> PID: YYY; 2.6s future done 89 | #> PID: ZZZ; 2.6s future done 90 | #> PID: YYY; 3.4s future done 91 | #> PID: ZZZ; 3.6s future done 92 | } 93 | 94 | # `"promise done"` will almost immediately, before any workers have completed 95 | # The first two `"future done"` comments appear earlier the example above 96 | with_two_workers({ 97 | promise_resolve(Sys.getpid()) \%...>\% print_msg("promise") 98 | for (i in 1:6) future_promise({Sys.sleep(1); Sys.getpid()}) \%...>\% print_msg("future done") 99 | }) 100 | { 101 | #> PID: XXX; 0.2s promise done 102 | #> PID: YYY; 1.3s future done 103 | #> PID: ZZZ; 1.4s future done 104 | #> PID: YYY; 2.5s future done 105 | #> PID: ZZZ; 2.6s future done 106 | #> PID: YYY; 3.4s future done 107 | #> PID: ZZZ; 3.6s future done 108 | }} 109 | } 110 | \seealso{ 111 | \code{\link{WorkQueue}} 112 | } 113 | -------------------------------------------------------------------------------- /man/is.promise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/promise.R 3 | \name{is.promise} 4 | \alias{is.promise} 5 | \alias{is.promising} 6 | \alias{as.promise} 7 | \title{Coerce to a promise} 8 | \usage{ 9 | is.promise(x) 10 | 11 | is.promising(x) 12 | 13 | as.promise(x) 14 | } 15 | \arguments{ 16 | \item{x}{An R object to test or coerce.} 17 | } 18 | \value{ 19 | \code{as.promise} returns a promise object, or throws an error if the 20 | object cannot be converted. 21 | 22 | \code{is.promise} returns \code{TRUE} if the given value is a promise object, and 23 | \code{FALSE} otherwise. 24 | 25 | \code{is.promising} returns \code{TRUE} if the given value is a promise object or 26 | if it can be converted to a promise object using \code{as.promise}, and \code{FALSE} 27 | otherwise. 28 | } 29 | \description{ 30 | Use \code{is.promise} to determine whether an R object is a promise. Use 31 | \code{as.promise} (an S3 generic method) to attempt to coerce an R object to a 32 | promise, and \code{is.promising} (another S3 generic method) to test whether 33 | \code{as.promise} is supported. This package includes support for converting 34 | \link[future:Future-class]{future::Future} objects into promises. 35 | } 36 | -------------------------------------------------------------------------------- /man/pipes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pipe.R 3 | \name{pipes} 4 | \alias{pipes} 5 | \alias{\%...>\%} 6 | \alias{\%...T>\%} 7 | \alias{\%...!\%} 8 | \alias{\%...T!\%} 9 | \title{Promise pipe operators} 10 | \usage{ 11 | lhs \%...>\% rhs 12 | 13 | lhs \%...T>\% rhs 14 | 15 | lhs \%...!\% rhs 16 | 17 | lhs \%...T!\% rhs 18 | } 19 | \arguments{ 20 | \item{lhs}{A promise object.} 21 | 22 | \item{rhs}{A function call using the magrittr semantics. It can return either 23 | a promise or non-promise value, or throw an error.} 24 | } 25 | \value{ 26 | A new promise. 27 | } 28 | \description{ 29 | Promise-aware pipe operators, in the style of \href{https://CRAN.R-project.org/package=magrittr/vignettes/magrittr.html}{magrittr}. 30 | Like magrittr pipes, these operators can be used to chain together pipelines 31 | of promise-transforming operations. Unlike magrittr pipes, these pipes wait 32 | for promise resolution and pass the unwrapped value (or error) to the \code{rhs} 33 | function call. 34 | } 35 | \details{ 36 | The \code{>} variants are for handling successful resolution, the \code{!} variants are 37 | for handling errors. The \code{T} variants of each return the lhs instead of the 38 | rhs, which is useful for pipeline steps that are used for side effects 39 | (printing, plotting, saving). 40 | \enumerate{ 41 | \item \code{promise \%...>\% func()} is equivalent to \code{promise \%>\% then(func)}. 42 | \item \code{promise \%...!\% func()} is equivalent to \code{promise \%>\% catch(func)}. 43 | \item \code{promise \%...T>\% func()} is equivalent to \code{promise \%T>\% then(func)}. 44 | \item \code{promise \%...T!\% func()} is equivalent to \code{promise \%T>\% 45 | catch(func)} or \code{promise \%>\% catch(func, tee = TRUE)}. 46 | } 47 | 48 | One situation where 3. and 4. above break down is when \code{func()} throws an 49 | error, or returns a promise that ultimately fails. In that case, the failure 50 | will be propagated by our pipe operators but not by the 51 | magrittr-plus-function "equivalents". 52 | 53 | For simplicity of implementation, we do not support the magrittr feature of 54 | using a \code{.} at the head of a pipeline to turn the entire pipeline into a 55 | function instead of an expression. 56 | } 57 | \examples{ 58 | \dontrun{ 59 | library(future) 60 | plan(multisession) 61 | 62 | future_promise(cars) \%...>\% 63 | head(5) \%...T>\% 64 | print() 65 | 66 | # If the read.csv fails, resolve to NULL instead 67 | future_promise(read.csv("http://example.com/data.csv")) \%...!\% 68 | { NULL } 69 | } 70 | 71 | } 72 | \seealso{ 73 | https://rstudio.github.io/promises/articles/overview.html#using-pipes 74 | } 75 | -------------------------------------------------------------------------------- /man/promise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/promise.R 3 | \name{promise} 4 | \alias{promise} 5 | \title{Create a new promise object} 6 | \usage{ 7 | promise(action) 8 | } 9 | \arguments{ 10 | \item{action}{A function with signature \verb{function(resolve, reject)}, or a 11 | one-sided formula. See Details.} 12 | } 13 | \value{ 14 | A promise object (see \code{\link{then}}). 15 | } 16 | \description{ 17 | \code{promise()} creates a new promise. A promise is a placeholder object for the 18 | eventual result (or error) of an asynchronous operation. This function is not 19 | generally needed to carry out asynchronous programming tasks; instead, it is 20 | intended to be used mostly by package authors who want to write asynchronous 21 | functions that return promises. 22 | } 23 | \details{ 24 | The \code{action} function should be a piece of code that returns quickly, but 25 | initiates a potentially long-running, asynchronous task. If/when the task 26 | successfully completes, call \code{resolve(value)} where \code{value} is the result of 27 | the computation (like the return value). If the task fails, call 28 | \code{reject(reason)}, where \code{reason} is either an error object, or a character 29 | string. 30 | 31 | It's important that asynchronous tasks kicked off from \code{action} be coded very 32 | carefully--in particular, all errors must be caught and passed to \code{reject()}. 33 | Failure to do so will cause those errors to be lost, at best; and the caller 34 | of the asynchronous task will never receive a response (the asynchronous 35 | equivalent of a function call that never returns, i.e. hangs). 36 | 37 | The return value of \code{action} will be ignored. 38 | } 39 | \examples{ 40 | # Create a promise that resolves to a random value after 2 secs 41 | p1 <- promise(function(resolve, reject) { 42 | later::later(~resolve(runif(1)), delay = 2) 43 | }) 44 | 45 | p1 \%...>\% print() 46 | 47 | # Create a promise that errors immediately 48 | p2 <- promise(~{ 49 | reject("An error has occurred") 50 | }) 51 | then(p2, 52 | onFulfilled = ~message("Success"), 53 | onRejected = ~message("Failure") 54 | ) 55 | 56 | } 57 | -------------------------------------------------------------------------------- /man/promise_all.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{promise_all} 4 | \alias{promise_all} 5 | \alias{promise_race} 6 | \title{Combine multiple promise objects} 7 | \usage{ 8 | promise_all(..., .list = NULL) 9 | 10 | promise_race(..., .list = NULL) 11 | } 12 | \arguments{ 13 | \item{...}{Promise objects. Either all arguments must be named, or all 14 | arguments must be unnamed. If \code{.list} is provided, then these arguments are 15 | ignored.} 16 | 17 | \item{.list}{A list of promise objects--an alternative to \code{...}.} 18 | } 19 | \value{ 20 | A promise. 21 | 22 | For \code{promise_all}, if all of the promises were successful, the returned 23 | promise will resolve to a list of the promises' values; if any promise 24 | fails, the first error to be encountered will be used to reject the 25 | returned promise. 26 | 27 | For \code{promise_race}, the first of the promises to either fulfill or reject 28 | will be passed through to the returned promise. 29 | } 30 | \description{ 31 | Use \code{promise_all} to wait for multiple promise objects to all be successfully 32 | fulfilled. Use \code{promise_race} to wait for the first of multiple promise 33 | objects to be either fulfilled or rejected. 34 | } 35 | \examples{ 36 | p1 <- promise(~later::later(~resolve(1), delay = 1)) 37 | p2 <- promise(~later::later(~resolve(2), delay = 2)) 38 | 39 | # Resolves after 1 second, to the value: 1 40 | promise_race(p1, p2) \%...>\% { 41 | cat("promise_race:\n") 42 | str(.) 43 | } 44 | 45 | # Resolves after 2 seconds, to the value: list(1, 2) 46 | promise_all(p1, p2) \%...>\% { 47 | cat("promise_all:\n") 48 | str(.) 49 | } 50 | 51 | } 52 | -------------------------------------------------------------------------------- /man/promise_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{promise_map} 4 | \alias{promise_map} 5 | \title{Promise-aware lapply/map} 6 | \usage{ 7 | promise_map(.x, .f, ...) 8 | } 9 | \arguments{ 10 | \item{.x}{A vector (atomic or list) or an expression object (but not a 11 | promise). Other objects (including classed objects) will be coerced by 12 | base::as.list.} 13 | 14 | \item{.f}{The function to be applied to each element of \code{.x}. The function is 15 | permitted, but not required, to return a promise.} 16 | 17 | \item{...}{Optional arguments to \code{.f}.} 18 | } 19 | \value{ 20 | A promise that resolves to a list (of values, not promises). 21 | } 22 | \description{ 23 | Similar to \code{\link[base:lapply]{base::lapply()}} or \code{\link[purrr:map]{purrr::map}}, but promise-aware: the \code{.f} 24 | function is permitted to return promises, and while \code{lapply} returns a list, 25 | \code{promise_map} returns a promise that resolves to a similar list (of resolved 26 | values only, no promises). 27 | } 28 | \details{ 29 | \code{promise_map} processes elements of \code{.x} serially; that is, if \code{.f(.x[[1]])} 30 | returns a promise, then \code{.f(.x[[2]])} will not be invoked until that promise 31 | is resolved. If any such promise rejects (errors), then the promise returned 32 | by \code{promise_map} immediately rejects with that err. 33 | } 34 | \examples{ 35 | # Waits x seconds, then returns x*10 36 | wait_this_long <- function(x) { 37 | promise(~later::later(~{ 38 | resolve(x*10) 39 | }, delay = x)) 40 | } 41 | 42 | promise_map(list(A=1, B=2, C=3), wait_this_long) \%...>\% 43 | print() 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/promise_reduce.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{promise_reduce} 4 | \alias{promise_reduce} 5 | \title{Promise-aware version of Reduce} 6 | \usage{ 7 | promise_reduce(.x, .f, ..., .init) 8 | } 9 | \arguments{ 10 | \item{.x}{A vector or list to reduce. (Not a promise.)} 11 | 12 | \item{.f}{A function that takes two parameters. The first parameter will be 13 | the "result" (initially \code{.init}, and then set to the result of the most 14 | recent call to \code{func}), and the second parameter will be an element of \code{.x}.} 15 | 16 | \item{...}{Other arguments to pass to \code{.f}} 17 | 18 | \item{.init}{The initial result value of the fold, passed into \code{.f} when it 19 | is first executed.} 20 | } 21 | \value{ 22 | A promise that will resolve to the result of calling \code{.f} on the last 23 | element (or \code{.init} if \code{.x} had no elements). If any invocation of \code{.f} 24 | results in an error or a rejected promise, then the overall 25 | \code{promise_reduce} promise will immediately reject with that error. 26 | } 27 | \description{ 28 | Similar to \code{\link[purrr:reduce]{purrr::reduce}} (left fold), but the function \code{.f} is permitted 29 | to return a promise. \code{promise_reduce} will wait for any returned promise to 30 | resolve before invoking \code{.f} with the next element; in other words, execution 31 | is serial. \code{.f} can return a promise as output but should never encounter a 32 | promise as input (unless \code{.x} itself is a list of promises to begin with, in 33 | which case the second parameter would be a promise). 34 | } 35 | \examples{ 36 | # Returns a promise for the sum of e1 + e2, with a 0.5 sec delay 37 | slowly_add <- function(e1, e2) { 38 | promise(~later::later(~resolve(e1 + e2), delay = 0.5)) 39 | } 40 | 41 | # Prints 55 after a little over 5 seconds 42 | promise_reduce(1:10, slowly_add, .init = 0) \%...>\% print() 43 | 44 | } 45 | -------------------------------------------------------------------------------- /man/promise_resolve.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/promise.R 3 | \name{promise_resolve} 4 | \alias{promise_resolve} 5 | \alias{promise_reject} 6 | \title{Create a resolved or rejected promise} 7 | \usage{ 8 | promise_resolve(value) 9 | 10 | promise_reject(reason) 11 | } 12 | \arguments{ 13 | \item{value}{A value, or promise, that the new promise should be resolved to. 14 | This expression will be lazily evaluated, and if evaluating the expression 15 | raises an error, then the new promise will be rejected with that error as 16 | the reason.} 17 | 18 | \item{reason}{An error message string, or error object.} 19 | } 20 | \description{ 21 | Helper functions to conveniently create a promise that is resolved to the 22 | given value (or rejected with the given reason). 23 | } 24 | \examples{ 25 | promise_resolve(mtcars) \%...>\% 26 | head() \%...>\% 27 | print() 28 | 29 | promise_reject("Something went wrong") \%...T!\% 30 | { message(conditionMessage(.)) } 31 | 32 | } 33 | -------------------------------------------------------------------------------- /man/promises-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/promises-package.R 3 | \docType{package} 4 | \name{promises-package} 5 | \alias{promises} 6 | \alias{promises-package} 7 | \title{promises: Abstractions for Promise-Based Asynchronous Programming} 8 | \description{ 9 | Provides fundamental abstractions for doing asynchronous programming in R using promises. Asynchronous programming is useful for allowing a single R process to orchestrate multiple tasks in the background while also attending to something else. Semantics are similar to 'JavaScript' promises, but with a syntax that is idiomatic R. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://rstudio.github.io/promises/} 15 | \item \url{https://github.com/rstudio/promises} 16 | \item Report bugs at \url{https://github.com/rstudio/promises/issues} 17 | } 18 | 19 | } 20 | \author{ 21 | \strong{Maintainer}: Joe Cheng \email{joe@posit.co} 22 | 23 | Other contributors: 24 | \itemize{ 25 | \item Posit Software, PBC (03wc8by49) [copyright holder, funder] 26 | } 27 | 28 | } 29 | \keyword{internal} 30 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pipe.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{\%>\%} 7 | \alias{\%T>\%} 8 | \title{Objects exported from other packages} 9 | \keyword{internal} 10 | \description{ 11 | These objects are imported from other packages. Follow the links 12 | below to see their documentation. 13 | 14 | \describe{ 15 | \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}, \code{\link[magrittr:tee]{\%T>\%}}} 16 | }} 17 | 18 | -------------------------------------------------------------------------------- /man/resolve.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/promise.R 3 | \name{resolve} 4 | \alias{resolve} 5 | \alias{reject} 6 | \title{Fulfill a promise} 7 | \usage{ 8 | resolve(value = NULL) 9 | 10 | reject(reason) 11 | } 12 | \arguments{ 13 | \item{value}{The result from a successful calculation.} 14 | 15 | \item{reason}{An error or string that explains why the operation failed.} 16 | } 17 | \description{ 18 | Use these functions to satisfy a promise with either success (\code{resolve}) 19 | or failure (\code{reject}). These functions are not exported, but rather, are 20 | passed as arguments to the \code{action} function you pass to a \link{promise} 21 | constructor. 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /man/then.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/then.R 3 | \name{then} 4 | \alias{then} 5 | \alias{catch} 6 | \alias{finally} 7 | \title{Access the results of a promise} 8 | \usage{ 9 | then(promise, onFulfilled = NULL, onRejected = NULL) 10 | 11 | catch(promise, onRejected, tee = FALSE) 12 | 13 | finally(promise, onFinally) 14 | } 15 | \arguments{ 16 | \item{promise}{A promise object. The object can be in any state.} 17 | 18 | \item{onFulfilled}{A function (or a formula--see Details) that will be 19 | invoked if the promise value successfully resolves. When invoked, the 20 | function will be called with a single argument: the resolved value. 21 | Optionally, the function can take a second parameter \code{.visible} if you care 22 | whether the promise was resolved with a visible or invisible value. The 23 | function can return a value or a promise object, or can throw an error; 24 | these will affect the resolution of the promise object that is returned 25 | by \code{then()}.} 26 | 27 | \item{onRejected}{A function taking the argument \code{error} (or a formula--see 28 | Details). The function can return a value or a promise object, or can throw 29 | an error. If \code{onRejected} is provided and doesn't throw an error (or return 30 | a promise that fails) then this is the async equivalent of catching an 31 | error.} 32 | 33 | \item{tee}{If \code{TRUE}, ignore the return value of the callback, and use the 34 | original value instead. This is useful for performing operations with 35 | side-effects, particularly logging to the console or a file. If the 36 | callback itself throws an error, and \code{tee} is \code{TRUE}, that error will still 37 | be used to fulfill the the returned promise (in other words, \code{tee} only has 38 | an effect if the callback does not throw).} 39 | 40 | \item{onFinally}{A function with no arguments, to be called when the async 41 | operation either succeeds or fails. Usually used for freeing resources that 42 | were used during async operations.} 43 | } 44 | \description{ 45 | Use the \code{then} function to access the eventual result of a promise (or, if the operation fails, the reason for that failure). Regardless of the state of the promise, the call to \code{then} is non-blocking, that is, it returns immediately; so what it does \emph{not} do is immediately return the result value of the promise. Instead, you pass logic you want to execute to \code{then}, in the form of function callbacks (or formulas, see Details). If you provide an \code{onFulfilled} callback, it will be called upon the promise's successful resolution, with a single argument \code{value}: the result value. If you provide an \code{onRejected} callback, it will be called if the operation fails, with a single argument \code{reason}: the error that caused the failure. 46 | } 47 | \section{Formulas}{ 48 | 49 | 50 | For convenience, the \code{then()}, \code{catch()}, and \code{finally()} functions use 51 | \code{\link[rlang:as_function]{rlang::as_function()}} to convert \code{onFulfilled}, \code{onRejected}, and 52 | \code{onFinally} arguments to functions. This means that you can use formulas to 53 | create very compact anonymous functions, using \code{.} to access the value (in 54 | the case of \code{onFulfilled}) or error (in the case of \code{onRejected}). 55 | } 56 | 57 | \section{Chaining promises}{ 58 | 59 | 60 | The first parameter of \code{then} is a promise; given the stated purpose of the 61 | function, this should be no surprise. However, what may be surprising is that 62 | the return value of \code{then} is also a (newly created) promise. This new 63 | promise waits for the original promise to be fulfilled or rejected, and for 64 | \code{onFulfilled} or \code{onRejected} to be called. The result of (or error raised 65 | by) calling \code{onFulfilled}/\code{onRejected} will be used to fulfill (reject) the 66 | new promise. 67 | 68 | \if{html}{\out{
}}\preformatted{promise_a <- get_data_frame_async() 69 | promise_b <- then(promise_a, onFulfilled = head) 70 | }\if{html}{\out{
}} 71 | 72 | In this example, assuming \code{get_data_frame_async} returns a promise that 73 | eventually resolves to a data frame, \code{promise_b} will eventually resolve to 74 | the first 10 or fewer rows of that data frame. 75 | 76 | Note that the new promise is considered fulfilled or rejected based on 77 | whether \code{onFulfilled}/\code{onRejected} returns a value or throws an error, not on 78 | whether the original promise was fulfilled or rejected. In other words, it's 79 | possible to turn failure to success and success to failure. Consider this 80 | example, where we expect \code{some_async_operation} to fail, and want to consider 81 | it an error if it doesn't: 82 | 83 | \if{html}{\out{
}}\preformatted{promise_c <- some_async_operation() 84 | promise_d <- then(promise_c, 85 | onFulfilled = function(value) \{ 86 | stop("That's strange, the operation didn't fail!") 87 | \}, 88 | onRejected = function(reason) \{ 89 | # Great, the operation failed as expected 90 | NULL 91 | \} 92 | ) 93 | }\if{html}{\out{
}} 94 | 95 | Now, \code{promise_d} will be rejected if \code{promise_c} is fulfilled, and vice 96 | versa. 97 | 98 | \strong{Warning:} Be very careful not to accidentally turn failure into success, 99 | if your error handling code is not the last item in a chain! 100 | 101 | \if{html}{\out{
}}\preformatted{some_async_operation() \%>\% 102 | catch(function(reason) \{ 103 | warning("An error occurred: ", reason) 104 | \}) \%>\% 105 | then(function() \{ 106 | message("I guess we succeeded...?") # No! 107 | \}) 108 | }\if{html}{\out{
}} 109 | 110 | In this example, the \code{catch} callback does not itself throw an error, so the 111 | subsequent \code{then} call will consider its promise fulfilled! 112 | } 113 | 114 | \section{Convenience functions}{ 115 | 116 | 117 | For readability and convenience, we provide \code{catch} and \code{finally} functions. 118 | 119 | The \code{catch} function is equivalent to \code{then}, but without the \code{onFulfilled} 120 | argument. It is typically used at the end of a promise chain to perform error 121 | handling/logging. 122 | 123 | The \code{finally} function is similar to \code{then}, but takes a single no-argument 124 | function (or formula) that will be executed upon completion of the promise, 125 | regardless of whether the result is success or failure. It is typically used 126 | at the end of a promise chain to perform cleanup tasks, like closing file 127 | handles or database connections. Unlike \code{then} and \code{catch}, the return value 128 | of \code{finally} is ignored; however, if an error is thrown in \code{finally}, that 129 | error will be propagated forward into the returned promise. 130 | } 131 | 132 | \section{Visibility}{ 133 | 134 | 135 | \code{onFulfilled} functions can optionally have a second parameter \code{visible}, 136 | which will be \code{FALSE} if the result value is \link[base:invisible]{invisible}. 137 | } 138 | 139 | -------------------------------------------------------------------------------- /man/with_promise_domain.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/domains.R 3 | \name{with_promise_domain} 4 | \alias{with_promise_domain} 5 | \alias{new_promise_domain} 6 | \title{Promise domains} 7 | \usage{ 8 | with_promise_domain(domain, expr, replace = FALSE) 9 | 10 | new_promise_domain( 11 | wrapOnFulfilled = identity, 12 | wrapOnRejected = identity, 13 | wrapSync = force, 14 | onError = force, 15 | ..., 16 | wrapOnFinally = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{domain}{A promise domain object to install while \code{expr} is evaluated.} 21 | 22 | \item{expr}{Any R expression, to be evaluated under the influence of 23 | \code{domain}.} 24 | 25 | \item{replace}{If \code{FALSE}, then the effect of the \code{domain} will be added 26 | to the effect of any currently active promise domain(s). If \code{TRUE}, then 27 | the current promise domain(s) will be ignored for the duration of the 28 | \code{with_promise_domain} call.} 29 | 30 | \item{wrapOnFulfilled}{A function that takes a single argument: a function 31 | that was passed as an \code{onFulfilled} argument to \code{\link[=then]{then()}}. The 32 | \code{wrapOnFulfilled} function should return a function that is suitable for 33 | \code{onFulfilled} duty.} 34 | 35 | \item{wrapOnRejected}{A function that takes a single argument: a function 36 | that was passed as an \code{onRejected} argument to \code{\link[=then]{then()}}. The 37 | \code{wrapOnRejected} function should return a function that is suitable for 38 | \code{onRejected} duty.} 39 | 40 | \item{wrapSync}{A function that takes a single argument: a (lazily evaluated) 41 | expression that the function should \code{\link[=force]{force()}}. This expression represents 42 | the \code{expr} argument passed to \code{\link[=with_promise_domain]{with_promise_domain()}}; \code{wrapSync} allows 43 | the domain to manipulate the environment before/after \code{expr} is evaluated.} 44 | 45 | \item{onError}{A function that takes a single argument: an error. \code{onError} 46 | will be called whenever an exception occurs in a domain (that isn't caught 47 | by a \code{tryCatch}). Providing an \code{onError} callback doesn't cause errors to 48 | be caught, necessarily; instead, \code{onError} callbacks behave like calling 49 | handlers.} 50 | 51 | \item{...}{Arbitrary named values that will become elements of the promise 52 | domain object, and can be accessed as items in an environment (i.e. using 53 | \code{[[} or \code{$}).} 54 | 55 | \item{wrapOnFinally}{A function that takes a single argument: a function 56 | that was passed as an \code{onFinally} argument to \code{\link[=then]{then()}}. The 57 | \code{wrapOnFinally} function should return a function that is suitable for 58 | \code{onFinally} duty. If \code{wrapOnFinally} is \code{NULL} (the default), then the 59 | domain will use both \code{wrapOnFulfilled} and \code{wrapOnRejected} to wrap the 60 | \code{onFinally}. If it's important to distinguish between normal 61 | fulfillment/rejection handlers and finally handlers, then be sure to 62 | provide \code{wrapOnFinally}, even if it's just \code{\link[base:identity]{base::identity()}}.} 63 | } 64 | \description{ 65 | Promise domains are used to temporarily set up custom environments that 66 | intercept and influence the registration of callbacks. Create new promise 67 | domain objects using \code{new_promise_domain}, and temporarily activate a promise 68 | domain object (for the duration of evaluating a given expression) using 69 | \code{with_promise_domain}. 70 | } 71 | \details{ 72 | While \code{with_promise_domain} is on the call stack, any calls to \code{\link[=then]{then()}} (or 73 | higher level functions or operators, like \code{\link[=catch]{catch()}} or the various \link{pipes}) 74 | will belong to the promise domain. In addition, when a \code{then} callback that 75 | belongs to a promise domain is invoked, then any new calls to \code{then} will 76 | also belong to that promise domain. In other words, a promise domain 77 | "infects" not only the immediate calls to \code{then}, but also to "nested" calls 78 | to \code{then}. 79 | 80 | For more background, read the 81 | \href{https://gist.github.com/jcheng5/b1c87bb416f6153643cd0470ac756231}{original design doc}. 82 | 83 | For examples, see the source code of the Shiny package, which uses promise 84 | domains extensively to manage graphics devices and reactivity. 85 | } 86 | -------------------------------------------------------------------------------- /promises.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --as-cran --run-donttest 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | data.sqlite 2 | *.noindex 3 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:---------------------------------| 5 | |version |R version 4.3.2 (2023-10-31) | 6 | |os |macOS 15.1 | 7 | |system |aarch64, darwin20 | 8 | |ui |X11 | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |America/Los_Angeles | 13 | |date |2024-11-25 | 14 | |pandoc |2.19.2 @ /opt/homebrew/bin/pandoc | 15 | 16 | # Dependencies 17 | 18 | |package |old |new |Δ | 19 | |:--------|:-----|:-----|:--| 20 | |promises |1.3.0 |1.3.1 |* | 21 | 22 | # Revdeps 23 | 24 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 31 reverse dependencies (29 from CRAN + 2 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | 6 | using namespace Rcpp; 7 | 8 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 9 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 10 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 11 | #endif 12 | 13 | // asyncFib 14 | void asyncFib(Rcpp::Function resolve, Rcpp::Function reject, double x); 15 | RcppExport SEXP _promises_asyncFib(SEXP resolveSEXP, SEXP rejectSEXP, SEXP xSEXP) { 16 | BEGIN_RCPP 17 | Rcpp::RNGScope rcpp_rngScope_gen; 18 | Rcpp::traits::input_parameter< Rcpp::Function >::type resolve(resolveSEXP); 19 | Rcpp::traits::input_parameter< Rcpp::Function >::type reject(rejectSEXP); 20 | Rcpp::traits::input_parameter< double >::type x(xSEXP); 21 | asyncFib(resolve, reject, x); 22 | return R_NilValue; 23 | END_RCPP 24 | } 25 | 26 | static const R_CallMethodDef CallEntries[] = { 27 | {"_promises_asyncFib", (DL_FUNC) &_promises_asyncFib, 3}, 28 | {NULL, NULL, 0} 29 | }; 30 | 31 | RcppExport void R_init_promises(DllInfo *dll) { 32 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 33 | R_useDynamicSymbols(dll, FALSE); 34 | } 35 | -------------------------------------------------------------------------------- /src/promise_task.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | class PromiseTask : public later::BackgroundTask { 5 | public: 6 | PromiseTask(Rcpp::Function resolve, Rcpp::Function reject) : 7 | resolve(resolve), reject(reject) { 8 | } 9 | 10 | protected: 11 | virtual void execute() = 0; 12 | virtual Rcpp::RObject get_result() = 0; 13 | 14 | void complete() { 15 | Rcpp::RObject result = get_result(); 16 | resolve(result); 17 | } 18 | private: 19 | Rcpp::Function resolve; 20 | Rcpp::Function reject; 21 | }; 22 | 23 | long fib(long x) { 24 | if (x <= 2) { 25 | return 1; 26 | } 27 | return fib(x-1) + fib(x-2); 28 | } 29 | 30 | class FibonacciTask : public PromiseTask { 31 | public: 32 | FibonacciTask(Rcpp::Function resolve, Rcpp::Function reject, double x) : 33 | PromiseTask(resolve, reject), x(x) { 34 | } 35 | 36 | void execute() { 37 | result = fib((long)x); 38 | } 39 | 40 | Rcpp::RObject get_result() { 41 | Rcpp::NumericVector res(1); 42 | res[0] = (double)result; 43 | return res; 44 | } 45 | 46 | private: 47 | double x; 48 | long result; 49 | }; 50 | 51 | // [[Rcpp::export]] 52 | void asyncFib(Rcpp::Function resolve, Rcpp::Function reject, double x) { 53 | FibonacciTask* fib = new FibonacciTask(resolve, reject, x); 54 | fib->begin(); 55 | } 56 | 57 | /*** R 58 | library(promises) 59 | library(later) 60 | library(Rcpp) 61 | 62 | promise(function(resolve, reject) { 63 | promise:::asyncFib(resolve, reject, 45) 64 | }) %...>% print() 65 | 66 | */ 67 | -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if (requireNamespace('spelling', quietly = TRUE)) 2 | spelling::spell_check_test( 3 | vignettes = TRUE, 4 | error = TRUE, 5 | skip_on_cran = TRUE 6 | ) 7 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview 7 | # * https://testthat.r-lib.org/articles/special-files.html 8 | 9 | library(testthat) 10 | library(promises) 11 | 12 | test_check("promises") 13 | -------------------------------------------------------------------------------- /tests/testthat/common.R: -------------------------------------------------------------------------------- 1 | library(later) 2 | 3 | on_ci <- isTRUE(as.logical(Sys.getenv("CI"))) 4 | 5 | # Create a promise that can be EXTernally resolved/rejected/inspected 6 | ext_promise <- function() { 7 | res <- NULL 8 | p <- promise(function(resolve, reject) { 9 | res <<- list(resolve = resolve, reject = reject) 10 | }) 11 | 12 | list( 13 | promise = p, 14 | resolve = res$resolve, 15 | reject = res$reject, 16 | status = attr(p, "promise_impl", exact = TRUE)$status 17 | ) 18 | } 19 | 20 | # Block until all pending later tasks have executed 21 | # wait_for_it <- function(timeout = if (on_ci) 60 else 30) { 22 | wait_for_it <- function(p = NULL, timeout = if (on_ci) 60 else 30) { 23 | start <- Sys.time() 24 | 25 | err <- NULL 26 | if (!is.null(p)) { 27 | p %...!% (function(reason) err <<- reason) 28 | } 29 | 30 | while (!loop_empty()) { 31 | if (difftime(Sys.time(), start, units = "secs") > timeout) { 32 | stop("Waited too long") 33 | } 34 | run_now() 35 | Sys.sleep(0.01) 36 | } 37 | 38 | if (!is.null(err)) { 39 | withRestarts( 40 | stop(err), 41 | continue_test = function(e) NULL 42 | ) 43 | } 44 | } 45 | 46 | # Block until the promise is resolved/rejected. If resolved, return the value. 47 | # If rejected, throw (yes throw, not return) the error. 48 | extract <- function(promise) { 49 | promise_value <- NULL 50 | 51 | promise %...>% 52 | (function(value) promise_value <<- value) %>% 53 | wait_for_it() 54 | 55 | promise_value 56 | } 57 | 58 | resolve_later <- function(value, delaySecs) { 59 | force(value) 60 | promise(~ later::later(~ resolve(value), delaySecs)) 61 | } 62 | 63 | # Prevent "Unhandled promise error" warning that happens if you don't handle the 64 | # rejection of a promise 65 | squelch_unhandled_promise_error <- function(promise) { 66 | promise %...!% 67 | (function(reason) { 68 | if (inherits(reason, "failure")) { 69 | # Don't squelch test failures 70 | stop(reason) 71 | } 72 | }) 73 | } 74 | 75 | .GlobalEnv$.Last <- function() { 76 | # Detect unexpected "Unhandled promise error" warnings. 77 | wait_for_it() 78 | } 79 | 80 | create_counting_domain <- function(trackFinally = FALSE) { 81 | counts <- list2env( 82 | parent = emptyenv(), 83 | list( 84 | onFulfilledBound = 0L, 85 | onFulfilledCalled = 0L, 86 | onFulfilledActive = 0L, 87 | onRejectedBound = 0L, 88 | onRejectedCalled = 0L, 89 | onRejectedActive = 0L 90 | ) 91 | ) 92 | 93 | incr <- function(field) { 94 | field <- as.character(substitute(field)) 95 | counts[[field]] <- counts[[field]] + 1L 96 | } 97 | 98 | decr <- function(field) { 99 | field <- as.character(substitute(field)) 100 | counts[[field]] <- counts[[field]] - 1L 101 | } 102 | 103 | pd <- new_promise_domain( 104 | wrapOnFulfilled = function(onFulfilled) { 105 | incr(onFulfilledBound) 106 | function(...) { 107 | incr(onFulfilledCalled) 108 | incr(onFulfilledActive) 109 | on.exit(decr(onFulfilledActive)) 110 | 111 | onFulfilled(...) 112 | } 113 | }, 114 | wrapOnRejected = function(onRejected) { 115 | incr(onRejectedBound) 116 | function(...) { 117 | incr(onRejectedCalled) 118 | incr(onRejectedActive) 119 | on.exit(decr(onRejectedActive)) 120 | 121 | onRejected(...) 122 | } 123 | }, 124 | counts = counts 125 | ) 126 | 127 | if (trackFinally) { 128 | counts$onFinallyBound <- 0L 129 | counts$onFinallyCalled <- 0L 130 | counts$onFinallyActive <- 0L 131 | 132 | pd$wrapOnFinally <- function(onFinally) { 133 | incr(onFinallyBound) 134 | function() { 135 | incr(onFinallyCalled) 136 | incr(onFinallyActive) 137 | on.exit(incr(onFinallyActive)) 138 | 139 | onFinally() 140 | } 141 | } 142 | } 143 | 144 | pd 145 | } 146 | -------------------------------------------------------------------------------- /tests/testthat/test-aplus-2-1.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | describe("2.1. Promise States", { 6 | describe("2.1.1. When pending, a promise:", { 7 | it("2.1.1.1. may transition to either the fulfilled or rejected state.", { 8 | a <- ext_promise() 9 | expect_identical(a$status(), "pending") 10 | a$resolve(0) 11 | expect_identical(a$status(), "fulfilled") 12 | 13 | b <- ext_promise() 14 | expect_identical(b$status(), "pending") 15 | squelch_unhandled_promise_error(b$promise) 16 | b$reject("err") 17 | expect_identical(b$status(), "rejected") 18 | }) 19 | }) 20 | 21 | describe("2.1.2. When fulfilled, a promise:", { 22 | it("2.1.2.1. must not transition to any other state.", { 23 | a <- ext_promise() 24 | a$resolve(TRUE) 25 | expect_identical(a$status(), "fulfilled") 26 | a$reject("err") 27 | expect_identical(a$status(), "fulfilled") 28 | }) 29 | it("2.1.2.2. must have a value, which must not change.", { 30 | a <- ext_promise() 31 | a$resolve(TRUE) 32 | expect_identical(a$status(), "fulfilled") 33 | a$resolve(FALSE) 34 | expect_identical(extract(a$promise), TRUE) 35 | }) 36 | }) 37 | 38 | describe("2.1.3. When rejected, a promise:", { 39 | it("2.1.3.1. must not transition to any other state.", { 40 | a <- ext_promise() 41 | squelch_unhandled_promise_error(a$promise) 42 | a$reject("err") 43 | expect_identical(a$status(), "rejected") 44 | a$resolve(TRUE) 45 | expect_identical(a$status(), "rejected") 46 | }) 47 | it("2.1.3.2. must have a reason, which must not change.", { 48 | a <- ext_promise() 49 | a$reject("err1") 50 | expect_identical(a$status(), "rejected") 51 | a$reject("err2") 52 | expect_error(extract(a$promise), "err1") 53 | }) 54 | }) 55 | }) 56 | -------------------------------------------------------------------------------- /tests/testthat/test-aplus-2-2.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | describe("2.2. The `then` Method", { 6 | # A promise must provide a `then` method to access its current or eventual 7 | # value or reason. 8 | # 9 | # A promise’s then method accepts two arguments: 10 | # promise.then(onFulfilled, onRejected) 11 | 12 | describe("2.2.1. Both onFulfilled and onRejected are optional arguments:", { 13 | it("2.2.1.1. If onFulfilled is not a function, it must be ignored.", { 14 | # NOTE: This behavior varies; we throw an error 15 | # p <- promise(~resolve(10)) %>% then(20) 16 | # expect_identical(extract(p), 10) 17 | }) 18 | it("2.2.1.1. If onRejected is not a function, it must be ignored.", { 19 | # NOTE: This behavior varies; we throw an error 20 | # p <- promise(~reject("foo")) %>% then(onRejected = "bar") 21 | # expect_error(extract(p), "foo") 22 | }) 23 | }) 24 | 25 | describe("2.2.2. If onFulfilled is a function:", { 26 | it("2.2.2.1. it must be called after promise is fulfilled, with promise’s value as its first argument.", { 27 | x <- NULL 28 | p <- ext_promise() 29 | 30 | p$promise %>% 31 | then(function(value) { 32 | x <<- value 33 | }) %>% 34 | wait_for_it() 35 | expect_identical(x, NULL) 36 | 37 | p$resolve(10) %>% wait_for_it() 38 | expect_identical(x, 10) 39 | }) 40 | it("2.2.2.2. it must not be called before promise is fulfilled.", { 41 | }) 42 | it("2.2.2.3. it must not be called more than once.", { 43 | }) 44 | }) 45 | describe("2.2.3. If onRejected is a function,", { 46 | it("2.2.3.1. it must be called after promise is rejected, with promise’s reason as its first argument.", { 47 | x <- NULL 48 | p <- ext_promise() 49 | 50 | p$promise %>% 51 | then(onRejected = function(reason) { 52 | x <<- reason 53 | }) %>% 54 | wait_for_it() 55 | expect_identical(x, NULL) 56 | 57 | p$reject(simpleError("boom")) 58 | wait_for_it() 59 | expect_identical(x, simpleError("boom")) 60 | }) 61 | }) 62 | describe("2.2.4. onFulfilled or onRejected must not be called until the execution context stack contains only platform code. [3.1].", { 63 | it(" ", { 64 | x <- NULL 65 | p <- promise(~ resolve(TRUE)) %>% 66 | then(function(value) { 67 | x <<- value 68 | }) 69 | expect_identical(x, NULL) 70 | p %>% wait_for_it() 71 | expect_identical(x, TRUE) 72 | }) 73 | }) 74 | describe("2.2.5. onFulfilled and onRejected must be called as functions (i.e. with no this value). [3.2]", { 75 | # Not relevant for R. 76 | }) 77 | describe("2.2.6. `then` may be called multiple times on the same promise.", { 78 | it("2.2.6.1. If/when promise is fulfilled, all respective onFulfilled callbacks must execute in the order of their originating calls to then.", { 79 | p <- ext_promise() 80 | callbacks_called <- 0L 81 | results <- new.env(parent = emptyenv()) 82 | 83 | all_promises <- lapply(1:10, function(i) { 84 | results[[as.character(i)]] <- p$promise %>% 85 | then(function(value) { 86 | callbacks_called <<- callbacks_called + 1L 87 | expect_identical(callbacks_called, i) 88 | value 89 | }) 90 | }) 91 | 92 | p$resolve(cars) 93 | promise_all(.list = all_promises) %>% wait_for_it() 94 | 95 | lapply(as.list(results), function(x) { 96 | expect_identical(extract(x), cars) 97 | }) 98 | }) 99 | }) 100 | 101 | describe("2.2.6.2. If/when promise is rejected, all respective onRejected callbacks must execute in the order of their originating calls to then.", { 102 | p <- ext_promise() 103 | callbacks_called <- 0L 104 | results <- new.env(parent = emptyenv()) 105 | 106 | all_promises <- lapply(1:10, function(i) { 107 | results[[as.character(i)]] <- p$promise %>% 108 | catch(function(err) { 109 | callbacks_called <<- callbacks_called + 1L 110 | expect_identical(callbacks_called, i) 111 | err 112 | }) 113 | }) 114 | 115 | p$reject(simpleError("an error")) 116 | promise_all(.list = all_promises) %>% wait_for_it() 117 | 118 | lapply(as.list(results), function(x) { 119 | expect_identical(extract(x), simpleError("an error")) 120 | }) 121 | }) 122 | 123 | describe("2.2.7. `then` must return a promise [3.3].", { 124 | it(" ", { 125 | promise( 126 | ~ { 127 | } 128 | ) %>% 129 | then() %>% 130 | is.promise() %>% 131 | expect_true() 132 | }) 133 | 134 | it("2.2.7.1. If either onFulfilled or onRejected returns a value x, run the Promise Resolution Procedure [[Resolve]](promise2, x).", { 135 | p1 <- promise(~ resolve(TRUE)) %>% then(~"foo") 136 | expect_identical(extract(p1), "foo") 137 | 138 | p2 <- promise(~ reject("boom")) %>% catch(~"bar") 139 | expect_identical(extract(p2), "bar") 140 | }) 141 | 142 | it("2.2.7.2. If either onFulfilled or onRejected throws an exception e, promise2 must be rejected with e as the reason.", { 143 | p1 <- promise(~ resolve(TRUE)) %>% then(~ stop("foo")) 144 | expect_error(extract(p1), "^foo$") 145 | 146 | p2 <- promise(~ reject("boom")) %>% catch(~ stop("bar")) 147 | expect_error(extract(p2), "^bar$") 148 | }) 149 | 150 | it("2.2.7.3. If onFulfilled is not a function and promise1 is fulfilled, promise2 must be fulfilled with the same value as promise1.", { 151 | p <- promise(~ resolve("baz")) %>% then() 152 | expect_identical(extract(p), "baz") 153 | }) 154 | 155 | it("2.2.7.4. If onRejected is not a function and promise1 is rejected, promise2 must be rejected with the same reason as promise1.", { 156 | p <- promise(~ reject("qux")) %>% then() 157 | expect_error(extract(p), "^qux$") 158 | }) 159 | }) 160 | }) 161 | -------------------------------------------------------------------------------- /tests/testthat/test-aplus-2-3.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | # 2.3. The Promise Resolution Procedure 6 | 7 | describe("2.3.1. If promise and x refer to the same object, reject promise with a TypeError as the reason.", { 8 | it(" ", { 9 | p <- ext_promise() 10 | p$resolve(p$promise) 11 | expect_error(extract(p$promise), "^Chaining cycle detected for promise$") 12 | }) 13 | }) 14 | 15 | describe("2.3.2. If x is a promise, adopt its state [3.4]:", { 16 | it("2.3.2.1. If x is pending, promise must remain pending until x is fulfilled or rejected.", { 17 | p <- ext_promise() 18 | x <- ext_promise() 19 | p$resolve(x$promise) 20 | wait_for_it() 21 | expect_identical(x$status(), "pending") 22 | expect_identical(p$status(), "pending") 23 | }) 24 | it("2.3.2.2. If/when x is fulfilled, fulfill promise with the same value.", { 25 | p <- ext_promise() 26 | x <- ext_promise() 27 | p$resolve(x$promise) 28 | wait_for_it() 29 | expect_identical(x$status(), "pending") 30 | expect_identical(p$status(), "pending") 31 | x$resolve(100) 32 | expect_identical(extract(x$promise), 100) 33 | expect_identical(extract(p$promise), 100) 34 | }) 35 | it("2.3.2.3. If/when x is rejected, reject promise with the same reason.", { 36 | p <- ext_promise() 37 | x <- ext_promise() 38 | p$resolve(x$promise) 39 | wait_for_it() 40 | expect_identical(x$status(), "pending") 41 | expect_identical(p$status(), "pending") 42 | squelch_unhandled_promise_error(p$promise) 43 | x$reject("bad") 44 | expect_error(extract(x$promise), "^bad$") 45 | expect_error(extract(p$promise), "^bad$") 46 | }) 47 | }) 48 | # 2.3.3. Otherwise, if x is an object or function, 49 | # 2.3.3.1. Let then be x.then. [3.5] 50 | # 2.3.3.2. If retrieving the property x.then results in a thrown exception e, reject promise with e as the reason. 51 | # 2.3.3.3. If then is a function, call it with x as this, first argument resolvePromise, and second argument rejectPromise, where: 52 | # 2.3.3.3.1. If/when resolvePromise is called with a value y, run [[Resolve]](promise, y). 53 | # 2.3.3.3.2. If/when rejectPromise is called with a reason r, reject promise with r. 54 | # 2.3.3.3.3. If both resolvePromise and rejectPromise are called, or multiple calls to the same argument are made, the first call takes precedence, and any further calls are ignored. 55 | # 2.3.3.3.4. If calling then throws an exception e, 56 | # 2.3.3.3.4.1. If resolvePromise or rejectPromise have been called, ignore it. 57 | # 2.3.3.3.4.2. Otherwise, reject promise with e as the reason. 58 | # 2.3.3.4. If then is not a function, fulfill promise with x. 59 | describe("2.3.4. If x is not an object or function, fulfill promise with x.", { 60 | it(" ", { 61 | p <- ext_promise() 62 | p$resolve(10) 63 | expect_identical(extract(p$promise), 10) 64 | }) 65 | }) 66 | -------------------------------------------------------------------------------- /tests/testthat/test-combining.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | describe("promise_all", { 6 | it("preserves element ordering", { 7 | a <- resolve_later(1, 0.5) 8 | b <- resolve_later(2, 0.3) 9 | c <- resolve_later(3, 0.1) 10 | 11 | x <- promise_all(.list = list(a = a, b = b, c = c)) 12 | expect_identical(extract(x), list(a = 1, b = 2, c = 3)) 13 | }) 14 | 15 | it("Handles NULLs correctly", { 16 | x <- promise_all( 17 | promise_resolve(NULL), 18 | promise_resolve(NULL), 19 | promise_resolve(NULL) 20 | ) 21 | expect_identical(extract(x), list(NULL, NULL, NULL)) 22 | 23 | x <- promise_all( 24 | a = promise_resolve(NULL), 25 | b = promise_resolve(NULL), 26 | c = promise_resolve(NULL) 27 | ) 28 | expect_identical(extract(x), list(a = NULL, b = NULL, c = NULL)) 29 | }) 30 | }) 31 | -------------------------------------------------------------------------------- /tests/testthat/test-cpp.R: -------------------------------------------------------------------------------- 1 | describe("C++ interface", { 2 | it("basically works", { 3 | promise(function(resolve, reject) { 4 | asyncFib(resolve, reject, 3) 5 | }) %...>% 6 | { 7 | expect_identical(., 2) 8 | } %>% 9 | wait_for_it() 10 | }) 11 | 12 | it("works with domains", { 13 | cd <- create_counting_domain() 14 | 15 | expect_true(is.null(current_promise_domain())) 16 | with_promise_domain(cd, { 17 | promise(function(resolve, reject) { 18 | asyncFib(resolve, reject, 3) 19 | }) %...>% 20 | { 21 | expect_identical(., 2) 22 | expect_identical(cd$counts$onFulfilledCalled, 1L) 23 | promise_resolve(TRUE) %...>% 24 | { 25 | expect_true(!is.null(current_promise_domain())) 26 | expect_identical(cd$counts$onFulfilledCalled, 2L) 27 | } 28 | } %>% 29 | wait_for_it() 30 | }) 31 | }) 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-domains.R: -------------------------------------------------------------------------------- 1 | source("common.R") 2 | 3 | async_true <- function() { 4 | promise_resolve(TRUE) 5 | } 6 | 7 | describe("Promise domains", { 8 | it("are reentered during handlers", { 9 | cd <- create_counting_domain(trackFinally = TRUE) 10 | p <- with_promise_domain(cd, { 11 | async_true() %...>% 12 | { 13 | expect_identical(cd$counts$onFulfilledCalled, 1L) 14 | expect_identical(cd$counts$onFulfilledActive, 1L) 15 | 10 # sync result 16 | } %...>% 17 | { 18 | expect_identical(cd$counts$onFulfilledCalled, 2L) 19 | expect_identical(cd$counts$onFulfilledActive, 1L) 20 | promise_resolve(20) # async result 21 | } 22 | }) 23 | 24 | expect_identical(cd$counts$onFulfilledBound, 2L) 25 | 26 | p <- p %...>% 27 | { 28 | expect_identical(cd$counts$onFulfilledCalled, 2L) 29 | expect_identical(cd$counts$onFulfilledActive, 0L) 30 | } 31 | 32 | expect_identical(cd$counts$onFulfilledBound, 2L) 33 | p %>% wait_for_it() 34 | 35 | with_promise_domain(cd, { 36 | p <- async_true() %>% 37 | finally( 38 | ~ { 39 | expect_identical(cd$counts$onFinallyCalled, 1L) 40 | expect_identical(cd$counts$onFinallyActive, 1L) 41 | } 42 | ) 43 | expect_identical(cd$counts$onFinallyBound, 1L) 44 | 45 | expect_identical(cd$counts$onFulfilledBound, 2L) 46 | expect_identical(cd$counts$onRejectedBound, 0L) 47 | 48 | p %>% wait_for_it() 49 | }) 50 | 51 | expect_identical(cd$counts$onFulfilledBound, 2L) 52 | 53 | with_promise_domain(cd, { 54 | p <- async_true() %...>% 55 | { 56 | expect_identical(., TRUE) 57 | expect_identical(cd$counts$onFulfilledCalled, 3L) 58 | ten <- 10 59 | # This tests if promise domain membership infects subscriptions made 60 | # in handlers. 61 | promise_resolve(invisible(ten)) %...>% 62 | (function(value, .visible) { 63 | expect_identical(value, 10) 64 | expect_false(.visible) 65 | expect_true(!is.null(current_promise_domain())) 66 | expect_identical(cd$counts$onFulfilledCalled, 4L) 67 | }) 68 | } 69 | }) 70 | 71 | expect_true(is.null(current_promise_domain())) 72 | expect_identical(cd$counts$onFulfilledCalled, 2L) 73 | 74 | p %>% wait_for_it() 75 | }) 76 | 77 | it("pass finally binding to fulfill/reject by default", { 78 | cd1 <- create_counting_domain(trackFinally = FALSE) 79 | 80 | with_promise_domain(cd1, { 81 | p1 <- async_true() %>% 82 | finally( 83 | ~ { 84 | expect_identical(cd1$counts$onFulfilledActive, 1L) 85 | expect_identical(cd1$counts$onRejectedActive, 0L) 86 | } 87 | ) 88 | expect_identical(cd1$counts$onFulfilledBound, 1L) 89 | expect_identical(cd1$counts$onRejectedBound, 1L) 90 | p1 %>% wait_for_it() 91 | expect_identical(cd1$counts$onFulfilledCalled, 1L) 92 | expect_identical(cd1$counts$onRejectedCalled, 0L) 93 | }) 94 | 95 | cd2 <- create_counting_domain(trackFinally = FALSE) 96 | 97 | p2 <- with_promise_domain(cd2, { 98 | promise_reject("a problem") %>% 99 | finally( 100 | ~ { 101 | expect_identical(cd2$counts$onFulfilledActive, 0L) 102 | expect_identical(cd2$counts$onRejectedActive, 1L) 103 | } 104 | ) 105 | }) %>% 106 | squelch_unhandled_promise_error() 107 | 108 | expect_identical(cd2$counts$onFulfilledBound, 1L) 109 | expect_identical(cd2$counts$onRejectedBound, 1L) 110 | p2 %>% wait_for_it() 111 | expect_identical(cd2$counts$onFulfilledCalled, 0L) 112 | expect_identical(cd2$counts$onRejectedCalled, 1L) 113 | }) 114 | 115 | it("doesn't intercept fulfill/reject on finally, if finally is explicitly intercepted", { 116 | cd1 <- create_counting_domain(trackFinally = TRUE) 117 | 118 | with_promise_domain(cd1, { 119 | p1 <- async_true() %>% 120 | finally( 121 | ~ { 122 | expect_identical(cd1$counts$onFinallyActive, 1L) 123 | expect_identical(cd1$counts$onFulfilledActive, 0L) 124 | expect_identical(cd1$counts$onRejectedActive, 0L) 125 | } 126 | ) 127 | expect_identical(cd1$counts$onFinallyBound, 1L) 128 | expect_identical(cd1$counts$onFulfilledBound, 0L) 129 | expect_identical(cd1$counts$onRejectedBound, 0L) 130 | p1 %>% wait_for_it() 131 | expect_identical(cd1$counts$onFinallyCalled, 1L) 132 | expect_identical(cd1$counts$onFulfilledCalled, 0L) 133 | expect_identical(cd1$counts$onRejectedCalled, 0L) 134 | }) 135 | 136 | cd2 <- create_counting_domain(trackFinally = TRUE) 137 | 138 | p2 <- with_promise_domain(cd2, { 139 | promise_reject(TRUE) %>% 140 | finally( 141 | ~ { 142 | expect_identical(cd2$counts$onFinallyActive, 1L) 143 | expect_identical(cd2$counts$onFulfilledActive, 0L) 144 | expect_identical(cd2$counts$onRejectedActive, 0L) 145 | } 146 | ) 147 | }) %>% 148 | squelch_unhandled_promise_error() 149 | 150 | expect_identical(cd2$counts$onFinallyBound, 1L) 151 | expect_identical(cd2$counts$onFulfilledBound, 0L) 152 | expect_identical(cd2$counts$onRejectedBound, 0L) 153 | p2 %>% wait_for_it() 154 | expect_identical(cd2$counts$onFinallyCalled, 1L) 155 | expect_identical(cd2$counts$onFulfilledCalled, 0L) 156 | expect_identical(cd2$counts$onRejectedCalled, 0L) 157 | }) 158 | 159 | it("handles weird edge case relating to symbols", { 160 | # This test resulted from a bug in wrap_callback_reenter() where do.call()'s 161 | # default behavior of quote=FALSE would cause a resolved value that happens 162 | # to be a symbol, to be evaluated. This would only happen when a promise 163 | # domain was in effect, and the symbol was passed to an onFulfilled. Fixed 164 | # by using rlang::exec() instead of do.call(). 165 | cd <- create_counting_domain() 166 | with_promise_domain(cd, { 167 | promise_resolve(as.symbol("foo")) %...>% 168 | { 169 | expect_identical(., as.symbol("foo")) 170 | } %>% 171 | wait_for_it() 172 | }) 173 | }) 174 | 175 | it("executes wrap_callback_reenter handlers in the right lexical environment", { 176 | # No reason this shouldn't work, I haven't seen it fail, just making sure. 177 | cd <- create_counting_domain() 178 | x <- NULL 179 | with_promise_domain(cd, { 180 | promise_resolve(NULL) %...>% 181 | { 182 | x <<- 1L 183 | } %...>% 184 | { 185 | x <<- x + 1L 186 | } %>% 187 | wait_for_it() 188 | }) 189 | expect_identical(x, 2L) 190 | }) 191 | 192 | it("doesn't grow the call stack", { 193 | # See https://github.com/rstudio/promises/issues/114 194 | # and also https://github.com/jcheng5/shinychat/issues/16 195 | 196 | recursive_promise <- function(n, .last_callstack_depth = NULL) { 197 | if (n == 0) { 198 | return(0) 199 | } else { 200 | promise_resolve(TRUE) %...>% 201 | { 202 | current_callstack_depth <- length(sys.calls()) 203 | if (!is.null(.last_callstack_depth)) { 204 | expect_identical(current_callstack_depth, .last_callstack_depth) 205 | } 206 | 207 | recursive_promise( 208 | n - 1, 209 | .last_callstack_depth = current_callstack_depth 210 | ) 211 | } 212 | } 213 | } 214 | 215 | cd <- create_counting_domain() 216 | with_promise_domain(cd, { 217 | recursive_promise(5) %...>% 218 | { 219 | # 5 (from inside recursive_promise) + 1 (for the current handler) 220 | expect_identical(cd$counts$onFulfilledCalled, 6L) 221 | } %>% 222 | wait_for_it() 223 | }) 224 | 225 | cd2 <- create_counting_domain() 226 | p <- recursive_promise(5) 227 | with_promise_domain(cd2, { 228 | p %...>% 229 | { 230 | # This time, none of the ones inside recursive_promise count, since 231 | # they were bound outside of the influence of cd2 (even though they 232 | # are resolved within the influence of cd2, thanks to wait_for_it()). 233 | expect_identical(cd2$counts$onFulfilledCalled, 1L) 234 | } %>% 235 | wait_for_it() 236 | }) 237 | }) 238 | }) 239 | -------------------------------------------------------------------------------- /tests/testthat/test-methods.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | describe("then()", { 6 | it("honors .visible argument", { 7 | result <- NULL 8 | p <- promise(~ resolve(invisible(1))) %>% 9 | then(function(value, .visible) { 10 | result <<- list(value = value, visible = .visible) 11 | }) 12 | p %>% wait_for_it() 13 | expect_identical(result$value, 1) 14 | expect_identical(result$visible, FALSE) 15 | 16 | p <- promise(~ resolve(1)) %>% 17 | then(function(value, .visible) { 18 | result <<- list(value = value, visible = .visible) 19 | }) 20 | p %>% wait_for_it() 21 | expect_identical(result$value, 1) 22 | expect_identical(result$visible, TRUE) 23 | 24 | # .visible is preserved even with an intermediate then() or catch() 25 | p <- promise(~ resolve(invisible(1))) %>% 26 | then() %>% 27 | catch(~"what error?") %>% 28 | then(function(value, .visible) { 29 | result <<- list(value = value, visible = .visible) 30 | }) 31 | p %>% wait_for_it() 32 | expect_identical(result$value, 1) 33 | expect_identical(result$visible, FALSE) 34 | }) 35 | it("method ignores non-functions or NULL...", { 36 | p1 <- promise(~ resolve(1)) 37 | expect_warning( 38 | { 39 | p1 <- p1$then(10) 40 | }, 41 | "`onFulfilled` must be a function or `NULL`", 42 | fixed = TRUE 43 | ) 44 | expect_warning( 45 | { 46 | p1 <- p1$then(NULL) 47 | }, 48 | NA 49 | ) 50 | expect_identical(extract(p1), 1) 51 | }) 52 | it("...but function only ignores NULL, not non-functions", { 53 | expect_error(promise(~ resolve(1)) %>% then(10)) 54 | expect_error(promise(~ resolve(1)) %>% then(NULL), NA) 55 | }) 56 | 57 | it("honors visibility with no .visible argument", { 58 | result <- NULL 59 | p <- promise_resolve(invisible(1))$then(function(value) { 60 | result <<- withVisible(value) 61 | }) 62 | p %>% wait_for_it() 63 | expect_identical(result$value, 1) 64 | expect_identical(result$visible, FALSE) 65 | 66 | result <- NULL 67 | p <- promise_resolve(2)$then(function(value) { 68 | result <<- withVisible(value) 69 | }) 70 | p %>% wait_for_it() 71 | expect_identical(result$value, 2) 72 | expect_identical(result$visible, TRUE) 73 | }) 74 | }) 75 | 76 | describe("catch()", { 77 | it("catches", { 78 | p <- ext_promise() 79 | p2 <- p$promise %>% catch(~TRUE) 80 | p$reject("boom") 81 | expect_identical(extract(p2), TRUE) 82 | }) 83 | it("can throw", { 84 | p <- promise(~ stop("foo")) %>% catch(~ stop("bar")) 85 | expect_error(extract(p), "^bar$") 86 | }) 87 | it("method ignores non-functions or NULL...", { 88 | p1 <- promise(~ resolve(1)) 89 | expect_warning( 90 | { 91 | p1 <- p1$catch(10) 92 | }, 93 | "`onRejected` must be a function or `NULL`", 94 | fixed = TRUE 95 | ) 96 | expect_warning( 97 | { 98 | p1 <- p1$catch(NULL) 99 | }, 100 | NA 101 | ) 102 | expect_identical(extract(p1), 1) 103 | }) 104 | it("...but function only ignores NULL, not non-functions", { 105 | expect_error(promise(~ resolve(1)) %>% catch(10)) 106 | expect_error(promise(~ resolve(1)) %>% catch(NULL), NA) 107 | }) 108 | }) 109 | 110 | describe("finally()", { 111 | it("calls back when a promise is resolved", { 112 | called <- FALSE 113 | p <- promise(~ resolve(10)) %>% 114 | finally( 115 | ~ { 116 | called <<- TRUE 117 | } 118 | ) 119 | p %>% wait_for_it() 120 | expect_identical(called, TRUE) 121 | expect_identical(extract(p), 10) 122 | }) 123 | it("calls back when a promise is rejected", { 124 | called <- FALSE 125 | (p <- promise(~ reject("foobar")) %>% 126 | finally( 127 | ~ { 128 | called <<- TRUE 129 | } 130 | )) %>% 131 | squelch_unhandled_promise_error() %>% 132 | wait_for_it() 133 | expect_identical(called, TRUE) 134 | expect_error(extract(p), "^foobar$") 135 | }) 136 | it("does not affect the return value of the promise", { 137 | p1 <- promise(~ resolve(1)) %>% finally(~20) 138 | expect_identical(extract(p1), 1) 139 | 140 | p2 <- promise(~ reject("err")) %>% finally(~20) 141 | expect_error(extract(p2), "^err$") 142 | }) 143 | it("errors replace the result of the promise", { 144 | p1 <- promise(~ resolve(1)) %>% finally(~ stop("boom")) 145 | expect_error(extract(p1), "^boom$") 146 | 147 | p2 <- promise(~ reject("foo")) %>% finally(~ stop("bar")) 148 | expect_error(extract(p2), "^bar$") 149 | }) 150 | it("method ignores non-functions or NULL...", { 151 | p1 <- promise(~ resolve(1))$finally(10)$finally(NULL) 152 | expect_identical(extract(p1), 1) 153 | }) 154 | it("...but function only ignores NULL, not non-functions", { 155 | expect_error(promise(~ resolve(1)) %>% finally(10)) 156 | expect_error(promise(~ resolve(1)) %>% finally(NULL), NA) 157 | }) 158 | }) 159 | 160 | describe("future", { 161 | it("is treated as promise when used as resolution", { 162 | p <- promise_resolve(future::future(1)) 163 | expect_identical(extract(p), 1) 164 | 165 | p2 <- promise_resolve(future::future(stop("boom"))) 166 | expect_error(extract(p2)) 167 | }) 168 | 169 | it("is treated as promise when used as resolution", { 170 | p <- promise_reject(future::future(1)) 171 | expect_identical(extract(p), 1) 172 | 173 | p2 <- promise_reject(future::future(stop("boom"))) 174 | expect_error(extract(p2)) 175 | }) 176 | }) 177 | -------------------------------------------------------------------------------- /tests/testthat/test-visibility.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | source("common.R") 4 | 5 | describe("visibility", { 6 | single_fn <- function(value) { 7 | info <- withVisible(value) 8 | if (info$visible) { 9 | info$value 10 | } else { 11 | invisible(info$value) 12 | } 13 | } 14 | double_fn <- function(value, .visible) { 15 | if (.visible) value else invisible(value) 16 | } 17 | 18 | # display in block to avoid indent of doom 19 | for (add_catch in c("false", "single", "double", "expr")) { 20 | for (add_finally in c("false", "expr")) { 21 | for (add_then in c("false", "single", "double", "expr")) { 22 | it( 23 | paste0( 24 | "survives ", 25 | paste0( 26 | c( 27 | if (add_then != "false") paste0("then-", add_then), 28 | if (add_catch != "false") paste0("catch-", add_catch), 29 | if (add_finally != "false") paste0("finally-", add_finally), 30 | "then" 31 | ), 32 | collapse = ", " 33 | ) 34 | ), 35 | { 36 | p <- promise_resolve(invisible(1)) 37 | 38 | p <- 39 | switch( 40 | add_then, 41 | "false" = p, 42 | "single" = p %>% then(single_fn), 43 | "double" = p %>% then(double_fn), 44 | "expr" = p %>% 45 | then( 46 | ~ { 47 | info <- withVisible(.) 48 | if (info$visible) { 49 | info$value 50 | } else { 51 | invisible(info$value) 52 | } 53 | } 54 | ) 55 | ) 56 | p <- 57 | switch( 58 | add_catch, 59 | "false" = p, 60 | "single" = p %>% catch(single_fn), 61 | "double" = p %>% catch(double_fn), 62 | "expr" = p %>% 63 | catch( 64 | ~ { 65 | } 66 | ) 67 | ) 68 | 69 | finally_val <- NULL 70 | p <- 71 | switch( 72 | add_finally, 73 | "false" = p, 74 | "expr" = p %>% 75 | finally( 76 | ~ { 77 | finally_val <<- TRUE 78 | } 79 | ) 80 | ) 81 | 82 | extended_val <- 83 | p %>% 84 | then(function(value, .visible) { 85 | list(value = value, visible = .visible) 86 | }) %>% 87 | extract() 88 | 89 | regular_val <- 90 | p %>% 91 | then(function(value) { 92 | withVisible(value) 93 | }) %>% 94 | extract() 95 | 96 | if (add_finally != "false") { 97 | expect_true(finally_val) 98 | } 99 | 100 | expect_identical(extended_val$value, 1) 101 | expect_identical(extended_val$visible, FALSE) 102 | 103 | expect_identical(regular_val$value, 1) 104 | expect_identical(regular_val$visible, FALSE) 105 | } 106 | ) 107 | } 108 | } 109 | } 110 | }) 111 | -------------------------------------------------------------------------------- /tests/testthat/test-zzz-future_promise.R: -------------------------------------------------------------------------------- 1 | skip_on_cran() 2 | skip_on_os("windows") # timing is not consistent on Windows GHA 3 | 4 | skip_if_not_installed("future", "1.21.0") 5 | skip_if_not_installed("fastmap", "1.1.0") 6 | 7 | source(test_path("common.R")) 8 | 9 | local({ 10 | ## Setup ## 11 | 12 | n_workers <- 2 13 | # Set up a plan with 2 future workers 14 | with_test_workers <- function(code) { 15 | # (Can not use a variable for workers if in a local({})) 16 | old_plan <- future::plan(future::multisession(workers = 2)) 17 | on.exit( 18 | { 19 | future::plan(old_plan) 20 | }, 21 | add = TRUE 22 | ) 23 | 24 | force(code) 25 | } 26 | 27 | start <- Sys.time() 28 | time_diffs <- c() 29 | 30 | reset_baselines <- function() { 31 | start <<- Sys.time() 32 | time_diffs <<- c() 33 | } 34 | 35 | time_diff <- function() { 36 | difftime(Sys.time(), start, units = "secs") 37 | } 38 | 39 | # This function will print every `delay` seconds 40 | # The thing to notes is that the function will not execute unless the main R session is free 41 | # We should expect to see `run_every()` statements interleaved with `future_promise()` calls 42 | # We should NOT expect to see `run_every()` statements while `future::future()` is blocking the main R session 43 | run_every <- function(i = 0, max = 2 / delay, delay = 0.1) { 44 | if (i > max) return() 45 | time_diffs <<- c(time_diffs, time_diff()) 46 | # Do it again, later 47 | later::later( 48 | function() { 49 | run_every(i + 1, max = max, delay = delay) 50 | }, 51 | delay = delay 52 | ) 53 | } 54 | 55 | worker_jobs <- 8 56 | # allow for more time on CI (4s on CI vs 1s locally) 57 | worker_job_time <- if (on_ci) 4 else 1 58 | expected_total_time <- worker_jobs * worker_job_time / n_workers 59 | 60 | do_future_test <- function( 61 | prom_fn = future_promise, 62 | # Introduce extra future workers mid execution 63 | block_mid_session = FALSE, 64 | # expect that the average finish lag time is less than 2 * n_time 65 | expect_reasonable_exec_lag_time = TRUE, 66 | # expect the lapply to finish in less than 1s 67 | expect_immediate_lapply = TRUE, 68 | # expect `run_every()` delay to be < 1s (Expected 0.1s) 69 | expect_no_main_blocking = TRUE 70 | ) { 71 | with_test_workers({ 72 | # prep future sessions 73 | f1 <- future::future({ 74 | 1 75 | }) 76 | f2 <- future::future({ 77 | 2 78 | }) 79 | c(future::value(future::resolve(f1)), future::value(future::resolve(f2))) 80 | 81 | expect_true(future_worker_is_free()) 82 | expect_equal(future::nbrOfWorkers(), 2) 83 | expect_equal(future::nbrOfFreeWorkers(), 2) 84 | 85 | reset_baselines() 86 | run_every() 87 | 88 | future_exec_times <- c() 89 | if (block_mid_session) { 90 | # Have `future` block the main R session 1 second into execution 91 | lapply(seq_len(worker_jobs), function(i) { 92 | later::later( 93 | function() { 94 | future::future({ 95 | Sys.sleep(worker_job_time) 96 | time_diff() 97 | }) %...>% 98 | { 99 | future_exec_times <<- c(future_exec_times, .) 100 | } 101 | }, 102 | delay = 1 103 | ) 104 | }) 105 | } 106 | 107 | exec_times <- NA 108 | p <- lapply(seq_len(worker_jobs), function(i) { 109 | prom_fn({ 110 | Sys.sleep(worker_job_time) 111 | time_diff() 112 | }) 113 | }) %>% 114 | promise_all(.list = .) %...>% 115 | { 116 | exec_times <<- unlist(.) 117 | } 118 | post_lapply_time_diff <- time_diff() 119 | 120 | p %>% wait_for_it() 121 | 122 | # expect that the average time is less than the expected total time 123 | expect_equal(median(exec_times) < expected_total_time, !block_mid_session) 124 | 125 | # expect prom_fn to take a reasonable amount of time to finish 126 | exec_times_lag <- exec_times[-1] - exec_times[-length(exec_times)] 127 | expect_equal( 128 | all(exec_times_lag < (2 * worker_job_time)), 129 | expect_reasonable_exec_lag_time 130 | ) 131 | 132 | # post_lapply_time_diff should be ~ 0s 133 | expect_equal( 134 | post_lapply_time_diff < 135 | (worker_job_time * ((worker_jobs - n_workers) / n_workers)), 136 | expect_immediate_lapply 137 | ) 138 | 139 | # time_diffs should never grow by more than 1s; (Expected 0.1) 140 | time_diffs_lag <- time_diffs[-1] - time_diffs[-length(time_diffs)] 141 | expect_equal( 142 | all(time_diffs_lag < worker_job_time), 143 | expect_no_main_blocking 144 | ) 145 | }) 146 | } 147 | 148 | test_that("future_promise() allows the main thread to keep the main R process open", { 149 | do_future_test( 150 | prom_fn = future_promise, 151 | # expect that the average finish lag time is less than 2 * n_time 152 | expect_reasonable_exec_lag_time = TRUE, 153 | # expect the lapply to finish in less than 1s 154 | expect_immediate_lapply = TRUE, 155 | # expect `run_every()` delay to be < 1s (Expected 0.1s) 156 | expect_no_main_blocking = TRUE 157 | ) 158 | }) 159 | 160 | test_that("future::future() does not keep the main process open when all workers are busy", { 161 | do_future_test( 162 | prom_fn = future::future, 163 | # expect that the average finish lag time is less than 2 * n_time 164 | expect_reasonable_exec_lag_time = TRUE, 165 | # expect the lapply to finish after 1s 166 | expect_immediate_lapply = FALSE, 167 | # expect one `run_every()` delay to be >= 1s (Expected 0.1s) 168 | expect_no_main_blocking = FALSE 169 | ) 170 | }) 171 | 172 | test_that("future_promise() recovers from losing all future workers", { 173 | do_future_test( 174 | prom_fn = future_promise, 175 | block_mid_session = TRUE, 176 | # expect that the average finish lag time is less than 2 * n_time 177 | # b/c `future::future()` blocks the main R session, expect >=1 unreasonable lag time 178 | expect_reasonable_exec_lag_time = FALSE, 179 | # expect the lapply to finish in less than 1s 180 | expect_immediate_lapply = TRUE, 181 | # expect one `run_every()` delay to be >= 1s (Expected 0.1s) 182 | # b/c `future::future()` blocks the main R session, expect >=1 unreasonable lag time 183 | expect_no_main_blocking = FALSE 184 | ) 185 | }) 186 | 187 | test_that("future_promise reports unhandled errors", { 188 | with_test_workers({ 189 | err <- capture.output(type = "message", { 190 | future_promise(stop("boom1")) 191 | wait_for_it() 192 | }) 193 | expect_match(err, "boom1") 194 | }) 195 | }) 196 | 197 | test_that("future_promise doesn't report errors that have been handled", { 198 | with_test_workers({ 199 | err <- capture.output(type = "message", { 200 | future_promise(stop("boom1")) %>% 201 | then( 202 | onRejected = ~ { 203 | } 204 | ) %>% 205 | wait_for_it() 206 | }) 207 | expect_equal(err, character(0)) 208 | }) 209 | }) 210 | }) 211 | -------------------------------------------------------------------------------- /vignettes/case-study-downloaders.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-downloaders.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt-aligned.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt-aligned.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt-async.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt-async.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt-async2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt-async2.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt1.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt2.png -------------------------------------------------------------------------------- /vignettes/case-study-gantt3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-gantt3.png -------------------------------------------------------------------------------- /vignettes/case-study-react.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-react.png -------------------------------------------------------------------------------- /vignettes/case-study-tab1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-tab1.png -------------------------------------------------------------------------------- /vignettes/case-study-tab2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-tab2.png -------------------------------------------------------------------------------- /vignettes/case-study-tab3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-tab3.png -------------------------------------------------------------------------------- /vignettes/case-study-tab4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-tab4.png -------------------------------------------------------------------------------- /vignettes/case-study-tab5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/case-study-tab5.png -------------------------------------------------------------------------------- /vignettes/future_promise/blocked_future_promise.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/future_promise/blocked_future_promise.png -------------------------------------------------------------------------------- /vignettes/future_promise/future.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/future_promise/future.png -------------------------------------------------------------------------------- /vignettes/future_promise/future_promise_vignette.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/promises/7a870a898380235c7da3257fad66b1fc530342df/vignettes/future_promise/future_promise_vignette.key -------------------------------------------------------------------------------- /vignettes/future_promise/plots.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | 3 | receive_point <- function(y) { 4 | geom_point( 5 | mapping = aes(shape = shape), 6 | data = data.frame( 7 | x = 0, 8 | y = y, 9 | shape = "receive" 10 | ), 11 | size = 4 12 | ) 13 | } 14 | return_point <- function(x, y) { 15 | geom_point( 16 | mapping = aes(shape = shape), 17 | data = data.frame( 18 | x = x, 19 | y = y, 20 | shape = "return" 21 | ), 22 | size = 3 23 | ) 24 | } 25 | working_line <- function(x, y) { 26 | geom_line( 27 | mapping = aes(group = y, linetype = linetype), 28 | data = data.frame( 29 | x = x, 30 | y = y, 31 | linetype = "working" 32 | ), 33 | size = 2 34 | ) 35 | } 36 | waiting_line <- function(x, y, group = y) { 37 | geom_line( 38 | mapping = aes(group = group, linetype = linetype), 39 | data = data.frame( 40 | x = x, 41 | y = y, 42 | linetype = "waiting", 43 | group = group 44 | ) 45 | ) 46 | } 47 | 48 | save_image <- function(p, file, height = 4, width = 6, ...) { 49 | p <- p + theme(aspect.ratio = 100 / 150) 50 | ggsave(file, p, height = height, width = NA, ...) 51 | } 52 | 53 | route_type_guide <- function( 54 | future_values = NULL, 55 | plumber_values, 56 | promise_values = NULL 57 | ) { 58 | values <- c() 59 | values[plumber_values] <- "#2D9180" # fast 60 | labels <- "plumber" 61 | breaks <- plumber_values[1] 62 | 63 | if (!is.null(future_values)) { 64 | values[future_values] <- "#D77D49" # slow 65 | labels <- c("plumber + future", labels) 66 | breaks <- c(future_values[1], breaks) 67 | } 68 | if (!is.null(promise_values)) { 69 | values[promise_values] <- "#9437FF" # slow 70 | labels <- c("plumber + future_promise", labels) 71 | breaks <- c(promise_values[1], breaks) 72 | } 73 | scale_color_manual( 74 | name = "Route Type", 75 | values = values, 76 | labels = labels, 77 | breaks = breaks, 78 | guide = guide_legend( 79 | order = 1, 80 | override.aes = list( 81 | size = 1 82 | ) 83 | ) 84 | ) 85 | } 86 | 87 | status_guide <- function(waiting = TRUE, promise = FALSE) { 88 | scale_linetype_manual( 89 | name = "Status", 90 | values = c( 91 | if (waiting) c(waiting = "dashed"), 92 | working = "solid" 93 | ), 94 | breaks = c(if (waiting) "waiting", "working"), 95 | labels = if (promise) c("Waiting in promise", "Working in future") else 96 | c(if (waiting) "Waiting", "Working"), 97 | guide = guide_legend( 98 | order = 3, 99 | override.aes = list( 100 | linetype = c(if (waiting) "dashed", "solid"), 101 | size = c(if (waiting) 0.5, 1.5) 102 | ) 103 | ) 104 | ) 105 | } 106 | 107 | constants <- 108 | list( 109 | labs( 110 | x = "time (s)", 111 | y = NULL 112 | ), 113 | xlim(0, 20), 114 | scale_shape_manual( 115 | name = "Execution", 116 | values = c( 117 | "startend" = "X", 118 | "receive" = "|", 119 | "return" = "circle" 120 | ), 121 | breaks = c("receive", "startend", "return"), 122 | labels = c("Receive", "Process", "Respond"), 123 | guide = guide_legend(order = 2) 124 | ), 125 | # theme(aspect.ratio = 100 / 125), 126 | status_guide() 127 | ) 128 | 129 | 130 | p <- 131 | ggplot(mapping = aes(x = x, y = y)) + 132 | geom_point( 133 | data = data.frame(x = c(0, 0, 10, 10), y = c("a", "b", "b", "c")), 134 | color = "transparent" 135 | ) + 136 | scale_y_discrete( 137 | limits = rev(letters[1:3]), 138 | labels = c("/fast", "/slow", "/fast") 139 | ) + 140 | constants 141 | 142 | save_image(p, "images/timing-blank.png") 143 | 144 | 145 | p <- 146 | ggplot(mapping = aes(x = x, y = y, color = y)) + 147 | receive_point(letters[1:4]) + 148 | return_point( 149 | c(0, 10, 20, 20), 150 | letters[1:4] 151 | ) + 152 | working_line( 153 | x = c(0, 10, 10, 20), 154 | y = c("b", "b", "c", "c") 155 | ) + 156 | waiting_line( 157 | x = c(0, 10, 0, 20), 158 | y = c("c", "c", "d", "d") 159 | ) + 160 | route_type_guide(NULL, letters[1:4]) + 161 | scale_y_discrete( 162 | limits = rev(letters[1:4]), 163 | labels = c("/fast/4", "/slow/3", "/slow/2", "/fast/1") 164 | ) + 165 | constants 166 | 167 | save_image(p, "images/timing-plumber.png", width = 5.5) 168 | 169 | 170 | p <- 171 | ggplot(mapping = aes(x = x, y = y, color = y)) + 172 | receive_point(letters[1:4]) + 173 | return_point( 174 | c(0, 10, 10, 0), 175 | letters[1:4] 176 | ) + 177 | # just to make legend happy 178 | waiting_line( 179 | x = c(0, 0), 180 | y = c("b", "b") 181 | ) + 182 | working_line( 183 | x = c(0, 10, 0, 10), 184 | y = c("b", "b", "c", "c") 185 | ) + 186 | route_type_guide(c("b", "c"), c("a", "d")) + 187 | scale_y_discrete( 188 | limits = rev(letters[1:4]), 189 | labels = c("/fast/4", "/slow/3", "/slow/2", "/fast/1") 190 | ) + 191 | constants 192 | 193 | 194 | save_image(p, "images/timing-plumber-future.png") 195 | 196 | 197 | p <- 198 | ggplot(mapping = aes(x = x, y = y, color = y)) + 199 | receive_point(letters[2:6]) + 200 | return_point( 201 | x = c(10, 10, 20, 20, 0), 202 | y = letters[2:6] 203 | ) + 204 | working_line( 205 | x = c(0, 10, 0, 10, 10, 20, 10, 20), 206 | y = c("b", "b", "c", "c", "d", "d", "e", "e") 207 | ) + 208 | waiting_line( 209 | x = c(0, 10, 0, 10), 210 | y = c("d", "d", "e", "e") 211 | ) + 212 | route_type_guide(c("b", "c", "d", "e"), "f") + 213 | scale_y_discrete( 214 | limits = c("f", "e", "d", "c", "b"), 215 | labels = c("/fast/5", "/slow/4", "/slow/3", "/slow/2", "/slow/1") 216 | ) + 217 | constants 218 | 219 | 220 | save_image(p, "images/timing-plumber-limitation.png") 221 | 222 | 223 | future_constants <- list( 224 | scale_y_discrete( 225 | limits = rev(letters[1:7]), 226 | labels = c( 227 | "/fast/7", 228 | "/slow/6", 229 | "/slow/5", 230 | "/slow/4", 231 | "/slow/3", 232 | "/slow/2", 233 | "/slow/1" 234 | ) 235 | ), 236 | constants[c(-2)], 237 | theme( 238 | legend.position = "right", 239 | # legend.title = element_text(size = 5) 240 | ) 241 | ) 242 | 243 | p <- 244 | ggplot(mapping = aes(x = x, y = y, color = y)) + 245 | receive_point(letters[1:7]) + 246 | return_point( 247 | c(20, 20, 20, 20, 20, 30, 30), 248 | c("g", "a", "b", "c", "d", "e", "f") 249 | ) + 250 | waiting_line( 251 | x = c( 252 | 10, 253 | 20, 254 | 10, 255 | 20, 256 | 0, 257 | 10, # 20, 30, 258 | 0, 259 | 10, # 20, 30, 260 | 0, 261 | 20, 262 | 0, 263 | 20, 264 | 0, 265 | 20 266 | ), 267 | y = rep(letters[1:7], c(2, 2, 2, 2, 2, 2, 2)), 268 | group = c( 269 | "a2", 270 | "a2", 271 | "b2", 272 | "b2", 273 | "c1", 274 | "c1", #"c2", "c2", 275 | "d1", 276 | "d1", #"d2", "d2", 277 | "e1", 278 | "e1", 279 | "f1", 280 | "f1", 281 | "g1", 282 | "g1" 283 | ) 284 | ) + 285 | working_line( 286 | x = c(0, 10, 0, 10, 10, 20, 10, 20, 20, 30, 20, 30), 287 | y = rep(letters[1:6], each = 2) 288 | ) + 289 | route_type_guide(letters[1:6], letters[7]) + 290 | future_constants 291 | 292 | 293 | save_image(p, "images/timing-plumber-worker_full-future.png") 294 | 295 | 296 | p <- 297 | ggplot(mapping = aes(x = x, y = y, color = y)) + 298 | # # start / end time 299 | # geom_point( 300 | # mapping = aes(shape = shape), 301 | # data = data.frame( 302 | # x = c(0, 10, 0, 10, 10, 20, 10, 20, 20, 30, 20, 30, 0), 303 | # y = c(rep(letters[1:6], each = 2), "g"), 304 | # shape = "startend" 305 | # ), 306 | # size = 4 307 | # ) + 308 | receive_point(letters[1:7]) + 309 | return_point( 310 | c(0, 10, 10, 20, 20, 30, 30), 311 | c("g", "a", "b", "c", "d", "e", "f") 312 | ) + 313 | # wait time 314 | geom_line( 315 | mapping = aes(group = group, linetype = linetype), 316 | data = data.frame( 317 | x = c( 318 | 0, 319 | 10, 320 | 0, 321 | 10, 322 | 0, 323 | 20, 324 | 0, 325 | 20 326 | ), 327 | y = rep(c("c", "d", "e", "f"), each = 2), 328 | group = c( 329 | "c1", 330 | "c1", 331 | "d1", 332 | "d1", 333 | "e1", 334 | "e1", 335 | "f1", 336 | "f1" 337 | ), 338 | linetype = "waiting" 339 | ) 340 | ) + 341 | # execution time 342 | working_line( 343 | x = c(0, 10, 0, 10, 10, 20, 10, 20, 20, 30, 20, 30), 344 | y = rep(letters[1:6], each = 2) 345 | ) + 346 | route_type_guide(promise_values = letters[1:6], plumber_values = letters[7]) + 347 | future_constants + 348 | status_guide(promise = TRUE) 349 | 350 | 351 | save_image(p, "images/timing-plumber-worker_full-promise.png", width = 6.5) 352 | -------------------------------------------------------------------------------- /vignettes/promises_01_motivation.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Why use promises?" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteEngine{knitr::rmarkdown} 6 | %\VignetteIndexEntry{Why use promises?} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | The `promises` library is designed to make it possible for R users to integrate *asynchronous programming* techniques into their code. It is intended to improve the scalability of certain classes of Shiny applications, and can also be used completely separately from Shiny. 11 | 12 | Asynchronous programming means starting an operation without waiting around for its results. Contrast this with standard (synchronous) R programming, where the caller of a function must wait for the function to either return a result or throw an error. 13 | 14 | Asynchronous programming is a particularly important capability for languages that are both 1) single threaded, and 2) need to serve multiple users concurrently. R is single threaded, but until recent years has mostly been restricted to desktop use or batch execution. The rise of Shiny and other web frameworks for R has meant much greater demand for serving multiple users concurrently, and thus a greater need for asynchronous programming. 15 | 16 | ## What are promises good for? 17 | 18 | Promises work well when you have a Shiny application with a particular operation, especially a calculation, that takes a long time (measured in seconds or even minutes). Without promises, such operations not only block the current user's session from proceeding, but also block *all* other requests being made to the R process, no matter how trivial. Even loading a small CSS file, which should be nearly instantaneous, can be delayed by many seconds if another user's Shiny session is busy crunching through hundreds of gigabytes of data or querying a particularly slow backend database. 19 | 20 | With promises, you can convert long-running operations to be asynchronous, which frees up the R process to do other work. For Shiny applications, this has the potential to greatly increase scalability for each R process (depending on how slow the operations are in the first place, and what resources they make use of). 21 | 22 | **DO use promises if you have a Shiny app with long-running operations, and want to serve multiple users simultaneously.** 23 | 24 | ## What _aren't_ promises good for? 25 | 26 | While promises can make a huge difference in the scalability of a Shiny app, they make relatively little difference in the latency of a single session. That is to say, if a Shiny application is slow when only a single user is hitting it, converting it to use promises is unlikely to make it perform any faster (and in fact may slightly slow it down). Promises will just help prevent *other* sessions from being slowed down by one session's computations. 27 | 28 | (The exception to this is if the Shiny app has several distinct long computations that don't depend very much on each other—then you could use asynchronous programming to exploit a little parallelism. But I think this will be a less common use of async programming, as R already has other good tools designed specifically for data parallelism.) 29 | 30 | **DON'T use promises to improve the performance of Shiny apps for a single user.** 31 | 32 |
33 | Next: [An informal intro to async programming](promises_02_intro.html) 34 |
35 | -------------------------------------------------------------------------------- /vignettes/promises_02_intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "An informal introduction to async programming" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteEngine{knitr::rmarkdown} 6 | %\VignetteIndexEntry{An informal introduction to async programming} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | Hello, R and/or Shiny user! Let’s talk about async programming! 11 | 12 | **Async programming? Sounds complicated.** 13 | 14 | It is, very! You may want to grab some coffee. 15 | 16 | **Ugh. Tell me why I even need to know this?** 17 | 18 | Async programming is a major new addition to Shiny that can make certain classes 19 | of apps dramatically more responsive under load. 20 | 21 | Because R is single threaded (i.e. it can only do one thing at a time), a given 22 | Shiny app process can also only do one thing at a time: if it is fitting a 23 | linear model for one client, it can’t simultaneously serve up a CSV download for 24 | another client. 25 | 26 | For many Shiny apps, this isn’t a big problem; if no one processing step takes 27 | very long, then no client has to wait an undue amount of time before they start 28 | seeing results. But for apps that perform long-running operations — either 29 | expensive computations that take a while to complete, or waiting on slow network 30 | operations like database or web API queries — your users’ experience can suffer 31 | dramatically as traffic ramps up. Operations that normally are lightning quick, 32 | like downloading a small JavaScript file, can get stuck in traffic behind 33 | something slow. 34 | 35 | **Oh, OK—more responsiveness is always good. But you said this’ll only help for 36 | certain classes of Shiny apps?** 37 | 38 | It’s mostly helpful for apps that have a few specific operations that take a 39 | long time, rather than lots of little operations that are all a bit slow on 40 | their own and add up to one big slow mess. We’re looking for watermelons, not 41 | blueberries. 42 | 43 | **Watermelons… sure. So then, how does this all work?** 44 | 45 | It all starts with *async functions*. An async function is one that performs an 46 | operation that takes a long time, yet returns control to you immediately. 47 | Whereas a normal function like `read.csv` will not return until its work is done 48 | and it has the value you requested, an asynchronous `read.csv.async` function 49 | would kick off the CSV reading operation, but then return immediately, long 50 | before the real work has actually completed. 51 | 52 | ```r 53 | library(future) 54 | plan(multisession) 55 | 56 | read.csv.async <- function(file, header = TRUE, stringsAsFactors = FALSE) { 57 | future_promise({ 58 | read.csv(file, header = header, stringsAsFactors = stringsAsFactors) 59 | }) 60 | } 61 | ``` 62 | 63 | (Don't worry about what this definition means for now. You'll learn more about defining async functions in [Launching tasks](promises_04_futures.html) and [Advanced `future` and `promises` usage](promises_05_future_promise.html).) 64 | 65 | **So instead of “read this CSV file” it’s more like “begin reading this CSV 66 | file”?** 67 | 68 | Yes! That’s what async functions do: they start things, and give you back a 69 | special object called a *promise*. If it doesn’t return a promise, it’s not an 70 | async function. 71 | 72 | **Oh, I’ve heard of promises in R! From [the NSE 73 | chapter](http://adv-r.had.co.nz/Computing-on-the-language.html) in Hadley’s 74 | Advanced R book!** 75 | 76 | Ah... this is awkward, but no. I’m using the word “promise”, but I’m not referring 77 | to *that* kind of promise. For the purposes of async programming, try to forget 78 | that you’ve ever heard of that kind of promise, OK? 79 | 80 | I know it seems needlessly confusing, but the promises we’re talking about here 81 | are ~~shamelessly copied from~~ directly inspired by a central abstraction in modern 82 | JavaScript, and the JS folks named them “promises”. 83 | 84 | **Fine, whatever. So what are these promises?** 85 | 86 | Conceptually, they’re a stand-in for the *eventual result* of the operation. For 87 | example, in the case of our `read.csv.async` function, the 88 | promise is a stand-in for a data frame. At some point, the operation is going to 89 | finish, and a data frame is going to become available. The promise gives us a 90 | way to get at that value. 91 | 92 | **Let me guess: it’s an object that has `has_completed()` and 93 | `get_value()` methods?** 94 | 95 | Good guess, but no. Promises are *not* a way to directly inquire about the 96 | status of an operation, nor to directly retrieve the result value. That is 97 | probably the simplest and most obvious way to build an async framework, but in 98 | practice it’s very difficult to build deeply async programs with an API like 99 | that. 100 | 101 | Instead, a promise lets you *chain together operations* that should be performed 102 | whenever the operation completes. These operations might have side effects (like 103 | plotting, or writing to disk, or printing to the console) or they might 104 | transform the result values somehow. 105 | 106 | **Chain together operations? Using the `%>%` operator?** 107 | 108 | A lot like that! You can’t use the `%>%` operator itself, but we provide a 109 | promise-compatible version of it: `%...>%`. So whereas you might do this to a 110 | regular data frame: 111 | 112 | ```r 113 | library(dplyr) 114 | read.csv("https://rstudio.github.io/promises/data.csv") %>% 115 | filter(state == "NY") %>% 116 | View() 117 | ``` 118 | 119 | The async version would look like: 120 | 121 | ```r 122 | library(dplyr) 123 | read.csv.async("https://rstudio.github.io/promises/data.csv") %...>% 124 | filter(state == "NY") %...>% 125 | View() 126 | ``` 127 | 128 | The `%...>%` operator here is the secret sauce. It’s called the *promise pipe*; 129 | the `...` stands for promise, and `>` mimics the standard pipe operator. 130 | 131 | **What a strange looking operator. Does it work just like a regular pipe?** 132 | 133 | In many ways `%...>%` does work like a regular pipe: it rewrites each stage’s 134 | function call to take the previous stage’s output as the first argument. (All 135 | the [standard magrittr 136 | tricks](https://CRAN.R-project.org/package=magrittr/vignettes/magrittr.html) 137 | apply here: `.`, `{`, parenthesized lambdas, etc.) But the differences, while 138 | subtle, are profound. 139 | 140 | The first and most important difference is that `%...>%` *must* take a promise 141 | as input; that is, the left-hand side of the operator must be an expression that 142 | yields a promise. The `%...>%` will do the work of “extracting” the result value 143 | from the promise, and passing that (unwrapped) result to the function call on 144 | the right-hand side. 145 | 146 | This last fact—that `%...>%` passes an unwrapped, plain old, not-a-promise value 147 | to the right-hand side—is critically important. It means we can use promise 148 | objects with non-promise-aware functions, with `%...>%` serving as the bridge 149 | between asynchronous and synchronous code. 150 | 151 | **So the left-hand side of `%...>%` needs to be one of these special promise 152 | objects, but the right-hand side can be regular R base functions?** 153 | 154 | Yes! R base functions, dplyr, ggplot2, or whatever. 155 | 156 | However, that work often can’t be done in the present, since the whole point of 157 | a promise is that it represents work that hasn’t completed yet. So `%...>%` does 158 | the work of extracting and piping not at the time that it’s called, but rather, 159 | sometime in the future. 160 | 161 | **You lost me.** 162 | 163 | OK, let’s slow down and take this step by step. We’ll generate a promise by 164 | calling an async function: 165 | 166 | ```r 167 | df_promise <- read.csv.async("https://rstudio.github.io/promises/data.csv") 168 | ``` 169 | 170 | Even if `data.csv` is many gigabytes, `read.csv.async` returns immediately with 171 | a new promise. We store it as `df_promise`. Eventually, when the CSV reading 172 | operation successfully completes, the promise will contain a data frame, but for 173 | now it’s just an empty placeholder. 174 | 175 | One thing we definitely *can’t* do is treat `df_promise` as if it’s simply a 176 | data frame: 177 | 178 | ```r 179 | # Doesn't work! 180 | dplyr::filter(df_promise, state == "NY") 181 | ``` 182 | 183 | Try this and you’ll get an error like `no applicable method for 'filter_' 184 | applied to an object of class "promise"`. And the pipe won’t help you either; 185 | `df_promise %>% filter(state == "NY")` will give you the same error. 186 | 187 | **Right, that makes sense. `filter` is designed to work on data frames, and 188 | `df_promise` isn’t a data frame.** 189 | 190 | Exactly. Now let’s try something that actually works: 191 | 192 | ```r 193 | df_promise %...>% filter(state == "NY") 194 | ``` 195 | 196 | At the moment it’s called, this code won’t appear to do much of anything, 197 | really. But whenever the `df_promise` operation actually completes successfully, 198 | then the result of that operation—the plain old data frame—will be passed to 199 | `filter(., state = "NY")`. 200 | 201 | **OK, so that’s good. I see what you mean about `%...>%` letting you use 202 | non-promise functions with promises. But the whole point of using the 203 | `filter` function is to get a data frame back. If `filter` isn’t even 204 | going to be called until some random time in the future, how do we get its value 205 | back?** 206 | 207 | I’ll tell you the answer, but it’s not going to be satisfying at first. 208 | 209 | When you use a regular `%>%`, the result you get back is the return value from 210 | the right-hand side: 211 | 212 | ```r 213 | df_filtered <- df %>% filter(state == "NY") 214 | ``` 215 | 216 | When you use `%...>%`, the result you get back is a promise, whose *eventual* 217 | result will be the return value from the right-hand side: 218 | 219 | ```r 220 | df_filtered_promise <- df_promise %...>% filter(state == "NY") 221 | ``` 222 | 223 | **Wait, what? If I have a promise, I can do stuff to it using `%...>%`, but 224 | then I just end up with another promise? Why not just have `%...>%` return a 225 | regular value instead of a promise?** 226 | 227 | Remember, the whole point of a promise is that we don’t know its value yet! So 228 | to write a function that uses a promise as input and returns some non-promise 229 | value as output, you’d need to either be a time traveler or an oracle. 230 | 231 | To summarize, once you start working with a promise, any calculations and 232 | actions that are “downstream” of that promise will need to become 233 | promise-oriented. Generally, this means once you have a promise, you need to use 234 | `%...>%` and keep using it until your pipeline terminates. 235 | 236 | **I guess that makes sense. Still, if the only thing you can do with promises is 237 | make more promises, that limits their usefulness, doesn’t it?** 238 | 239 | It’s a different way of thinking about things, to be sure, but it turns out 240 | there’s not much limit in usefulness—especially in the context of a Shiny app. 241 | 242 | First, you can use promises with Shiny outputs. If you’re using an 243 | async-compatible version of Shiny (version >=1.1), all of the 244 | built-in `renderXXX` functions can deal with either regular values or promises. 245 | An example of the latter: 246 | 247 | ```r 248 | output$table <- renderTable({ 249 | read.csv.async("https://rstudio.github.io/promises/data.csv") %...>% 250 | filter(state == "NY") 251 | }) 252 | ``` 253 | 254 | When `output$table` executes the `renderTable` code block, it will notice that 255 | the result is a promise, and wait for it to complete before continuing with the 256 | table rendering. While it’s waiting, the R process can move on to do other 257 | things. 258 | 259 | Second, you can use promises with reactive expressions. Reactive expressions 260 | treat promises about the same as they treat other values, actually. But this 261 | works perfectly fine: 262 | 263 | ```r 264 | # A reactive expression that returns a promise 265 | filtered_df <- reactive({ 266 | read.csv.async("https://rstudio.github.io/promises/data.csv") %...>% 267 | filter(state == "NY") %...>% 268 | arrange(median_income) 269 | }) 270 | 271 | # A reactive expression that reads the previous 272 | # (promise-returning) reactive, and returns a 273 | # new promise 274 | top_n_by_income <- reactive({ 275 | filtered_df() %...>% 276 | head(input$n) 277 | }) 278 | 279 | output$table <- renderTable({ 280 | top_n_by_income() 281 | }) 282 | ``` 283 | 284 | Third, you can use promises in reactive observers. Use them to perform 285 | asynchronous tasks in response to reactivity. 286 | 287 | ```r 288 | observeEvent(input$save, { 289 | filtered_df() %...>% 290 | write.csv("ny_data.csv") 291 | }) 292 | ``` 293 | 294 | **Alright, I think I see what you mean. You can’t escape from promise-land, but 295 | there’s no need to, because Shiny knows what to do with them.** 296 | 297 | Yes, that’s basically right. You just need to keep track of which functions and 298 | reactive expressions return promises instead of regular values, and be sure to 299 | interact with them using `%...>%` or other promise-aware operators and 300 | functions. 301 | 302 | **Wait, there are other promise-aware operators and functions?** 303 | 304 | Yes. The `%...>%` is the one you’ll most commonly use, but there is a variant 305 | `%...T>%`, which we call the *promise tee* operator (it’s analogous to the 306 | magrittr `%T>%` operator). The `%...T>%` operator mostly acts like `%...>%`, but 307 | instead of returning a promise for the result value, it returns the original 308 | value instead. Meaning `p %...T>% cat("\n")` won’t return a promise for the 309 | return value of `cat()` (which is always `NULL`) but instead the value of `p`. 310 | This is useful for logging, or other “side effecty” operations. 311 | 312 | There’s also `%...!%`, and its tee version, `%...T!%`, which are used for error 313 | handling. I won’t confuse you with more about that now, but you can read more 314 | [here](promises_03_overview.html#error-handling). 315 | 316 | The `promises` package is where all of these operators live, and it also comes 317 | with some additional functions for working with promises. 318 | 319 | So far, the only actual async function we’ve talked about has been 320 | `read.csv.async`, which doesn’t actually exist. To learn where actual async 321 | functions come from, read [this guide to the `future` package](promises_04_futures.html). 322 | 323 | There are the lower-level functions `then`, `catch`, and `finally`, which are 324 | the non-pipe, non-operator equivalents of the promise operators we’ve been 325 | discussing. See [reference](promises_03_overview.html#accessing-results-with-then). 326 | 327 | And finally, there are `promise_all`, `promise_race`, and `promise_lapply`, used to combine 328 | multiple promises into a single promise. Learn more about them [here](../reference/promise_all.html). 329 | 330 | **OK, looks like I have a lot of stuff to read up on. And I’ll probably have to 331 | reread this conversation a few times before it fully sinks in.** 332 | 333 | Sorry. I told you it was complicated. If you make it through the rest of the guide, you’ll be 95% of the way there. 334 | 335 |
336 | Next: [Working with promises](promises_03_overview.html) 337 |
338 | -------------------------------------------------------------------------------- /vignettes/promises_04_futures.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Launching tasks with future" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteEngine{knitr::rmarkdown} 6 | %\VignetteIndexEntry{Launching tasks with future} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{css echo=FALSE} 11 | .alert-success a, .alert-success a:visited { 12 | color: inherit; 13 | text-decoration: underline; 14 | } 15 | .alert code { 16 | color: inherit; 17 | background-color: inherit; 18 | } 19 | ``` 20 | 21 |
22 | While this article and others on this site focus on the `future` package, there's a much newer package called [`mirai`](https://mirai.r-lib.org/) that you may want to consider instead. 23 | Here are some factors to consider as you choose between the two. 24 | 25 | 1. The `future` package tries hard to automatically infer what variables and packages you need from the main R package, and makes those available to the child process. `mirai` doesn't try to do this for you; you need to pass in whatever data you need explicitly, and make package-namespaced calls explicitly inside of your inner code. 26 | 2. `mirai` is very fast; it's much faster than `future` at starting up and has less per-task overhead. `mirai` creates event-driven promises, whereas promises using `future` time-poll every 0.1 seconds. This makes `mirai` ideal where response times and latency are critical. 27 | 3. `future` is designed to be a general API supporting many types of distributed computing backends, and potentially offers more options. `mirai` on the other hand is its own system, whilst it does support both local and distributed execution. 28 | 4. `mirai` is inherently queued, meaning it readily accepts more tasks than workers. This means you don’t need an equivalent of `future_promise()`. With `future` you need to manage cases where futures launch other futures ("evaluation topologies") upfront, whereas with `mirai` they will just work. 29 | 5. `mirai` supports task cancellation and the ability to interrupt ongoing tasks on the worker. 30 |
31 | 32 | The `future` package provides a lightweight way to launch R tasks that don't block the current R session. It was created by Henrik Bengtsson long before the `promises` package existed—the first CRAN release of `future` predates development of `promises` by almost two years. 33 | 34 | The `promises` package provides the API for working with the results of async tasks, but it totally abdicates responsibility for actually launching/creating async tasks. The idea is that any number of different packages could be capable of launching async tasks, using whatever techniques they want, but all of them would either return promise objects (or objects that can be converted to promise objects, as is the case for `future`). However, for now, `future` is likely to be the primary or even exclusive way that async tasks are created. 35 | 36 | This document will give an introduction to the parts of `future` that are most relevant to promises. For more information, please consult the vignettes that come with `future`, especially the [Comprehensive Overview](https://CRAN.R-project.org/package=future/vignettes/future-1-overview.html). 37 | 38 | ## How future works 39 | 40 | The main API that `future` provides couldn't be simpler. You call `future()` and pass it the code that you want executed asynchronously: 41 | 42 | ```R 43 | f <- future({ 44 | # expensive operations go here... 45 | df <- download_lots_of_data() 46 | fit_model(df) 47 | }) 48 | ``` 49 | 50 | The object that's returned is a future, which for all intents and purposes is a promise object[^1], which will eventually resolve to the return value of the code block (i.e. the last expression) or an error if the code does not complete executing successfully. The important thing is that no matter how long the expensive operation takes, these lines will execute almost instantly, while the operation continues in the background. 51 | 52 | [^1]: (The `future` package provides several functions for working with future objects, but they are not relevant for our purposes.) 53 | 54 | But we know that R is single-threaded, so how does `future` accomplish this? The answer: by utilizing another R process. `future` delegates the execution of the expensive operation to a totally different R process, so that the original R process can move on. 55 | 56 | ## Choosing a launch method 57 | 58 | There are several different methods we could use for launching R processes or attaching to existing R processes, and each method has its own advantages, disadvantages, limitations, and requirements. Rather than prescribing a single method, the `future` package provides an extensible mechanism that lets you, the R user, decide what method to use. Call the `plan()` function with one of the following values (without quotes—these are function names, not strings): 59 | 60 | * `multisession`: Launches up to *n* background R processes on the same machine (where *n* is the number of processor cores on the system, minus 1). These background processes will be used/recycled for the life of the originating R process. If a future is launched while all the background R processes are busy executing, then the new future will be queued until one of the background processes free up. 61 | * `multicore`: Each new task executes in its own forked child process. Forking is generally much faster than launching a new process from scratch, and most of the state of the original process is available to the child process without having to go through any extra effort (see the section about Globals below). The biggest limitation of forking is that it doesn't work at all on Windows operating systems, which is what the majority of R users use. There are also some dangerous edge cases with this style of execution (Google "fork without exec" for more information), though popular frameworks like RServe and OpenCPU rely heavily on this and don't seem to suffer for it. 62 | 63 | The `future` package also includes a `sequential` method, which executes synchronously and is therefore not relevant for our purposes. Unfortunately, `sequential` is the default, hence explicitly calling `plan()` with a different method is a must. 64 | 65 | There is also a `cluster` method, as well as a separate `future.batchtools` package, for doing distributed execution; those may work with promises, but have not been tested by our team and are not described further in this document. 66 | 67 | To learn more, see the [`future::plan()` reference docs](https://future.futureverse.org/reference/plan.html) as well as the [`future` overview](https://future.futureverse.org/articles/future-1-overview.html#controlling-how-futures-are-resolved). 68 | 69 | ## Caveats and limitations 70 | 71 | The abstractions that `future` presents are simple, but [leaky](https://en.wikipedia.org/wiki/Leaky_abstraction). You can't make effective use of `future` without understanding its various strategies for running R tasks asynchronously. Please read this entire section carefully before proceeding. 72 | 73 | ### Globals: Providing input to future code chunks 74 | 75 | Most future code chunks will need to reference data from the original process, e.g. data to be fitted, URLs to be requested, file paths to read from. The future package goes to some lengths to try to make this process seamless for you, by inspecting your code chunk and predicting which variables from the original process should be copied to the child process. In our testing this works fairly reliably with multicore, somewhat less reliably with multisession. 76 | 77 | Multisession also has the distinct disadvantage that any identified variables must be physically (though automatically) copied between the main and child processes, which can be extremely time-consuming if the data is large. (The multicore strategy does not need to do this, because every forked process starts out with its memory in the same state as its parent at the time of the fork.) 78 | 79 | In summary, it's possible for both false positives (data copied that doesn't need to be) and false negatives (data not available when it's needed) to occur. Therefore, for all but the simplest cases, we suggest suppressing future's automated variable copying and instead manually specifying the relevant variables, using the `future()` function's `globals` parameter. You can pass it a character vector (`globals = c("var_a", "var_b")`) or a named list (`globals = c(data = mtcars, iterations = n)`). 80 | 81 | One final note about globals: as a safety measure, `future()` will error if the size of the data to be shuttled between the processes exceeds 500MB. This is true whether the variables to copy were identified by automatic detection, or explicitly via the `globals` parameter; and it's even true if you're using the multicore strategy, where no copies are actually made. If your data is potentially large, you'll want to increase the limit by setting the `future.globals.maxSize` option to a suitably high number of bytes, e.g. `options(future.globals.maxSize=1e9)` for a billion bytes. 82 | 83 | ### Package loading 84 | 85 | Besides variables, `future()` also tries to automatically infer what R packages need to be loaded in the child process. If the automatic detection is not sufficient, you can use the `future()` function's `packages` parameter to pass in a character vector of package names, e.g. `packages = c("dplyr", "ggplot2")`. 86 | 87 | Again, this is especially important for multisession, because multicore will inherit all of the attached packages of the parent process. 88 | 89 | ### Native resources 90 | 91 | Future code blocks cannot use resources such as database connections and network sockets that were created in the parent process. This is true regardless of what future implementation you use! Even if it seems to work with a simple test, you are asking for crashes or worse by sharing these kinds of resources across processes. 92 | 93 | Instead, make sure you create, use, and destroy such resources entirely within the scope of the future code block. 94 | 95 | ### Mutation 96 | 97 | Reference class objects (including R6 objects and data.table objects) and environments are among the few "native" R object types that are mutable, that is, can be modified in-place. Unless they contain native resources (see previous section), there's nothing wrong with using mutable objects from within future code blocks, even objects created in the parent process. However, note that any changes you make to these objects will not be visible from the parent process; the future code is operating on a copy of the object, not the original. 98 | 99 | ### Returning values 100 | 101 | Future code blocks can return a value—they'd be a lot less useful if they couldn't! Like everywhere else in R, the return value is determined by the last expression in the code block, unless `return()` is explicitly called earlier. 102 | 103 | Regardless of future method, the return value will be copied back into the parent process. This matters for two reasons. 104 | 105 | First, if the return value is very large, the copying process can take some time—and because the data must essentially be serialized to and deserialized from rds format, it can take a surprising amount of time. In the case of future blocks that execute fairly quickly but return huge amounts of data, you may be better off not using future/async techniques at all. 106 | 107 | Second, objects that refer to native resources are unlikely to work in this direction either; just as you can't use the parent's database connections in the child process, you also cannot have the child process return a database connection for the parent to use. 108 | 109 |
110 |
111 | 112 | Next: 113 | 114 | * [Advanced `future` and `promises` usage](promises_05_future_promise.html) 115 | * [Using `promises` with Shiny](promises_06_shiny.html) 116 | 117 |
118 |
119 | -------------------------------------------------------------------------------- /vignettes/promises_05_future_promise.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Advanced future and promises usage" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteEngine{knitr::rmarkdown} 6 | %\VignetteIndexEntry{Advanced future and promises usage} 7 | %\VignetteEncoding{UTF-8} 8 | resource_files: 9 | - future_promise/future.png 10 | - future_promise/blocked_future_promise.png 11 | --- 12 | 13 | This article discusses the benefits of using `promises::future_promise()` over a combination of `future::future()` + `promises::promise()` to better take advantage of computing resources available to your main R session. To demonstrate these benefits, we'll walk-through a use-case with the `plumber` package. ([See here](https://www.rplumber.io/) to learn more about `plumber` and [the previous article](promises_04_futures.html) to learn more about `future`.) 14 | 15 | ## The problem with `future()`+`promise()` 16 | 17 | In an ideal situation, the number of available `future` _workers_ (`future::nbrOfFreeWorkers()`) is always **more than** the number of `future::future()` _jobs_. However, if a `future` job is attempted when the number of free workers is `0`, then `future` will block the current R session until one becomes available. 18 | 19 | For a concrete example, let's imagine a scenario, where seven `plumber` requests are received at the same time with only two `future` workers available. Also, let's assume the `plumber` route(s) serving the first 6 requests use `future::future()` and take ~10s to compute `slow_calc()`: 20 | 21 | ```r 22 | #* @get /slow/ 23 | function() { 24 | future::future({ 25 | slow_calc() 26 | }) 27 | } 28 | ``` 29 | 30 | Let's also assume the `plumber` route serving the last request does not use any form of `future` or `promises` and takes almost no time to compute. 31 | 32 | ```r 33 | #* @get /fast/ 34 | function() { 35 | fast_calc() 36 | } 37 | ``` 38 | 39 | 40 | The figure below depicts the overall timeline of execution of these 7 requests under the conditions we've outlined above. Note that the y-axis is ordered from first request coming in (`/slow/1`) to the last request (`/fast/7`). 41 | 42 | Early workers take more time than expected. Main R session is blocked 43 | 44 | Note how R has to wait 20s before processing the 7th request (shown in green). This is a big improvement over not using `future`+`promises` at all (in that case, R would have to wait 60s before processing). However, since there are only two `future` workers available R still has to wait longer than necessary to process that last request because the main R session must wait for a `future` worker to become available. The video below animates this behavior: 45 | 46 | 47 | ```{r, echo = FALSE} 48 | library(vembedr) 49 | embed_vimeo("505287449") %>% 50 | use_align("center") 51 | ``` 52 | 53 | 54 | ## The solution: `future_promise()` 55 | 56 | The advantage of using `future_promise()` over `future::future()` is that even if there aren't `future` workers available, the `future` is scheduled to be done when workers become available via `promises`. In other words, `future_promise()` ensures the main R thread isn't blocked when a `future` job is requested and can't immediately perform the work (i.e., the number of jobs exceeds the number of workers). 57 | 58 | Continuing with the example above, we can swap out the calls to `future::future()` with `future_promise()`. 59 | 60 | ```r 61 | #* @get /slow/ 62 | function() { 63 | promises::future_promise({ 64 | slow_calc() 65 | }) 66 | } 67 | ``` 68 | 69 | 70 | With this change to `future_promise()`, note how the `/fast/7` route now does not have to wait on `future` work to finish processing. Therefore, `plumber` can complete the last requests almost immediately: 71 | 72 | future_promise() keeps the main R session free 73 | 74 | The vertical gray bars in the figure above represent timepoints where the main R session is actually busy. Outside of these gray areas, the R session is free to do other things, for example, executing other `promises` or, more generally, non-`future` work. The video below animates this behavior: 75 | 76 | ```{r, echo = FALSE} 77 | library(vembedr) 78 | embed_vimeo("505286442") %>% 79 | use_align("center") 80 | ``` 81 | 82 |
83 | Next: [Using `promises` with Shiny](promises_06_shiny.html) 84 |
85 | -------------------------------------------------------------------------------- /vignettes/promises_07_combining.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Combining promises" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteEngine{knitr::rmarkdown} 6 | %\VignetteIndexEntry{Combining promises} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | So far, all of our examples have involved chaining operations onto a single promise. In practice, you'll often find yourself needing to perform tasks that require the results of more than one promise. These are some patterns you may find useful: 11 | 12 | * [**Gathering:**](#gathering) Combining multiple independent promises into a single computation 13 | * [**Nesting:**](#nesting) Using the result of one promise to affect the input or execution of another async operation 14 | * [**Racing:**](#racing) Using the fastest of multiple promises 15 | * [**Mapping:**](#mapping) Applying an async function to each of a list's elements and collecting the results 16 | * [**Reducing:**](#reducing) Applying an async function to each of a list's elements and reducing 17 | 18 | ## Gathering 19 | 20 | The most common pattern for combining promises is gathering, where you have two or more promises in hand and you want to use all of their results in a computation. The `promise_all` function is designed for this. Its signature looks like this: 21 | 22 | ```r 23 | promise_all(..., .list = NULL) 24 | ``` 25 | 26 | `promise_all` takes any number of promises as named arguments, and returns a promise of a list containing named elements with the results of those promises. 27 | 28 | Here's an example using `promise_all` to combine the results of two async `read.csv` operations: 29 | 30 | ```r 31 | library(promises) 32 | library(future) 33 | plan(multisession) 34 | 35 | a <- future_promise(read.csv("a.csv")) 36 | b <- future_promise(read.csv("b.csv")) 37 | 38 | result <- promise_all(a = a, b = b) %...>% { 39 | rbind(.$a, .$b) 40 | } 41 | ``` 42 | 43 | In this example, the value of `.` within the curly braces is a list whose elements `a` and `b` are both data frames. We use `rbind` to combine them. 44 | 45 | The `.$` prefix is a bit inelegant, so we recommend the use of the base R function `with`, which lets you skip the prefix. Here's the same example, with `with`: 46 | 47 | ```r 48 | library(promises) 49 | library(future) 50 | plan(multisession) 51 | 52 | a <- future_promise(read.csv("a.csv")) 53 | b <- future_promise(read.csv("b.csv")) 54 | 55 | promise_all(a = a, b = b) %...>% 56 | with({ 57 | rbind(a, b) 58 | }) 59 | ``` 60 | 61 | (Note that since the `promise_all` argument names are the same as the variable names (`a = a`, `b = b`), the original variables are masked: inside the `with` block, `a` now refers to the *result* of the promise `a`, not the promise object itself. If you find this confusing, you can just choose a different argument name, like `promise_all(a_result = a, …)`.) 62 | 63 | The combination of `promise_all` and `with` is a concise and powerful way to gather the results of multiple promises. 64 | 65 | `promise_all` also gives you two other options for passing input promises. First, if you would rather your result list be unnamed, you can pass in promises as unnamed arguments: `promise_all(a, b)` would yield `list(1, 2)`. Second, if you have a list of promises already in hand, you can pass the list as a single argument using `promise_all(.list = x)` (instead of, say, using `do.call(promise_all, x)`). 66 | 67 | ## Nesting 68 | 69 | Gathering is easy and convenient, but sometimes not flexible enough. For example, if you use the result of promise `a` to decide whether to launch a second async task, whose result you then use in combination with the result of `a`. 70 | 71 | ```r 72 | library(promises) 73 | library(future) 74 | plan(multisession) 75 | 76 | a <- future_promise(1) 77 | 78 | a %...>% (function(a) { 79 | b <- future_promise(2) 80 | b %...>% (function(b) { 81 | a + b 82 | }) 83 | }) 84 | ``` 85 | 86 | (We use anonymous functions here to mask the names of the original promises--i.e. once inside the first anonymous function, the symbol `a` now refers to the result of the promise `a`.) 87 | 88 | The nesting pattern is effective and flexible. The main downside is the physical nesting of the source code; if you use this pattern to a depth of more than a couple of promises, your code will be quite indented (in programming jargon this is referred to as the "pyramid of doom"). 89 | 90 | ## Racing 91 | 92 | ```r 93 | library(promises) 94 | library(future) 95 | plan(multisession) 96 | 97 | a <- future_promise({ Sys.sleep(1); 1 }) 98 | b <- future_promise({ Sys.sleep(0.5); 2 }) 99 | 100 | first <- promise_race(a, b) 101 | ``` 102 | 103 | `promise_race` takes multiple promises and returns a new promise that will be fulfilled with the first promise that succeeds. In the example above, `first` is a promise that will be fulfilled with `2` after 0.5 seconds. 104 | 105 | If one of the input promises rejects before any succeed, then the returned promise will be rejected. 106 | 107 | Note that promises does not currently support cancellation. So losing promises will attempt to run to completion even after the race ends. 108 | 109 | ## Mapping 110 | 111 | Use `promise_map` to run an async operation on each element of a list or vector, and collect the results in a list. It's very similar to `lapply` or `purrr::map`, except that the function to apply can return a promise, and the return value is also a promise. 112 | 113 | In the example below, we iterate over a named vector of package names. For each package name, we launch an async task to download the package's description file from CRAN pick out the last published date. 114 | 115 | ```r 116 | library(promises) 117 | library(future) 118 | plan(multisession) 119 | 120 | get_pub_date <- function(pkg) { 121 | desc_url <- paste0("https://cran.r-project.org/web/packages/", pkg, "/DESCRIPTION") 122 | future_promise({ 123 | read.dcf(url(desc_url))[, "Date/Publication"] %>% unname() 124 | }) 125 | } 126 | 127 | packages <- setNames(, c("ggplot2", "dplyr", "knitr")) 128 | 129 | pkg_dates <- promise_map(packages, get_pub_date) 130 | 131 | pkg_dates %...>% print() 132 | ``` 133 | 134 | The resulting output looks like this: 135 | 136 | ``` 137 | $ggplot2 138 | [1] "2016-12-30 22:45:17" 139 | 140 | $dplyr 141 | [1] "2017-09-28 20:43:29 UTC" 142 | 143 | $knitr 144 | [1] "2018-01-29 11:01:22 UTC" 145 | ``` 146 | 147 | `promise_map` works serially; each time it calls the given function on an element of the list/vector, it will wait for the returned promise to resolve before proceeding to the next element. Furthermore, any error or rejected promise will cause the entire `promise_map` operation to reject. 148 | 149 | If you want behavior that's similar to `promise_map` but for all the async operations to occur in parallel, you can achieve that with a combination of a regular `purrr::map` and `promise_all`: 150 | 151 | ```r 152 | pkg_dates <- purrr::map(packages, get_pub_date) %>% 153 | promise_all(.list = .) 154 | 155 | pkg_dates %...>% print() 156 | ``` 157 | 158 | ## Reducing 159 | 160 | Use `promise_reduce` when you have a list where you want to run an async operation on each of the elements, and to do so serially (i.e. only one async operation runs at a time). This can be helpful when you're searching through some elements using an async operation and want to terminate early when your search succeeds. 161 | 162 | The signature of `promise_reduce` is as follows: 163 | 164 | ```r 165 | promise_reduce(x, func, init = NULL) 166 | ``` 167 | 168 | If you've worked with `base::Reduce()` or `purr:::reduce()`, this should seem reasonably familiar: `x` is a vector or list; `func` is a function that takes two arguments, the accumulated value and the "next" value; and `init` is the default accumulated value. 169 | 170 | The main difference between `promise_reduce` and `purrr:::reduce` is that with `promise_reduce`, your `func` can return a promise. If it does, `promise_reduce` will wait for it to resolve before updating the accumulated value and invoking `func` on the next element. The result returned from `promise_reduce` is a promise that resolves to the ultimate accumulated value. 171 | 172 | The following example loops through a partial list of CRAN mirrors, returning the first one that passes whatever check `http::http_error` performs. 173 | 174 | ```r 175 | library(promises) 176 | library(future) 177 | plan(multisession) 178 | 179 | cran_mirrors <- c( 180 | "https://cloud.r-project.org", 181 | "https://cran.usthb.dz", 182 | "https://cran.csiro.au", 183 | "https://cran.wu.ac.at" 184 | ) 185 | 186 | promise_reduce(cran_mirrors, function(result, mirror) { 187 | if (!is.null(result)) { 188 | result 189 | } else { 190 | future_promise({ 191 | # Test the URL; return the URL on success, or NULL on failure 192 | if (!httr::http_error(mirror)) mirror 193 | }) 194 | } 195 | }, .init = NULL) %...>% print() 196 | ``` 197 | --------------------------------------------------------------------------------