diff --git a/.circleci/config.yml b/.circleci/config.yml index a92f615f..4a82f472 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,15 +1,13 @@ version: 2 jobs: - - "test": &test-template working_directory: ~/dashr docker: - image: plotly/dashr:ci auth: username: dashautomation - password: $DASH_PAT_DOCKERHUB + password: $DASH_PAT_DOCKERHUB environment: PERCY_PARALLEL_TOTAL: '-1' PUPPETEER_SKIP_CHROMIUM_DOWNLOAD: 'True' @@ -33,18 +31,22 @@ jobs: - run: name: 🚧 install R dependencies command: | - sudo Rscript -e 'commit_hash <- readChar("commit.txt", file.info("commit.txt")$size); message("Preparing to install plotly/dashR ", commit_hash, " ..."); install.packages("remotes"); remotes::install_github("plotly/dashR", upgrade=TRUE, ref=commit_hash, force=TRUE)' + sudo Rscript -e 'commit_hash <- readChar("commit.txt", file.info("commit.txt")$size); message("Preparing to install plotly/dashR ", commit_hash, " ..."); install.packages("remotes"); remotes::install_github("plotly/dashR", upgrade=TRUE, ref=commit_hash, dependencies=TRUE, force=TRUE)' - run: name: ⚙️ Integration tests command: | + curl --proto '=https' --tlsv1.2 -sSf -o rust-init.sh https://sh.rustup.rs + chmod ugo+x rust-init.sh + ./rust-init.sh -y python -m venv venv . venv/bin/activate git clone --depth 1 https://github.com/plotly/dash.git dash-main + export PATH=$PATH:/home/circleci/.local/bin/:/home/circleci/.cargo/bin + export RUSTC_BOOTSTRAP=1 cd dash-main && pip install -e .[dev,testing] --progress-bar off && cd .. cd dash-main/\@plotly/dash-generator-test-component-nested && npm ci && npm run build && sudo R CMD INSTALL . && cd ../../.. cd dash-main/\@plotly/dash-generator-test-component-standard && npm ci && npm run build && sudo R CMD INSTALL . && cd ../../.. - export PATH=$PATH:/home/circleci/.local/bin/ pytest --nopercyfinalize --junitxml=test-reports/dashr.xml tests/integration/ - store_artifacts: path: test-reports diff --git a/CHANGELOG.md b/CHANGELOG.md index e6369863..95ff4705 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,9 +2,12 @@ All notable changes to `dash` will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). -## [1.0.0] - 2021-03-04 +## [1.0.0] - UNRELEASED +### Added +- Dash wrapper functions are included, which simplify the layout syntax for writing Dash apps. This includes the ability to pipe in the `app` object to layout and meta functions, as well as tags which simplify `html` component arguments and children. [#265](https://github.com/plotly/dashR/pull/265) + ### Changed -- Unify the core Dash packages (dash, dashCoreComponents, dashHtmlComponents, dashTable) for streamlined maintenance and accessibility. The namespaces of these packages will be combined under the `dash` namespace, and all artifacts from the ancillary dash packages will be included with Dash for R. [#243](https://github.com/plotly/dashr/pull/243) +- Unified the core Dash packages (dash, dashCoreComponents, dashHtmlComponents, dashTable) for streamlined maintenance and accessibility. The namespaces of these packages will be combined under the `dash` namespace, and all artifacts from the ancillary dash packages will be included with Dash for R. [#243](https://github.com/plotly/dashr/pull/243) ### Fixed - Minor fix for favicon issue continued from [#240](https://github.com/plotly/dashr/pull/240) (for more details, see [#243](https://github.com/plotly/dashR/pull/243#issuecomment-842813526)). diff --git a/DESCRIPTION b/DESCRIPTION index 59171370..57f99bbd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,8 @@ Imports: mime, crayon, brotli, - glue + glue, + magrittr Suggests: testthat License: MIT + file LICENSE diff --git a/NAMESPACE b/NAMESPACE index c8e3960b..2c1c3981 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,15 +1,34 @@ # Generated by roxygen2: do not edit by hand S3method(print,dash_component) +export("%>%") export(ALL) export(ALLSMALLER) export(Dash) export(MATCH) +export(add_meta) +export(add_script) +export(add_stylesheet) +export(br) +export(button) export(clientsideFunction) export(dashNoUpdate) +export(dash_app) +export(dash_tag) +export(div) +export(h1) +export(h2) +export(h3) +export(h4) +export(html) export(input) export(output) +export(p) +export(run_app) +export(set_layout) +export(span) export(state) +export(strong) importFrom(R6,R6Class) importFrom(assertthat,assert_that) importFrom(base64enc,base64encode) @@ -25,6 +44,7 @@ importFrom(htmltools,htmlDependencies) importFrom(htmltools,htmlDependency) importFrom(htmltools,renderDependencies) importFrom(jsonlite,toJSON) +importFrom(magrittr,"%>%") importFrom(reqres,default_parsers) importFrom(routr,Route) importFrom(routr,RouteStack) diff --git a/R/all_tags.R b/R/all_tags.R new file mode 100644 index 00000000..7da1b707 --- /dev/null +++ b/R/all_tags.R @@ -0,0 +1,135 @@ +## Generated by `scripts/generate_tags.R`; do not edit by hand +all_tags <- c( + "a", + "abbr", + "acronym", + "address", + "area", + "article", + "aside", + "audio", + "b", + "base", + "basefont", + "bdi", + "bdo", + "big", + "blink", + "blockquote", + "br", + "button", + "canvas", + "caption", + "center", + "cite", + "code", + "col", + "colgroup", + "command", + "content", + "data", + "datalist", + "dd", + "del", + "details", + "dfn", + "dialog", + "div", + "dl", + "dt", + "element", + "em", + "embed", + "fieldset", + "figcaption", + "figure", + "font", + "footer", + "form", + "frame", + "frameset", + "h1", + "h2", + "h3", + "h4", + "h5", + "h6", + "header", + "hgroup", + "hr", + "i", + "iframe", + "img", + "ins", + "isindex", + "kbd", + "keygen", + "label", + "legend", + "li", + "link", + "listing", + "main", + "map", + "mark", + "marquee", + "meta", + "meter", + "multicol", + "nav", + "nextid", + "nobr", + "noscript", + "object", + "ol", + "optgroup", + "option", + "output", + "p", + "param", + "picture", + "plaintext", + "pre", + "progress", + "q", + "rb", + "rp", + "rt", + "rtc", + "ruby", + "s", + "samp", + "script", + "section", + "select", + "shadow", + "slot", + "small", + "source", + "spacer", + "span", + "strike", + "strong", + "sub", + "summary", + "sup", + "table", + "tbody", + "td", + "template", + "textarea", + "tfoot", + "th", + "thead", + "time", + "title", + "tr", + "track", + "u", + "ul", + "var", + "video", + "wbr", + "xmp" +) +names(all_tags) <- all_tags diff --git a/R/tags.R b/R/tags.R new file mode 100644 index 00000000..a92afc8e --- /dev/null +++ b/R/tags.R @@ -0,0 +1,123 @@ +#' Create HTML tags +#' +#' Create an HTML tag to place in a Dash app layout. All tags are available +#' in the `html` list, and some common tags have shortcuts as functions for +#' convenience (e.g. `h1()` produces `

