From 61db4ee6558ffc9f8387f9a760aaffa37574480a Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 13:39:21 -0400 Subject: [PATCH 1/9] Tag updates --- R/tags.R | 28 ++++++++++++++++++++++------ R/wrappers.R | 9 ++++++++- 2 files changed, 30 insertions(+), 7 deletions(-) diff --git a/R/tags.R b/R/tags.R index a92afc8e..1f29ab26 100644 --- a/R/tags.R +++ b/R/tags.R @@ -9,8 +9,6 @@ #' 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. #' @@ -21,6 +19,10 @@ #' - 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. +#' - A special property `n_clicks` is automatically added to every HTML tag. +#' This property represents the number of times that this element has been +#' clicked on. If not explicitly initialized to a certain integer, its default +#' value is `NULL` initially. #' #' @examples #' app <- dash_app() @@ -50,9 +52,9 @@ NULL #' @export html <- lapply(all_tags, function(tag_name) { rlang::new_function( - args = alist(... = , n_clicks = NULL), + args = alist(... = ), body = rlang::expr({ - dash_tag(!!tag_name, list(...), n_clicks = n_clicks) + dash_tag(!!tag_name, list(...)) }), env = asNamespace("dash") ) @@ -100,19 +102,33 @@ button <- html$button #' @rdname tags #' @export -dash_tag <- function(tag_name, content = list(), n_clicks = NULL) { +a <- html$a + +#' @rdname tags +#' @export +img <- html$img + +#' @rdname tags +#' @export +dash_tag <- function(tag_name, content = list()) { content_names <- rlang::names2(content) content_named_idx <- nzchar(content_names) attributes <- remove_empty(content[content_named_idx]) children <- unname(content[!content_named_idx]) + # Try to match the exact level of nesting of children as original {dash} + if (length(children) == 0) { + children <- NULL + } else if (length(children) == 1) { + children <- children[[1]] + } + # 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")) { diff --git a/R/wrappers.R b/R/wrappers.R index 7d18ae52..94669ccd 100644 --- a/R/wrappers.R +++ b/R/wrappers.R @@ -223,7 +223,7 @@ add_script <- function(app, script) { #' app %>% set_layout("Conditional UI using an if statement: ", #' if (TRUE) "rendered", #' if (FALSE) "not rendered") -#' app %>% set_layout(function() { htmlDiv(children = list(htmlDiv("hello"), "Dash")) }) +#' app %>% set_layout(function() { div("Current time: ", Sys.time()) }) #' @export set_layout <- function(app, ...) { assert_dash(app) @@ -266,3 +266,10 @@ run_app <- function(app, } app$run_server(host = host, port = port) } + +#' Run a Dash app when explicitly printed to the console +#' @export +#' @keywords internal +print.Dash <- function(x, ...) { + run_app(x) +} From bff0caaf6c6c608edfd95cd1f8c06b1422458525 Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 13:39:56 -0400 Subject: [PATCH 2/9] Added RStudio dash snippet --- R/install_snippet.R | 146 +++++++++++++++++++++++++++++++++++++++ inst/rstudio/snippet.txt | 20 ++++++ 2 files changed, 166 insertions(+) create mode 100644 R/install_snippet.R create mode 100644 inst/rstudio/snippet.txt diff --git a/R/install_snippet.R b/R/install_snippet.R new file mode 100644 index 00000000..d883a48a --- /dev/null +++ b/R/install_snippet.R @@ -0,0 +1,146 @@ +#' Install Dash RStudio snippet +#' +#' Install the Dash code snippet for RStudio, for quickly creating a new Dash +#' app. +#' +#' @return boolean Whether or not the snippet was installed +#' @export +install_snippet <- function() { + # Modified code from https://stackoverflow.com/a/62223103/3943160 (user 'dario') + + added <- FALSE + + # if not on RStudio or RStudioServer exit + if (!nzchar(Sys.getenv("RSTUDIO_USER_IDENTITY"))) { + return(NULL) + } + + # Name of files containing snippet code to copy + # + pckgSnippetsFiles <- "snippet.txt" + + # Name of files to copy into. Order has to be the same + # as in 'pckgSnippetsFiles' + # + rstudioSnippetsFiles <- "r.snippets" + + # Path to directory for RStudios user files depends on OS + # + if (rstudioapi::getVersion() < "1.3") { + rstudioSnippetsPathBase <- file.path(path.expand('~'),".R", "snippets") + } else { + if (.Platform$OS.type == "windows") { + rstudioSnippetsPathBase <- file.path(Sys.getenv("APPDATA"), "RStudio", "snippets") + } else { + rstudioSnippetsPathBase <- file.path(path.expand('~'), ".config/rstudio", "snippets") + } + } + + # Read each file in pckgSnippetsFiles and add its contents + # + for (i in seq_along(pckgSnippetsFiles)) { + + # Try to get template, if template is not found skip it + # + pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "dash2") + if (pckgSnippetsFilesPath == "") { + next() + } + + # load package snippets definitions + # + pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath, warn = FALSE) + + # Extract names of package snippets + # + pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)] + + + # Construct path for destination file + # + rstudioSnippetsFilePath <- file.path(rstudioSnippetsPathBase, rstudioSnippetsFiles[i]) + + # If targeted RStudios user file does not exist, raise error (otherwise we would 'remove') + # the default snippets from the 'user file' + # + if (!file.exists(rstudioSnippetsFilePath)) { + stop(paste0( "'", rstudioSnippetsFilePath, "' does not exist yet\n.", + "Use RStudio -> Tools -> Global Options -> Code -> Edit Snippets\n", + "To initalize user defined snippets file by adding dummy snippet\n")) + } + + # Extract 'names' of already existing snitppets + # + rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath, warn = FALSE) + rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)] + + # replace two spaces with tab, ONLY at beginning of string + # + pckgSnippetsFileContentSanitized <- gsub("(?:^ {2})|\\G {2}|\\G\t", "\t", pckgSnippetsFileContent, perl = TRUE) + + # find defintions appearing in packageSnippets but not in rstudioSnippets + # if no snippets are missing go to next file + # + snippetsToCopy <- setdiff(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions)) + snippetsNotToCopy <- intersect(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions)) + if (length(snippetsToCopy) == 0) { + # cat(paste0("(\nFollowing snippets will NOT be added because there is already a snippet with that name: ", + # paste0(snippetsNotToCopy, collapse=", ") ,")")) + next() + } + + # Inform user about changes, ask to confirm action + # + if (interactive()) { + cat(paste0("You are about to add the following ", length(snippetsToCopy), + " snippets to '", rstudioSnippetsFilePath, "':\n", + paste0(paste0("-", snippetsToCopy), collapse="\n"))) + if (length(snippetsNotToCopy) > 0) { + cat(paste0("\n(The following snippets will NOT be added because there is already a snippet with that name:\n", + paste0(snippetsNotToCopy, collapse=", ") ,")")) + } + answer <- readline(prompt="Do you want to proceed (y/n): ") + if (substr(answer, 1, 1) == "n") { + next() + } + } + + # Create list of line numbers where snippet definitons start + # This list is used to determine the end of each definition block + # + allPckgSnippetDefinitonStarts <- grep("^snippet .*", pckgSnippetsFileContentSanitized) + + for (s in snippetsToCopy) { + startLine <- grep(paste0("^", s, ".*"), pckgSnippetsFileContentSanitized) + + # Find last line of snippet definition: + # First find start of next defintion and return + # previous line number or lastline if already in last definiton + # + endLine <- allPckgSnippetDefinitonStarts[allPckgSnippetDefinitonStarts > startLine][1] -1 + if (is.na(endLine)) { + endLine <- length(pckgSnippetsFileContentSanitized) + } + + snippetText <- paste0(pckgSnippetsFileContentSanitized[startLine:endLine], collapse = "\n") + + # Make sure there is at least one empty line between entries + # + if (tail(readLines(rstudioSnippetsFilePath, warn = FALSE), n=1) != "") { + snippetText <- paste0("\n", snippetText) + } + + # Append snippet block, print message + # + cat(paste0(snippetText, "\n"), file = rstudioSnippetsFilePath, append = TRUE) + cat(paste0("* Added '", s, "' to '", rstudioSnippetsFilePath, "'\n")) + added <- TRUE + } + } + + if (added) { + cat("Restart RStudio to use new snippets") + } + + invisible(added) +} diff --git a/inst/rstudio/snippet.txt b/inst/rstudio/snippet.txt new file mode 100644 index 00000000..be7afa53 --- /dev/null +++ b/inst/rstudio/snippet.txt @@ -0,0 +1,20 @@ +snippet dashapp + library(dash) + + app <- dash_app() + + app %>% set_layout( + ${1} + ) + + app %>% add_callback( + outputs = output(${2}), + params = list( + input(${3}) + ), + function(${4}) { + ${5} + } + ) + + app %>% run_app() From 02d41f9ac4c3cdd7292f64bad3c385b1671b7eed Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 13:40:12 -0400 Subject: [PATCH 3/9] Added simple_table --- R/simple_table.R | 56 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100644 R/simple_table.R diff --git a/R/simple_table.R b/R/simple_table.R new file mode 100644 index 00000000..2dcb85a0 --- /dev/null +++ b/R/simple_table.R @@ -0,0 +1,56 @@ +#' Simple HTML table +#' +#' @param data A data.frame +#' @param colnames _(logical)_ Whether or not to show the column names (a header row) +#' @param rownames _(logical)_ Whether or not to show the row names +#' @examples +#' app <- dash_app() %>% +#' set_layout( +#' dash::dccChecklist( +#' id = "table_params", +#' labelStyle = list(display = "block"), +#' options = list( +#' list(label = "Header", value = "colnames"), +#' list(label = "Row names", value = "rownames") +#' ) +#' ), +#' br(), +#' div(id = "table") +#' ) +#' +#' app %>% add_callback( +#' output(id = 'table', property = 'children'), +#' input(id = 'table_params', property = 'value'), +#' function(val) { +#' simple_table(mtcars, colnames = "colnames" %in% val, rownames = "rownames" %in% val) +#' } +#' ) +#' +#' app %>% run_app() +#' @export +simple_table <- function(data, colnames = TRUE, rownames = FALSE) { + if (!is.data.frame(data)) { + stop("simple_table: `data` must be a data.frame", call. = FALSE) + } + if (ncol(data) == 0) { + return(NULL) + } + + header <- NULL + if (isTRUE(colnames) && !is.null(colnames(data))) { + header <- lapply(colnames(data), html$th) + if (isTRUE(rownames)) { + header <- c(list(html$th("")), header) + } + header <- html$tr(header) + } + + rows <- lapply(seq(nrow(data)), function(rownum) { + row <- lapply(as.character(data[rownum, ]), html$td) + if (isTRUE(rownames)) { + row <- c(list(html$td(rownames(data[rownum, ]))), row) + } + html$tr(row) + }) + html$table(c(list(header), rows)) +} From 7bf1c19c696673a05a89a872849677c2ae9c510a Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 13:40:28 -0400 Subject: [PATCH 4/9] Added flexible callbacks --- R/callbacks-advanced.R | 190 +++++++++++++++++++++++++++++++++++++++++ R/utils.R | 1 + 2 files changed, 191 insertions(+) create mode 100644 R/callbacks-advanced.R diff --git a/R/callbacks-advanced.R b/R/callbacks-advanced.R new file mode 100644 index 00000000..35238286 --- /dev/null +++ b/R/callbacks-advanced.R @@ -0,0 +1,190 @@ +#' Add a callback to a Dash app +#' +#' @param app A dash application created with [`dash_app()`]. +#' @export +add_callback <- function(app, outputs, params, callback) { + if (inherits(params, "dash_dependency")) { + params <- list(params) + } + + params_flat <- flatten(params) + + # determine if the callback arguments match the first level of parameters + cb_args <- methods::formalArgs(callback) + if (length(cb_args) != length(params)) { + stop("add_callback: Number of params does not match the number of arguments in the callback function", call. = FALSE) + } + if (!is.null(names(params))) { + if (!setequal(cb_args, names(params))) { + stop("add_callback: Arguments in callback do not match the names of the params", + call. = FALSE) + } + } + + cb <- function(...) { + callback_params <- eval(substitute(alist(...))) + + # the callback moves states to the end after inputs, so we need to fix the positions + state_idx <- which(unlist(lapply(params_flat, function(x) inherits(x, "state")))) + num_states <- length(state_idx) + if (num_states > 0) { + num_inputs <- length(callback_params) - num_states + for (i in seq_len(num_states)) { + idx <- num_inputs + i + callback_params <- append(callback_params, callback_params[[idx]], state_idx[i] - 1) + callback_params <- callback_params[-(idx + 1)] + } + } + + callback_params <- params_to_keys(callback_params, params) + do.call(callback, callback_params) + } + + app$callback( + output = outputs, + params = params_flat, + func = cb + ) + invisible(app) +} + +# test <- list( +# ab = list( +# input("a", "value"), +# state("b", "value") +# ), +# cdef = list( +# cde = list( +# input("c", "value"), +# state("d", "value"), +# input("e", "value") +# ), +# f = input("f", "value") +# ), +# g = input("g", "value") +# ) +# str(flatten(test)) +flatten <- function(x) { + if (!inherits(x, "list")) return(list(x)) + + key_names <- rlang::names2(x) + key_names_exist <- nzchar(key_names) + if (all(key_names_exist)) { + if (any(duplicated(key_names))) { + stop("Named params must have unique names", call. = FALSE) + } + x <- unname(x) + } else if (any(key_names_exist)) { + stop("Cannot mix named and unnamed params", call. = FALSE) + } + + unlist(lapply(x, flatten), recursive = FALSE) +} + +# test <- list( +# ab = list( +# input("a", "value"), +# state("b", "value") +# ), +# cdef = list( +# cde = list( +# input("c", "value"), +# state("d", "value"), +# input("e", "value") +# ), +# f = input("f", "value") +# ), +# g = input("g", "value") +# ) +# str(params_to_keys(as.list(LETTERS[1:7]), test)) +params_to_keys <- function(params, keys) { + params_to_key_helper <- function(keys) { + for (item_idx in seq_along(keys)) { + if (inherits(keys[[item_idx]], "dash_dependency")) { + keys[[item_idx]] <- params[[1]] + params <<- params[-1] + } else { + keys[[item_idx]] <- params_to_key_helper(keys[[item_idx]]) + } + } + keys + } + params_to_key_helper(keys) +} + +#' In addition to event properties like n_clicks that change whenever an event +#' happens there is a global variable dash$callback_context, available only +#' inside a callback. It has properties: +#' +#' `triggered`: list of changed properties. This will be empty on initial load, +#' unless an input prop got its value from another initial callback. After a user +#' action it is a length-1 list, unless two properties of a single component +#' update simultaneously, such as a value and a timestamp or event counter. +#' +#' `inputs` and `states`: allow you to access the callback params by id and prop +#' instead of through the function arguments. +#' +#' @examples +#' dash_app() %>% +#' set_layout( +#' button('Button 1', id='btn1'), +#' button('Button 2', id='btn2'), +#' button('Button 3', id='btn3'), +#' div(id='container') +#' ) %>% +#' add_callback( +#' output("container", "children"), +#' list( +#' input("btn1", "n_clicks"), +#' input("btn2", "n_clicks"), +#' input("btn3", "n_clicks") +#' ), +#' function(btn1, btn2, btn3) { +#' ctx <- callback_context() +#' prevent_update(is.null(ctx)) +#' sprintf("Triggered: %s, btn1: %s, btn2: %s, btn3: %s", +#' ctx$triggered$prop_id, btn1, btn2, btn3) +#' } +#' ) %>% +#' run_app() +#' @export +callback_context <- function() { + get("app", envir = parent.frame(2))$callback_context() +} + +#' Prevent a callback from updating its output +#' +#' When used inside Dash callbacks, if any of the arguments evaluate to `TRUE`, +#' then the callback's outputs do not update. +#' +#' @param ... Values to check +#' @examples +#' app <- dash_app() +#' +#' app %>% set_layout( +#' button('Click here', id = 'btn'), +#' p('The number of times the button was clicked does not update when the number is divisible by 5'), +#' div(id = 'body-div') +#' ) +#' app %>% add_callback( +#' output(id='body-div', property='children'), +#' list( +#' input(id='btn', property='n_clicks') +#' ), +#' function(n_clicks) { +#' prevent_update(is.null(n_clicks[[1]]), n_clicks[[1]] %% 5 == 0) +#' paste(n_clicks[[1]], "clicks") +#' } +#' ) +#' +#' app %>% run_app() +#' +#' @export +prevent_update <- function(...) { + checks <- unlist(list(...)) + if (any(checks)) { + rlang::eval_bare(rlang::expr(invisible(return(structure(list(NULL), class = "no_update")))) , env = parent.frame()) + } else { + return() + } +} diff --git a/R/utils.R b/R/utils.R index f04c8c4c..4fcecf76 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1558,6 +1558,7 @@ componentify <- function(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)) { + x <- remove_empty(x) dash::htmlDiv(children = lapply(x, componentify)) } else if (length(x) == 1) { dash::htmlSpan(children = x) From 9a2f8a2bf5e7e44017e932e061df5486a4d361b1 Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 13:50:12 -0400 Subject: [PATCH 5/9] Documentation and NAMESPACE updates --- NAMESPACE | 8 ++++++++ man/add_callback.Rd | 14 +++++++++++++ man/callback_context.Rd | 44 +++++++++++++++++++++++++++++++++++++++++ man/dash_app.Rd | 2 +- man/install_snippet.Rd | 15 ++++++++++++++ man/prevent_update.Rd | 37 ++++++++++++++++++++++++++++++++++ man/print.Dash.Rd | 12 +++++++++++ man/set_layout.Rd | 2 +- man/simple_table.Rd | 43 ++++++++++++++++++++++++++++++++++++++++ man/tags.Rd | 35 +++++++++++++++++++------------- 10 files changed, 196 insertions(+), 16 deletions(-) create mode 100644 man/add_callback.Rd create mode 100644 man/callback_context.Rd create mode 100644 man/install_snippet.Rd create mode 100644 man/prevent_update.Rd create mode 100644 man/print.Dash.Rd create mode 100644 man/simple_table.Rd diff --git a/NAMESPACE b/NAMESPACE index 2c1c3981..abf6b9c4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,16 +1,20 @@ # Generated by roxygen2: do not edit by hand +S3method(print,Dash) S3method(print,dash_component) export("%>%") export(ALL) export(ALLSMALLER) export(Dash) export(MATCH) +export(a) +export(add_callback) export(add_meta) export(add_script) export(add_stylesheet) export(br) export(button) +export(callback_context) export(clientsideFunction) export(dashNoUpdate) export(dash_app) @@ -21,11 +25,15 @@ export(h2) export(h3) export(h4) export(html) +export(img) export(input) +export(install_snippet) export(output) export(p) +export(prevent_update) export(run_app) export(set_layout) +export(simple_table) export(span) export(state) export(strong) diff --git a/man/add_callback.Rd b/man/add_callback.Rd new file mode 100644 index 00000000..560dcbb7 --- /dev/null +++ b/man/add_callback.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callbacks-advanced.R +\name{add_callback} +\alias{add_callback} +\title{Add a callback to a Dash app} +\usage{ +add_callback(app, outputs, params, callback) +} +\arguments{ +\item{app}{A dash application created with \code{\link[=dash_app]{dash_app()}}.} +} +\description{ +Add a callback to a Dash app +} diff --git a/man/callback_context.Rd b/man/callback_context.Rd new file mode 100644 index 00000000..11e18b1a --- /dev/null +++ b/man/callback_context.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callbacks-advanced.R +\name{callback_context} +\alias{callback_context} +\title{In addition to event properties like n_clicks that change whenever an event +happens there is a global variable dash$callback_context, available only +inside a callback. It has properties:} +\usage{ +callback_context() +} +\description{ +\code{triggered}: list of changed properties. This will be empty on initial load, +unless an input prop got its value from another initial callback. After a user +action it is a length-1 list, unless two properties of a single component +update simultaneously, such as a value and a timestamp or event counter. +} +\details{ +\code{inputs} and \code{states}: allow you to access the callback params by id and prop +instead of through the function arguments. +} +\examples{ +dash_app() \%>\% + set_layout( + button('Button 1', id='btn1'), + button('Button 2', id='btn2'), + button('Button 3', id='btn3'), + div(id='container') + ) \%>\% + add_callback( + output("container", "children"), + list( + input("btn1", "n_clicks"), + input("btn2", "n_clicks"), + input("btn3", "n_clicks") + ), + function(btn1, btn2, btn3) { + ctx <- callback_context() + prevent_update(is.null(ctx)) + sprintf("Triggered: \%s, btn1: \%s, btn2: \%s, btn3: \%s", + ctx$triggered$prop_id, btn1, btn2, btn3) + } + ) \%>\% + run_app() +} diff --git a/man/dash_app.Rd b/man/dash_app.Rd index ab39045c..e755810c 100644 --- a/man/dash_app.Rd +++ b/man/dash_app.Rd @@ -24,7 +24,7 @@ dash_app( \item{title}{\emph{(character)} The browser window title.} \item{update_title}{\emph{(character)} The browser window title while a callback -is being processed. Set to \code{NULL} or \verb{”"} if you don't want Dash to +is being processed. Set to \code{NULL} or \code{""} if you don't want Dash to automatically update the window title.} \item{assets_folder}{\emph{(character)} Path (relative to the current working diff --git a/man/install_snippet.Rd b/man/install_snippet.Rd new file mode 100644 index 00000000..b5262612 --- /dev/null +++ b/man/install_snippet.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/install_snippet.R +\name{install_snippet} +\alias{install_snippet} +\title{Install Dash RStudio snippet} +\usage{ +install_snippet() +} +\value{ +boolean Whether or not the snippet was installed +} +\description{ +Install the Dash code snippet for RStudio, for quickly creating a new Dash +app. +} diff --git a/man/prevent_update.Rd b/man/prevent_update.Rd new file mode 100644 index 00000000..e55cd28c --- /dev/null +++ b/man/prevent_update.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/callbacks-advanced.R +\name{prevent_update} +\alias{prevent_update} +\title{Prevent a callback from updating its output} +\usage{ +prevent_update(...) +} +\arguments{ +\item{...}{Values to check} +} +\description{ +When used inside Dash callbacks, if any of the arguments evaluate to \code{TRUE}, +then the callback's outputs do not update. +} +\examples{ +app <- dash_app() + +app \%>\% set_layout( + button('Click here', id = 'btn'), + p('The number of times the button was clicked does not update when the number is divisible by 5'), + div(id = 'body-div') +) +app \%>\% add_callback( + output(id='body-div', property='children'), + list( + input(id='btn', property='n_clicks') + ), + function(n_clicks) { + prevent_update(is.null(n_clicks[[1]]), n_clicks[[1]] \%\% 5 == 0) + paste(n_clicks[[1]], "clicks") + } +) + +app \%>\% run_app() + +} diff --git a/man/print.Dash.Rd b/man/print.Dash.Rd new file mode 100644 index 00000000..f85018c8 --- /dev/null +++ b/man/print.Dash.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{print.Dash} +\alias{print.Dash} +\title{Run a Dash app when explicitly printed to the console} +\usage{ +\method{print}{Dash}(x, ...) +} +\description{ +Run a Dash app when explicitly printed to the console +} +\keyword{internal} diff --git a/man/set_layout.Rd b/man/set_layout.Rd index 43d85c16..a4e68c36 100644 --- a/man/set_layout.Rd +++ b/man/set_layout.Rd @@ -26,5 +26,5 @@ app \%>\% set_layout(list(div("hello"), "Dash")) app \%>\% set_layout("Conditional UI using an if statement: ", if (TRUE) "rendered", if (FALSE) "not rendered") -app \%>\% set_layout(function() { htmlDiv(children = list(htmlDiv("hello"), "Dash")) }) +app \%>\% set_layout(function() { div("Current time: ", Sys.time()) }) } diff --git a/man/simple_table.Rd b/man/simple_table.Rd new file mode 100644 index 00000000..f10e6c83 --- /dev/null +++ b/man/simple_table.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simple_table.R +\name{simple_table} +\alias{simple_table} +\title{Simple HTML table} +\usage{ +simple_table(data, colnames = TRUE, rownames = FALSE) +} +\arguments{ +\item{data}{A data.frame} + +\item{colnames}{\emph{(logical)} Whether or not to show the column names (a header row)} + +\item{rownames}{\emph{(logical)} Whether or not to show the row names} +} +\description{ +Simple HTML table +} +\examples{ +app <- dash_app() \%>\% + set_layout( + dash::dccChecklist( + id = "table_params", + labelStyle = list(display = "block"), + options = list( + list(label = "Header", value = "colnames"), + list(label = "Row names", value = "rownames") + ) + ), + br(), + div(id = "table") + ) + +app \%>\% add_callback( + output(id = 'table', property = 'children'), + input(id = 'table_params', property = 'value'), + function(val) { + simple_table(mtcars, colnames = "colnames" \%in\% val, rownames = "rownames" \%in\% val) + } +) + +app \%>\% run_app() +} diff --git a/man/tags.Rd b/man/tags.Rd index 294be4a2..a7c2e52e 100644 --- a/man/tags.Rd +++ b/man/tags.Rd @@ -14,32 +14,38 @@ \alias{strong} \alias{br} \alias{button} +\alias{a} +\alias{img} \alias{dash_tag} \title{Create HTML tags} \usage{ html -h1(..., n_clicks = NULL) +h1(...) -h2(..., n_clicks = NULL) +h2(...) -h3(..., n_clicks = NULL) +h3(...) -h4(..., n_clicks = NULL) +h4(...) -div(..., n_clicks = NULL) +div(...) -span(..., n_clicks = NULL) +span(...) -p(..., n_clicks = NULL) +p(...) -strong(..., n_clicks = NULL) +strong(...) -br(..., n_clicks = NULL) +br(...) -button(..., n_clicks = NULL) +button(...) -dash_tag(tag_name, content = list(), n_clicks = NULL) +a(...) + +img(...) + +dash_tag(tag_name, content = list()) } \arguments{ \item{...}{Any named arguments become tag attributes, and any unnamed @@ -47,9 +53,6 @@ arguments become children. A named argument with a value of \code{NULL} will be removed, and a named argument with a value of \code{NA} will be rendered as a boolean argument. See 'Special attributes' below for more information.} -\item{n_clicks}{(Numeric) An integer that represents the number of times -that this element has been clicked on. For advanced users only.} - \item{tag_name}{The name of the HTML tag.} \item{content}{List of attributes and children.} @@ -68,6 +71,10 @@ There are a few HTML attributes that are treated in a special way: \item The \code{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. +\item A special property \code{n_clicks} is automatically added to every HTML tag. +This property represents the number of times that this element has been +clicked on. If not explicitly initialized to a certain integer, its default +value is \code{NULL} initially. } } From f8db9ab6e4d06aa59ce1b02672246f3ae14d0c64 Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Mon, 27 Sep 2021 14:27:59 -0400 Subject: [PATCH 6/9] Updated DESCRIPTION --- DESCRIPTION | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 57f99bbd..2b24d61f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,10 @@ Imports: crayon, brotli, glue, - magrittr + magrittr, + methods, + rlang, + utils Suggests: testthat License: MIT + file LICENSE From 180fe5a4fae4fbf8e056101f1e5b80d4d0a42448 Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Tue, 28 Sep 2021 18:08:54 -0400 Subject: [PATCH 7/9] Adding unittests --- R/install_snippet.R | 2 +- tests/testthat/test-dash.R | 106 ++++++++++++++++++++- tests/testthat/test-layout.R | 180 ++++++++++++++++++++++++++++++++++- tests/testthat/test-tags.R | 39 ++++++++ tests/testthat/test-utils.R | 68 +++++++++++++ 5 files changed, 391 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/test-tags.R create mode 100644 tests/testthat/test-utils.R diff --git a/R/install_snippet.R b/R/install_snippet.R index d883a48a..89dc651e 100644 --- a/R/install_snippet.R +++ b/R/install_snippet.R @@ -42,7 +42,7 @@ install_snippet <- function() { # Try to get template, if template is not found skip it # - pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "dash2") + pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "dash") if (pckgSnippetsFilesPath == "") { next() } diff --git a/tests/testthat/test-dash.R b/tests/testthat/test-dash.R index b764dc23..49a52508 100644 --- a/tests/testthat/test-dash.R +++ b/tests/testthat/test-dash.R @@ -13,9 +13,9 @@ test_that("Can set/get layout", { d <- Dash$new() div <- htmlDiv("A div", id = "An id") d$layout(div) - + l <- d$layout_get() - + # dynamic layouts d$layout(function() { htmlDiv("A div", id = "An id") }) l2 <- d$layout_get() @@ -23,3 +23,105 @@ test_that("Can set/get layout", { expect_is(d$layout_get(render = FALSE), "function") }) + +# Simplified dash_app syntax unittests + +test_that("add_meta", { + + get_meta <- function(app) { + app$.__enclos_env__$private$meta_tags + } + + meta1 <- list(name = "keywords", content = "foo, analysis, graphs") + meta2 <- list(name = "viewport", content = "width=device-width, initial-scale=1.0") + + expect_error(add_meta(meta1)) + expect_identical( + dash_app() %>% add_meta(meta1) %>% get_meta(), + Dash$new(meta_tags = list(meta1)) %>% get_meta() + ) + expect_identical( + dash_app() %>% add_meta(meta1) %>% get_meta(), + dash_app() %>% add_meta(list(meta1)) %>% get_meta() + ) + expect_identical( + dash_app() %>% add_meta(list(meta1, meta2)) %>% get_meta(), + Dash$new(meta_tags = list(meta1, meta2)) %>% get_meta() + ) + expect_identical( + dash_app() %>% add_meta(meta1) %>% add_meta(meta2) %>% get_meta(), + dash_app() %>% add_meta(list(meta1, meta2)) %>% get_meta() + ) +}) + +test_that("add_stylesheet", { + + get_sheets <- function(app) { + app$.__enclos_env__$self$config$external_stylesheets + } + + sheet_simple1 <- "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" + sheet_simple2 <- "https://code.jquery.com/ui/1.12.1/themes/base/jquery-ui.css" + sheet_full <- list( + href = "https://cdn.jsdelivr.net/npm/bootstrap@5.0.1/dist/css/bootstrap.min.css", + integrity = "sha384-+0n0xVW2eSR5OomGNYDnhzAbDsOXxcvSN1TPprVMTNDbiYZCxYbOOl7+AMvyTG2x" + ) + + expect_error(add_stylesheet(sheet_simple1)) + expect_identical( + dash_app() %>% add_stylesheet(sheet_simple1) %>% get_sheets(), + Dash$new(external_stylesheets = list(sheet_simple1)) %>% get_sheets() + ) + expect_identical( + dash_app() %>% add_stylesheet(sheet_simple1) %>% get_sheets(), + dash_app() %>% add_stylesheet(list(sheet_simple1)) %>% get_sheets() + ) + expect_identical( + dash_app() %>% add_stylesheet(list(sheet_simple1, sheet_simple2)) %>% get_sheets(), + Dash$new(external_stylesheets = list(sheet_simple1, sheet_simple2)) %>% get_sheets() + ) + expect_identical( + dash_app() %>% add_stylesheet(sheet_full) %>% get_sheets(), + Dash$new(external_stylesheets = list(sheet_full)) %>% get_sheets() + ) + expect_identical( + dash_app() %>% add_stylesheet(list(sheet_simple1, sheet_simple2)) %>% add_stylesheet(sheet_full) %>% get_sheets(), + Dash$new(external_stylesheets = list(sheet_simple1, sheet_simple2, sheet_full)) %>% get_sheets() + ) +}) + +test_that("add_script", { + + get_scripts <- function(app) { + app$.__enclos_env__$self$config$external_scripts + } + + script_simple1 <- "https://stackpath.bootstrapcdn.com/bootstrap/4.4.1/js/bootstrap.min.js" + script_simple2 <- "https://cdnjs.cloudflare.com/ajax/libs/jquery/3.6.0/jquery.min.js" + script_full <- list( + src = "https://stackpath.bootstrapcdn.com/bootstrap/4.4.1/js/bootstrap.min.js", + integrity = "sha384-wfSDF2E50Y2D1uUdj0O3uMBJnjuUD4Ih7YwaYd1iqfktj0Uod8GCExl3Og8ifwB6" + ) + + expect_error(add_script(script_simple1)) + expect_identical( + dash_app() %>% add_script(script_simple1) %>% get_scripts(), + Dash$new(external_scripts = list(script_simple1)) %>% get_scripts() + ) + expect_identical( + dash_app() %>% add_script(script_simple1) %>% get_scripts(), + dash_app() %>% add_script(list(script_simple1)) %>% get_scripts() + ) + expect_identical( + dash_app() %>% add_script(list(script_simple1, script_simple2)) %>% get_scripts(), + Dash$new(external_scripts = list(script_simple1, script_simple2)) %>% get_scripts() + ) + expect_identical( + dash_app() %>% add_script(script_full) %>% get_scripts(), + Dash$new(external_scripts = list(script_full)) %>% get_scripts() + ) + expect_identical( + dash_app() %>% add_script(list(script_simple1, script_simple2)) %>% add_script(script_full) %>% get_scripts(), + Dash$new(external_scripts = list(script_simple1, script_simple2, script_full)) %>% get_scripts() + ) +}) diff --git a/tests/testthat/test-layout.R b/tests/testthat/test-layout.R index 4844c69d..043ce3fb 100644 --- a/tests/testthat/test-layout.R +++ b/tests/testthat/test-layout.R @@ -16,7 +16,185 @@ test_that("app$layout() only accepts components, or functions that return compon expect_error( app$layout(htmlA(id = "a"), htmlA(id = "a")), - 'unused argument (htmlA(id = "a"))', + 'unused argument (htmlA(id = "a"))', fixed = TRUE) }) + +# Simplified layout syntax unittests + +test_app <- dash_app() +set_get_layout_new <- function(..., app = test_app) set_layout(app, ...)$layout_get() +set_get_layout_old <- function(..., app = test_app) { app$layout(...); app$layout_get() } + +test_that("Can set empty layout, couldn't before", { + expect_error(set_get_layout_new(), NA) + expect_error(set_get_layout_old()) +}) + +test_that("Layout errors", { + expect_error(set_get_layout_new("test", app = "not a dash app")) + expect_error(set_get_layout_new(foo = "test")) + expect_error(set_get_layout_new(div("one"), h2("two"), id = "test")) +}) + +test_that("Layout basics", { + expect_identical( + set_get_layout_new(div("one"), h2("two")), + set_get_layout_old(dash::htmlDiv(list( + dash::htmlDiv("one"), dash::htmlH2("two") + ))) + ) + expect_identical(set_get_layout_new("one", "two"), set_get_layout_new(list("one", "two"))) + expect_identical( + set_get_layout_new(function() div("one", "two")), + set_get_layout_old(function() dash::htmlDiv(list("one", "two"))) + ) +}) + +test_that("set_layout replaces previous layout", { + expect_identical( + (dash_app() %>% set_layout("foo") %>% set_layout("bar"))$layout_get(), + (dash_app() %>% set_layout("bar"))$layout_get() + ) +}) + +test_that("NULL layout elements", { + expect_identical( + set_get_layout_new("one", if (TRUE) "two", "three"), + set_get_layout_new("one", "two", "three") + ) + expect_identical( + set_get_layout_new("one", if (FALSE) "two", "three"), + set_get_layout_new("one", "three") + ) +}) + +test_that("No need to place everything in containers and lists", { + expect_error(set_get_layout_new("test"), NA) + expect_error(set_get_layout_old("test")) + expect_identical( + set_get_layout_new(div("one", "two")), + set_get_layout_old(dash::htmlDiv(list("one", "two"))) + ) + expect_identical(set_get_layout_new("test"), set_get_layout_old(dash::htmlSpan("test"))) + expect_identical( + set_get_layout_new("one", 5, TRUE), + set_get_layout_old(dash::htmlDiv(list( + dash::htmlSpan("one"), + dash::htmlSpan(5), + dash::htmlSpan(TRUE) + ))) + ) +}) + +test_that("Function as layout works", { + app1 <- Dash$new() + set.seed(1000) + # Need to move to the next random int because the function version of layout + # runs the code in the layout once before requesting the layout_get() + runif(1) + set_layout(app1, div(runif(1))) + app1_layout1 <- app1$layout_get() + app1_layout2 <- app1$layout_get() + expect_identical(app1_layout1, app1_layout2) + app2 <- Dash$new() + set.seed(1000) + runif(1) + app2$layout(dash::htmlDiv(runif(1))) + app2_layout <- app2$layout_get() + expect_identical(app1_layout1, app2_layout) + + app1_fx <- Dash$new() + set.seed(1000) + set_layout(app1_fx, function() div(runif(1))) + app1_fx_layout1 <- app1_fx$layout_get() + app1_fx_layout2 <- app1_fx$layout_get() + expect_identical(app1_layout1, app1_fx_layout1) + expect_false(identical(app1_fx_layout1, app1_fx_layout2)) + app2_fx <- Dash$new() + set.seed(1000) + app2_fx$layout(function() dash::htmlDiv(runif(1))) + app2_fx_layout1 <- app2_fx$layout_get() + app2_fx_layout2 <- app2_fx$layout_get() + expect_identical(app1_fx_layout1, app2_fx_layout1) + expect_identical(app1_fx_layout2, app2_fx_layout2) +}) + +test_that("Sample apps layout are identical with the compact syntax", { + expect_identical( + set_get_layout_old( + dash::htmlDiv(list( + dash::htmlDiv('Dash To-Do List'), + dash::dccInput(id = 'new-item'), + dash::htmlButton("Add", id = "add"), + dash::htmlButton("Clear Done", id = "clear-done"), + dash::htmlDiv(id = "list-container"), + dash::htmlDiv(id = "totals") + )) + ), + + set_get_layout_new( + div('Dash To-Do List'), + dash::dccInput(id = 'new-item'), + button("Add", id = "add"), + button("Clear Done", id = "clear-done"), + div(id = "list-container"), + div(id = "totals") + ) + ) + + expect_identical( + set_get_layout_old( + dash::htmlDiv( + list( + dash::htmlH1('Hello Dash'), + dash::htmlDiv(children = "Dash: A web application framework for R."), + dash::dccGraph( + figure=list( + data=list( + list( + x=list(1, 2, 3), + y=list(4, 1, 2), + type='bar', + name='SF' + ), + list( + x=list(1, 2, 3), + y=list(2, 4, 5), + type='bar', + name='Montreal' + ) + ), + layout = list(title='Dash Data Visualization') + ) + ) + ) + ) + ), + + set_get_layout_new( + h1('Hello Dash'), + div("Dash: A web application framework for R."), + dash::dccGraph( + figure=list( + data=list( + list( + x=list(1, 2, 3), + y=list(4, 1, 2), + type='bar', + name='SF' + ), + list( + x=list(1, 2, 3), + y=list(2, 4, 5), + type='bar', + name='Montreal' + ) + ), + layout = list(title='Dash Data Visualization') + ) + ) + ) + ) +}) diff --git a/tests/testthat/test-tags.R b/tests/testthat/test-tags.R new file mode 100644 index 00000000..33978464 --- /dev/null +++ b/tests/testthat/test-tags.R @@ -0,0 +1,39 @@ +test_that("Tag basics", { + expect_identical(div("a", "b"), dash::htmlDiv(list("a", "b"))) + expect_identical(div("a", "b", 5), dash::htmlDiv(list("a", "b", 5))) + expect_identical(div("a", "b", 5, id = "test"), dash::htmlDiv(list("a", "b", 5), id = "test")) + expect_identical( + span("a", 5, id = "test", "b", className = "foo"), + dash::htmlSpan(list("a", 5, "b"), id = "test", className = "foo") + ) + expect_identical( + div(span("test"), dash::dccInput("input")), + dash::htmlDiv(list(dash::htmlSpan("test"), dash::dccInput("input"))) + ) +}) + +test_that("No children", { + expect_identical(div(), dash::htmlDiv()) + expect_identical(div(list()), dash::htmlDiv(children = list())) + expect_false(identical(div(), div(list()))) + expect_identical(div(id = "test"), dash::htmlDiv(id = "test")) +}) + +test_that("Illegal attributes", { + expect_error(div(foo = "test")) + expect_error(div(download = "download")) + expect_error(a(download = "download"), NA) +}) + +test_that("Single child is not a list", { + expect_identical(div("a"), dash::htmlDiv("a")) + expect_false(identical(div("a"), div(list("a")))) + expect_identical(div(list("a", "b")), dash::htmlDiv(list("a", "b"))) +}) + +test_that("Boolean and NULL attributes", { + expect_identical(div(hidden = NA)$props$hidden, "hidden") + expect_identical(div(hidden = "")$props$hidden, "hidden") + expect_identical(div(hidden = "test")$props$hidden, "test") + expect_null(div(hidden = NULL)$props$hidden) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 00000000..4a905c08 --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,68 @@ +test_that("remove_empty", { + expect_error(remove_empty()) + expect_null(remove_empty(NULL)) + expect_identical(remove_empty(c(NULL, "A", "B")), c("A", "B")) + expect_identical(remove_empty(c(NULL, NULL)), c()) + expect_identical(remove_empty(list(NULL, "A", "B")), list("A", "B")) + expect_identical(remove_empty(list(NULL, "A", NULL, "B")), list("A", "B")) + expect_identical(remove_empty(list(NULL, NULL)), list()) +}) + +test_that("assert_dash", { + expect_error(assert_dash()) + expect_error(assert_dash(NULL)) + expect_error(assert_dash("string")) + expect_true(assert_dash(Dash$new())) + expect_true(assert_dash(dash_app())) + expect_true(assert_dash(set_layout(dash_app(), "test"))) +}) + +test_that("componentify basics", { + expect_error(componentify()) + expect_error(componentify(mtcars)) + expect_error(componentify(c("foo", "bar"))) + expect_null(componentify(NULL)) + expect_identical( + componentify(div("foo")), + div("foo") + ) + expect_identical( + componentify(dash::dccInput("foo", "bar")), + dash::dccInput("foo", "bar") + ) +}) + +test_that("componentify simple child", { + expect_identical( + componentify(10), + span(10) + ) + expect_identical( + componentify("foo"), + span("foo") + ) + expect_identical( + componentify(TRUE), + span(TRUE) + ) +}) + +test_that("componentify list", { + expect_identical( + componentify(list("foo", "bar")), + div(span("foo"), span("bar")) + ) + expect_identical( + componentify(list("foo", "bar")), + div(span("foo"), span("bar")) + ) + expect_identical( + componentify(list("foo", dash::dccInput("foo", "bar"), 10, div("bar"))), + div( + span("foo"), + dash::dccInput("foo", "bar"), + span(10), + div("bar") + ) + ) +}) From ebebe9091807e491d029882f929f48534b0c2add Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Tue, 28 Sep 2021 18:35:51 -0400 Subject: [PATCH 8/9] Adding context tags to tests --- tests/testthat/test-tags.R | 2 ++ tests/testthat/test-utils.R | 2 ++ 2 files changed, 4 insertions(+) diff --git a/tests/testthat/test-tags.R b/tests/testthat/test-tags.R index 33978464..6d37307e 100644 --- a/tests/testthat/test-tags.R +++ b/tests/testthat/test-tags.R @@ -1,3 +1,5 @@ +context("tags") + test_that("Tag basics", { expect_identical(div("a", "b"), dash::htmlDiv(list("a", "b"))) expect_identical(div("a", "b", 5), dash::htmlDiv(list("a", "b", 5))) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 4a905c08..d52d5043 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,3 +1,5 @@ +context("utils") + test_that("remove_empty", { expect_error(remove_empty()) expect_null(remove_empty(NULL)) From 7815fd4326beeb0691e7a08085d49bce4e063e76 Mon Sep 17 00:00:00 2001 From: Hammad Khan Date: Wed, 29 Sep 2021 11:16:33 -0400 Subject: [PATCH 9/9] Updated CHANGELOG --- CHANGELOG.md | 4 +++- tests/manual/callbacks-simple.R | 23 ++++++++++++++++++ tests/manual/dash-simple-app-dynamic-ui.R | 29 +++++++++++++++++++++++ tests/manual/dash-simple-app.R | 29 +++++++++++++++++++++++ 4 files changed, 84 insertions(+), 1 deletion(-) create mode 100644 tests/manual/callbacks-simple.R create mode 100644 tests/manual/dash-simple-app-dynamic-ui.R create mode 100644 tests/manual/dash-simple-app.R diff --git a/CHANGELOG.md b/CHANGELOG.md index e8eacf13..82cd4a0a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,9 @@ This project adheres to [Semantic Versioning](http://semver.org/). ## [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) +- Dash layout 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) + +- Added simplified and flexible callbacks with the `add_callback` helper function. Included in this change are multiple additional helper functions to simplify Dash app configuration and tag usage. [#270](https://github.com/plotly/dashR/pull/270) ### Changed - 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) diff --git a/tests/manual/callbacks-simple.R b/tests/manual/callbacks-simple.R new file mode 100644 index 00000000..53b267c6 --- /dev/null +++ b/tests/manual/callbacks-simple.R @@ -0,0 +1,23 @@ +library(dash) + +dash_app() %>% + set_layout( + dash::dccInput(id = "text", "sample"), + div("CAPS: ", span(id = "out1")), + div("small: ", span(id = "out2")) + ) %>% + add_callback( + list( + output("out1", "children"), + output("out2", "children") + ), + input("text", "value"), + function(text) { + list( + toupper(text), + tolower(text) + ) + } + ) %>% + run_app() + diff --git a/tests/manual/dash-simple-app-dynamic-ui.R b/tests/manual/dash-simple-app-dynamic-ui.R new file mode 100644 index 00000000..0cc3e5a3 --- /dev/null +++ b/tests/manual/dash-simple-app-dynamic-ui.R @@ -0,0 +1,29 @@ +library(dash) + +app <- dash_app("test app") +app %>% set_layout(function() {div( + h1('Hello Dash'), + "Dash: A web application framework for R.", + br(), + "Time: ", as.character(Sys.time()), + dccGraph( + figure=list( + data=list( + list( + x=list(1, 2, 3), + y=list(4, 1, 2), + type='bar', + name='SF' + ), + list( + x=list(1, 2, 3), + y=list(2, 4, 5), + type='bar', + name='Montr\U{00E9}al' + ) + ), + layout = list(title='Dash Data Visualization') + ) + )) +}) +app %>% run_app() diff --git a/tests/manual/dash-simple-app.R b/tests/manual/dash-simple-app.R new file mode 100644 index 00000000..820ef18c --- /dev/null +++ b/tests/manual/dash-simple-app.R @@ -0,0 +1,29 @@ +library(dash) + +app <- dash_app("test app") +app %>% set_layout(div( + h1('Hello Dash'), + "Dash: A web application framework for R.", + br(), + "Time: ", as.character(Sys.time()), + dccGraph( + figure=list( + data=list( + list( + x=list(1, 2, 3), + y=list(4, 1, 2), + type='bar', + name='SF' + ), + list( + x=list(1, 2, 3), + y=list(2, 4, 5), + type='bar', + name='Montr\U{00E9}al' + ) + ), + layout = list(title='Dash Data Visualization') + ) + )) +) +app %>% run_app()