` and is equivalent to `html$h1()`). +#' +#' @name tags +#' @param ... Any named arguments become tag attributes, and any unnamed +#' arguments become children. A named argument with a value of `NULL` will +#' be removed, and a named argument with a value of `NA` will be rendered +#' as a boolean argument. See 'Special attributes' below for more information. +#' @param n_clicks (Numeric) An integer that represents the number of times +#' that this element has been clicked on. For advanced users only. +#' @param tag_name The name of the HTML tag. +#' @param content List of attributes and children. +#' +#' @section Special attributes: +#' There are a few HTML attributes that are treated in a special way: +#' - To add a `class` attribute, use the `className` parameter +#' - To add a `for` attribute, use the `htmlFor` parameter +#' - The `style` attribute is not provided as a string. Instead, it's provided +#' as a named list, where the name and value of each element correspond to the +#' CSS property and value. Each CSS property should be written in camelCase. +#' +#' @examples +#' app <- dash_app() +#' app %>% set_layout( +#' html$div( +#' h1( +#' "title", +#' style = list( +#' "color" = "red", +#' "backgroundColor" = "blue" +#' ) +#' ), +#' "some text", +#' button( +#' "can't click me", +#' disabled = NA, +#' className = "mybtn" +#' ) +#' ) +#' ) +#' app %>% run_app() +#' +NULL + +#' @rdname tags +#' @format NULL +#' @export +html <- lapply(all_tags, function(tag_name) { + rlang::new_function( + args = alist(... = , n_clicks = NULL), + body = rlang::expr({ + dash_tag(!!tag_name, list(...), n_clicks = n_clicks) + }), + env = asNamespace("dash") + ) +}) + +#' @rdname tags +#' @export +h1 <- html$h1 + +#' @rdname tags +#' @export +h2 <- html$h2 + +#' @rdname tags +#' @export +h3 <- html$h3 + +#' @rdname tags +#' @export +h4 <- html$h4 + +#' @rdname tags +#' @export +div <- html$div + +#' @rdname tags +#' @export +span <- html$span + +#' @rdname tags +#' @export +p <- html$p + +#' @rdname tags +#' @export +strong <- html$strong + +#' @rdname tags +#' @export +br <- html$br + +#' @rdname tags +#' @export +button <- html$button + +#' @rdname tags +#' @export +dash_tag <- function(tag_name, content = list(), n_clicks = NULL) { + content_names <- rlang::names2(content) + content_named_idx <- nzchar(content_names) + attributes <- remove_empty(content[content_named_idx]) + children <- unname(content[!content_named_idx]) + + # Support boolean attributes + attributes[is.na(attributes)] <- names(attributes[is.na(attributes)]) + attributes[attributes == ""] <- names(attributes[attributes == ""]) + + tag_params <- attributes + tag_params[["children"]] <- children + tag_params[["n_clicks"]] <- n_clicks + + dash_html_fx <- paste0("html", toupper(substring(tag_name, 1, 1)), substring(tag_name, 2)) + if (tag_name %in% c("map", "object")) { + dash_html_fx <- paste0(dash_html_fx, "El") + } + + do.call(getExportedValue("dash", dash_html_fx), tag_params) +} diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 00000000..fd0b1d13 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/R/utils.R b/R/utils.R index 70892f35..f04c8c4c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -423,12 +423,12 @@ assert_valid_callbacks <- function(output, params, func) { valid_wildcard_inputs <- sapply(inputs, function(x) { assertValidWildcards(x) }) - - + + valid_wildcard_state <- sapply(state, function(x) { assertValidWildcards(x) }) - + if(any(sapply(output, is.list))) { valid_wildcard_output <- sapply(output, function(x) { assertValidWildcards(x) @@ -439,7 +439,7 @@ assert_valid_callbacks <- function(output, params, func) { }) } - + # Check that outputs are not inputs # https://github.com/plotly/dash/issues/323 @@ -675,7 +675,7 @@ assertValidExternals <- function(scripts, stylesheets) { "rev") script_attributes <- character() stylesheet_attributes <- character() - + for (item in scripts) { if (is.list(item)) { if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$", @@ -713,10 +713,10 @@ assertValidExternals <- function(scripts, stylesheets) { stylesheet_attributes <- c(stylesheet_attributes, character(0)) } } - + invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs) invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs) - + if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) { stop(sprintf("The following script or stylesheet attributes are invalid: %s.", paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE) @@ -1031,7 +1031,7 @@ removeHandlers <- function(fnList) { setCallbackContext <- function(callback_elements) { # Set state elements for this callback - + if (length(callback_elements$state[[1]]) == 0) { states <- sapply(callback_elements$state, function(x) { setNames(list(x$value), paste(x$id, x$property, sep=".")) @@ -1043,7 +1043,7 @@ setCallbackContext <- function(callback_elements) { } else { states <- sapply(callback_elements$state, function(x) { states_vector <- unlist(x) - setNames(list(states_vector[grepl("value|value.", names(states_vector))]), + setNames(list(states_vector[grepl("value|value.", names(states_vector))]), paste(as.character(jsonlite::toJSON(x[[1]])), x$property, sep=".")) }) } @@ -1055,7 +1055,7 @@ setCallbackContext <- function(callback_elements) { input_id <- splitIdProp(x)[1] prop <- splitIdProp(x)[2] - # The following conditionals check whether the callback is a pattern-matching callback and if it has been triggered. + # The following conditionals check whether the callback is a pattern-matching callback and if it has been triggered. if (startsWith(input_id, "{")){ id_match <- vapply(callback_elements$inputs, function(x) { x <- unlist(x) @@ -1087,7 +1087,7 @@ setCallbackContext <- function(callback_elements) { } else { value <- sapply(callback_elements$inputs[id_match & prop_match], `[[`, "value") } - + return(list(`prop_id` = x, `value` = value)) } ) @@ -1536,3 +1536,38 @@ validate_keys <- function(string, is_template) { return(string) } } + +# Dash Layout Helper Functions + +#' Is the given object a Dash app? +#' @param x Any object. +is_dash_app <- function(x) { + inherits(x, "Dash") +} + +assert_dash <- function(x) { + if (!is_dash_app(x)) { + stop("You must provide a Dash app object (created with `dash::Dash$new()` or `dash::dash_app()`)", call. = FALSE) + } + invisible(TRUE) +} + +componentify <- function(x) { + if (asNamespace("dash")$is.component(x)) { + x + } else if (inherits(x, "shiny.tag") || inherits(x, "shiny.tag.list")) { + stop("dash: layout cannot include Shiny tags (you might have loaded the {shiny} package after loading {dash})", call. = FALSE) + } else if (is.list(x)) { + dash::htmlDiv(children = lapply(x, componentify)) + } else if (length(x) == 1) { + dash::htmlSpan(children = x) + } else if (is.null(x)) { + return(NULL) + } else { + stop("dash: layout must be a dash component or list of dash components", call. = FALSE) + } +} + +remove_empty <- function(x) { + Filter(Negate(is.null), x) +} diff --git a/R/wrappers.R b/R/wrappers.R new file mode 100644 index 00000000..7d18ae52 --- /dev/null +++ b/R/wrappers.R @@ -0,0 +1,268 @@ +# Dash 1.0 Layout Wrapper Functions (adapted from https://github.com/daattali/dash2) + +#' Create a Dash application +#' +#' This is a convenience function that returns a [`dash::Dash`] R6 object. +#' For advanced usage, you can use the object as an R6 object directly instead +#' of the functions provided by the `{dash}` package. +#' +#' @param title _(character)_ The browser window title. +#' @param update_title _(character)_ The browser window title while a callback +#' is being processed. Set to `NULL` or `""` if you don't want Dash to +#' automatically update the window title. +#' @param assets_folder _(character)_ Path (relative to the current working +#' directory) containing extra files to be served by the browser. All files +#' with ".js" or ".css" extensions will automatically be included on the page, +#' unless excluded with `assets_ignore`. Any other files, such as images, will +#' only be served if explicitly requested. +#' @param assets_url_path _(character)_ URL path for serving assets. For +#' example, a value of "www" means that any request path that begins with +#' "/www" will be mapped to the `assets_folder`. If your assets are hosted +#' online, you can provide a CDN URL, such as "http://your-assets-website". +#' @param assets_ignore _(character)_ Regular expression for ".js" and ".css" +#' files that should not be automatically included. Ignored files will still +#' be served if explicitly requested. Note that you cannot use this to +#' prevent access to sensitive files since ignored files are accessible +#' by users. +#' @param eager_loading _(logical)_ Whether asynchronous resources are +#' prefetched (`TRUE`) or loaded on-demand (`FALSE`). +#' @param serve_locally _(logical)_ Whether to serve HTML dependencies locally +#' or remotely (via URL). +#' @param pathname_url_base _(character)_ Local URL prefix to use app-wide. +#' @param pathname_routes_prefix _(character)_ Prefix applied to the backend +#' routes. Defaults to `pathname_url_base`. +#' @param pathname_requests_prefix _(character)_ Prefix applied to request +#' endpoints made by Dash's front-end. Defaults to `pathname_url_base`. +#' @param compress _(logical)_ Whether to try to compress files and data. If +#' `TRUE`, then `brotli` compression is attempted first, then `gzip`, then the +#' `deflate` algorithm, before falling back to identity. +#' @param suppress_callback_exceptions _(logical)_ Whether to relay warnings +#' about possible layout mis-specifications when registering a callback. +#' @param show_undo_redo _(logical)_ If `TRUE`, the app will have undo and redo +#' buttons for stepping through the history of the app state. +#' @seealso [`run_app()`] +#' @export +dash_app <- function(title = NULL, + update_title = "Updating...", + assets_folder = "assets", + assets_url_path = "/assets", + assets_ignore = NULL, + eager_loading = FALSE, + serve_locally = TRUE, + pathname_url_base = "/", + pathname_routes_prefix = NULL, + pathname_requests_prefix = NULL, + compress = TRUE, + suppress_callback_exceptions = FALSE, + show_undo_redo = FALSE) { + + if (is.null(assets_ignore)) { + assets_ignore <- "" + } + + app <- dash::Dash$new( + assets_folder = assets_folder, + assets_url_path = assets_url_path, + assets_ignore = assets_ignore, + eager_loading = eager_loading, + serve_locally = serve_locally, + url_base_pathname = pathname_url_base, + routes_pathname_prefix = pathname_routes_prefix, + requests_pathname_prefix = pathname_requests_prefix, + compress = compress, + suppress_callback_exceptions = suppress_callback_exceptions, + show_undo_redo = show_undo_redo, + update_title = update_title + ) + + if (!is.null(title)) { + app$title(title) + } + + invisible(app) +} + + +#' Add `` tags to a Dash app +#' +#' @param app A dash application created with [`dash_app()`]. +#' @param meta A single meta tag or a list of meta tags. Each meta tag is a +#' named list with two elements representing a meta tag. See examples below. +#' @examples +#' app <- dash_app() +#' +#' # Add a single meta tag +#' app %>% add_meta(list(name = "description", content = "My App")) +#' +#' # Add multiple meta tags +#' app %>% add_meta(list( +#' list(name = "keywords", content = "dash, analysis, graphs"), +#' list(name = "viewport", content = "width=device-width, initial-scale=1.0") +#' )) +#' @export +add_meta <- function(app, meta) { + assert_dash(app) + if (!is.list(meta[[1]])) { + meta <- list(meta) + } + app$.__enclos_env__$private$meta_tags <- c(app$.__enclos_env__$private$meta_tags, meta) + invisible(app) +} + + +#' Add external (CSS) stylesheets to a Dash app +#' +#' @param app A dash application created with [`dash_app()`]. +#' @param stylesheet A single stylesheet or a list of stylesheets. Each +#' stylesheet is either a string (the URL), or a named list with `href` (the +#' URL) and any other valid `` tag attributes. See examples below. +#' Note that this is only used to add **external** stylesheets, not local. +#' @examples +#' app <- dash_app() +#' +#' # Add a single stylesheet with URL +#' app %>% add_stylesheet("https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css") +#' +#' # Add multiple stylesheets with URL +#' app %>% add_stylesheet(list( +#' "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css", +#' "https://code.jquery.com/ui/1.12.1/themes/base/jquery-ui.css" +#' )) +#' +#' # Add a single stylesheet with a list +#' app %>% add_stylesheet( +#' list( +#' href = "https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css", +#' integrity = "sha384-+0n0xVW2eSR5OomGNYDnhzAbDsOXxcvSN1TPprVMTNDbiYZCxYbOOl7+AMvyTG2x" +#' ) +#' ) +#' +#' # Add multiple stylesheets with both URL and list +#' app %>% add_stylesheet( +#' list( +#' "https://code.jquery.com/ui/1.12.1/themes/base/jquery-ui.css", +#' "https://fonts.googleapis.com/css?family=Lora", +#' list( +#' href = "https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css", +#' integrity = "sha384-+0n0xVW2eSR5OomGNYDnhzAbDsOXxcvSN1TPprVMTNDbiYZCxYbOOl7+AMvyTG2x" +#' ) +#' ) +#' ) +#' @export +add_stylesheet <- function(app, stylesheet) { + assert_dash(app) + if (!is.list(stylesheet) || !is.null(names(stylesheet))) { + stylesheet <- list(stylesheet) + } + app$.__enclos_env__$self$config$external_stylesheets <- c(app$.__enclos_env__$self$config$external_stylesheets, stylesheet) + invisible(app) +} + + +#' Add external (JavaScript) scripts to a Dash app +#' +#' @param app A dash application created with [`dash_app()`] +#' @param script A single script or a list of scripts. Each script is either +#' a string (the URL), or a named list with `src` (the URL) and any other valid +#' `