Skip to content

Refactor DashR callbacks for increased parity with Dash for Python API #51

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 31 commits into from
Feb 20, 2019
Merged
Show file tree
Hide file tree
Changes from 27 commits
Commits
Show all changes
31 commits
Select commit Hold shift + click to select a range
87401c2
:hocho: some callback code, :hammer: for parity with Dash :snake:
Feb 5, 2019
1e37525
refactoring callbacks for parity with Dash for Python
Feb 12, 2019
f59842b
added assert_valid_callbacks
Feb 12, 2019
2a4962e
added call to assert_valid_callbacks
Feb 12, 2019
d0c4182
corrected missing function declaration
Feb 12, 2019
53d37ed
fix silly typo
Feb 12, 2019
5f89e80
Update README.md
rpkyle Feb 12, 2019
525bb76
Update DESCRIPTION
rpkyle Feb 13, 2019
4703fb0
:hammer: unify passing inputs and state
Feb 14, 2019
da17c59
:hocho: event
Feb 14, 2019
c6c4359
fixes for layout rendering
Feb 14, 2019
628e23e
replaced stray user_function with func
Feb 14, 2019
fc74849
replaced one more user_function with func
Feb 14, 2019
63bc0c3
added nested list check for state
Feb 14, 2019
dec6ddf
remove default arguments from id and property in helper fns
Feb 14, 2019
61feba5
validate that params contain only inputs or states
Feb 14, 2019
b88eb58
modified output_value
Feb 18, 2019
1db92b4
removed pointless unlist/cast to list
Feb 18, 2019
7032150
:white_check_mark: added check for input, state ordering
Feb 19, 2019
5951b2b
:bug: fixed check for valid_seq return value
Feb 19, 2019
db27e1a
Update README.md
rpkyle Feb 19, 2019
ebd11b1
Update README.md
rpkyle Feb 19, 2019
86e5268
Update README.md
rpkyle Feb 19, 2019
99c93ad
Update README.md
rpkyle Feb 19, 2019
b54e7aa
Update README.md
rpkyle Feb 19, 2019
1838f7b
Update README.md
rpkyle Feb 19, 2019
53fa11a
adjusting required version for deployment compatibility
Feb 20, 2019
7e51f91
:hocho: key field in dependency obj
Feb 20, 2019
313dff1
:hocho: key field in payload
Feb 20, 2019
f9c9174
:black_circle: wrap layout_render() in invisible
Feb 20, 2019
6cf95ff
add short comment to explain layout_render() behaviour
Feb 20, 2019
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 2 additions & 5 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
Package: dashR
Title: An interface to the dash ecosystem for authoring reactive web applications
Version: 0.0.1
Version: 0.0.2
Authors@R: c(person("Ryan", "Kyle", role = c("aut", "cre"), email = "[email protected]"), person("Carson", "Sievert", role = c("aut")))
Description: An interface to the dash ecosystem for authoring reactive web applications.
Depends:
R (>= 3.5)
R (>= 3.4)
Imports:
R6,
fiery (> 1.0.0),
Expand Down Expand Up @@ -37,6 +37,3 @@ RoxygenNote: 6.0.1.9000
Roxygen: list(markdown = TRUE)
URL: https://github.com/plotly/dashR
BugReports: https://github.com/plotly/dashR/issues
Remotes:
plotly/dash-html-components@R,
plotly/dash-core-components@R
1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@
S3method(print,dash_component)
export(Dash)
export(dash_css)
export(event)
export(heroku_app_deploy)
export(heroku_app_template)
export(input)
Expand Down
142 changes: 41 additions & 101 deletions R/dash.R
Original file line number Diff line number Diff line change
Expand Up @@ -188,6 +188,7 @@ Dash <- R6::R6Class(

dash_index <- routes_pathname_prefix
route$add_handler("get", dash_index, function(request, response, keys, ...) {

response$body <- private$.index
response$status <- 200L
response$type <- 'html'
Expand All @@ -196,6 +197,7 @@ Dash <- R6::R6Class(

dash_layout <- paste0(routes_pathname_prefix, "_dash-layout")
route$add_handler("get", dash_layout, function(request, response, keys, ...) {

lay <- private$layout_render()
response$body <- to_JSON(lay, pretty = TRUE)
response$status <- 200L
Expand All @@ -204,6 +206,7 @@ Dash <- R6::R6Class(
})

dash_deps <- paste0(routes_pathname_prefix, "_dash-dependencies")

route$add_handler("get", dash_deps, function(request, response, keys, ...) {

# dash-renderer wants an empty array when no dependencies exist (see python/01.py)
Expand All @@ -214,19 +217,16 @@ Dash <- R6::R6Class(
return(FALSE)
}

# client wants the mapping formatted this way -- https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L367-L378
outputs <- strsplit(names(private$callback_map), "\\.")
payload <- Map(function(x, y) {
# IMPORTANT: if state/events don't exist, dash-renderer wants them
# to be an empty array (i.e., null/missing won't work)
payload <- Map(function(callback_signature) {
list(
output = list(id = y[[1]], property = y[[2]]),
inputs = setNames(callback_inputs(x), NULL),
state = setNames(callback_states(x), NULL),
# Chris mentioned that events might/should be deprecated
events = setNames(callback_events(x), NULL)
output=callback_signature$output,
inputs=callback_signature$inputs,
state=callback_signature$state,
key=paste(callback_signature$output$id,
callback_signature$output$property,
sep='.')
)
}, private$callback_map, outputs)
}, private$callback_map)

response$body <- to_JSON(setNames(payload, NULL))
response$status <- 200L
Expand All @@ -236,7 +236,6 @@ Dash <- R6::R6Class(

dash_update <- paste0(routes_pathname_prefix, "_dash-update-component")
route$add_handler("post", dash_update, function(request, response, keys, ...) {

request <- request_parse_json(request)

if (!"output" %in% names(request$body)) {
Expand All @@ -248,41 +247,14 @@ Dash <- R6::R6Class(

# get the callback associated with this particular output
thisOutput <- with(request$body$output, paste(id, property, sep = "."))
callback <- private$callback_map[[thisOutput]]
callback <- private$callback_map[[thisOutput]][['func']]
if (!length(callback)) stop_report("Couldn't find output component.")
if (!is.function(callback)) {
stop(sprintf("Couldn't find a callback function associated with '%s'", thisOutput))
}

callback_args <- formals(callback)
if (length(callback_args)) {
get_key <- function(x) paste0(x[["id"]], ".", x[["property"]])
input_keys <- vapply(request$body$inputs, get_key, character(1))
state_keys <- vapply(request$body$states, get_key, character(1))

get_value <- function(x) getFromNamespace("simplify", "jsonlite")(x[["value"]])
input_values <- lapply(request$body$inputs, get_value)
state_values <- lapply(request$body$state, get_value)

client_values <- c(
setNames(input_values, input_keys),
setNames(state_values, state_keys)
)

get_dependency_key <- function(arg) {
val <- tryNULL(eval(arg))
if (is.dependency(val)) val[["key"]] else NA
}

callback_arg_keys <- sapply(callback_args, get_dependency_key)

# note that a modifyList() strategy throws away NULL args, which is WRONG
for (i in names(client_values)) {
callback_args[[match(i, callback_arg_keys)]] <- client_values[[i]]
}
}

output_value <- do.call(callback, args = as.list(callback_args))
callback_args <- lapply(c(request$body$inputs, request$body$state), `[[`, 3)
output_value <- do.call(callback, callback_args)

# have to format the response body like this
# https://github.com/plotly/dash/blob/064c811d/dash/dash.py#L562-L584
Expand All @@ -303,6 +275,7 @@ Dash <- R6::R6Class(
# https://plotly.slack.com/archives/D07PDTRK6/p1507657249000714?thread_ts=1505157408.000123&cid=D07PDTRK6
dash_suite <- paste0(routes_pathname_prefix, "_dash-component-suites")
route$add_handler("get", dash_suite, function(request, response, keys, ...) {

response$status <- 500L
response$body <- "Not yet implemented"
TRUE
Expand All @@ -328,6 +301,7 @@ Dash <- R6::R6Class(
},
layout_set = function(...) {
private$layout <- if (is.function(..1)) ..1 else list(...)
lay <- private$layout_render()
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This line confuses me a bit, although it might just be my misunderstanding of R. Where is lay being used?

  • Is this setting it to the class?
  • Does this also implicitly return lay?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also, why are we calling layout_render here? Could we leave a comment?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Currently, if you don't assign layout_render() to an object, it returns the layout, which will display in the console.

There are a couple ways I could handle this -- I can wrap the return in invisible, so that it silently returns the layout, which can be assigned to a new object. Or, I can add a silent option which is TRUE by default and let the app developer decide.

Copy link
Contributor Author

@rpkyle rpkyle Feb 20, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also, why are we calling layout_render here? Could we leave a comment?

I mentioned this last week, but I think it got lost in the shuffle. If we don't render the layout when it's set, I don't believe it will get rendered until a GET request occurs and is handled by routr unless layout_get(render=TRUE) is called.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

it returns the layout, which will display in the console.

Because if you didn't return the object but still needed to call private$layout_render(), the code would look like:

layout_set = function(...) {
       private$layout <- if (is.function(..1)) ..1 else list(...)
       private$layout_render()
}

which would actually return private$layout_render() (since it's the last line of the function).

But if we didn't need to call private$layout_render(), then the function would just be

layout_set = function(...) {
       private$layout <- if (is.function(..1)) ..1 else list(...)
}

which wouldn't return anything and be OK.

Am I understanding this correctly?

In Python, there is a convention to call "unused / do not care" arguments _ (https://hackernoon.com/understanding-the-underscore-of-python-309d1a029edc). Not sure if you can assign variables to _ in R or if R has that convention, but this codeblock might be easier for other folks to understand if it was written:

layout_set = function(...) {
       private$layout <- if (is.function(..1)) ..1 else list(...)
       # call layout_render() in order to  [...] but don't return its response
       _ <- private$layout_render()
}

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

anyway, this isn't blocking, just trying to understand things a bit better!

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, no worries -- I appreciate your questions because they often lead me to a better understanding of the way Dash works.

This line confuses me a bit, although it might just be my misunderstanding of R. Where is lay being used?

  • Is this setting it to the class?
  • Does this also implicitly return lay?

The code (which I've since modified) does not set class attributes or implicitly return lay since this line isn't the last one in the function. I've since wrapped layout_render() inside a call to invisible, which I think has the same effect as assignment to _ in Python. (I actually did not know about that, but it's a cool feature of which I should be aware.)

I've added a brief comment to explain what's happening here also.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yep, would be nice to understand at some point why this call is necessary (for that matter, I don't quite get why we have a nearly identical call on the Python side 😏) but thanks for making the intention clearer with invisible.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

fixed in f9c9174

Copy link
Contributor Author

@rpkyle rpkyle Feb 20, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Missed a question or two here:

which would actually return private$layout_render() (since it's the last line of the function).

Yes, that's right.

But if we didn't need to call private$layout_render(), then the function would just be

Yep, got it -- this line basically says if the first argument of ... is a function, assign it to layout, otherwise wrap all the arguments into a list and assign that into layout.

},

# ------------------------------------------------------------------------
Expand Down Expand Up @@ -374,55 +348,21 @@ Dash <- R6::R6Class(
# ------------------------------------------------------------------------
# callback registration
# ------------------------------------------------------------------------
callback = function(func = NULL, output = NULL) {

# argument type checking
assertthat::assert_that(is.function(func))
assertthat::assert_that(is.output(output))

# TODO: cache layouts so we don't have to do this for every callback...
layout <- private$layout_render()
if (identical(layout, welcome_page())) {
stop("The layout must be set before defining any callbacks", call. = FALSE)
}

# -----------------------------------------------------------------------
# verify that output/input/state IDs provided exists in the layout
# -----------------------------------------------------------------------
callbackInputs <- callback_inputs(func)
callbackStates <- callback_states(func)

callback_ids <- unlist(c(
output$id,
sapply(callbackInputs, "[[", "id"),
sapply(callbackStates, "[[", "id")
))
illegal_ids <- setdiff(callback_ids, private$layout_ids)
if (length(illegal_ids) && !private$suppress_callback_exceptions) {
warning(
sprintf(
"The following id(s) do not match any in the layout: '%s'",
paste(illegal_ids, collapse = "', '")
),
call. = FALSE
callback = function(output, params, func) {
assert_valid_callbacks(output, params, func)

inputs <- params[vapply(params, function(x) 'input' %in% attr(x, "class"), FUN.VALUE=logical(1))]
state <- params[vapply(params, function(x) 'state' %in% attr(x, "class"), FUN.VALUE=logical(1))]

# register the callback_map
private$callback_map[[paste(output$id, output$property, sep='.')]] <- list(
output=output,
inputs=inputs,
state=state,
func=func
)
}

# ----------------------------------------------------------------------
# verify that properties attached to output/inputs/state value are valid
# ----------------------------------------------------------------------
if (!private$suppress_callback_exceptions) {
validate_dependency(layout, output)
lapply(callbackInputs, function(i) validate_dependency(layout, i))
lapply(callbackStates, function(s) validate_dependency(layout, s))
}

# store the callback mapping/function so we may access it later
# https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L530-L546
private$callback_map[[output[["key"]]]] <- func
},


# ------------------------------------------------------------------------
# convenient fiery wrappers
# ------------------------------------------------------------------------
Expand Down Expand Up @@ -451,7 +391,7 @@ Dash <- R6::R6Class(
dependencies = list(),
dependencies_user = list(),
dependencies_internal = list(),

# layout stuff
layout = welcome_page(),
layout_ids = NULL,
Expand Down Expand Up @@ -513,21 +453,21 @@ Dash <- R6::R6Class(
# construct function name based on package name
fn_name <- paste0(".", pkg, "_js_metadata")
fn_summary <- getAnywhere(fn_name)

# ensure that the object refers to a function,
# and we are able to locate it somewhere
if (length(fn_summary$where) == 0) return(NULL)

if (mode(fn_summary$obj[[1]]) == "function") {
# function is available
dep_list <- do.call(fn_summary$obj[[1]], list())

return(dep_list)
} else {
return(NULL)
return(NULL)
}
})

deps_layout <- unlist(deps_layout, recursive=FALSE)

# if core components are used, but no coreGraph() exists,
Expand All @@ -545,7 +485,7 @@ Dash <- R6::R6Class(
# add on HTML dependencies we've identified by crawling the layout
private$dependencies <- c(private$dependencies, deps_layout)

# DashR's own dependencies
# DashR's own dependencies
private$dependencies_internal <- dashR:::.dashR_js_metadata()

# return the computed layout
Expand Down Expand Up @@ -592,6 +532,7 @@ Dash <- R6::R6Class(
# akin to https://github.com/plotly/dash-renderer/blob/master/dash_renderer/__init__.py
react_version_enabled= function() {
version <- private$dependencies_internal$react$version
return(version)
},
react_deps = function() {
deps <- private$dependencies_internal
Expand All @@ -600,11 +541,13 @@ Dash <- R6::R6Class(
react_versions = function() {
vapply(private$react_deps(), "[[", character(1), "version")
},

# akin to https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L338
# note discussion here https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L279-L284
.index = NULL,
index = function() {


# collect and resolve dependencies
depsAll <- compact(c(
private$react_deps()[private$react_versions() %in% private$react_version_enabled()],
Expand Down Expand Up @@ -663,9 +606,6 @@ Dash <- R6::R6Class(
)
)




# verify that properties attached to output/inputs/state value are valid
# @param layout
# @param component a component (should be a dependency)
Expand All @@ -689,16 +629,16 @@ validate_dependency <- function(layout, dependency) {
TRUE
}

assert_valid_wildcards <- function (...)
assert_valid_wildcards <- function (...)
{
args <- list(...)
validation_results <- lapply(args, function(x) {
grepl(c('^data-[a-zA-Z0-9]{1,}$|^aria-[a-zA-Z0-9]{1,}$'), x)
}
)
if(FALSE %in% validation_results) {
stop(sprintf("The following wildcards are not currently valid in DashR: '%s'",
paste((args)[grepl(FALSE, unlist(validation_results))],
stop(sprintf("The following wildcards are not currently valid in DashR: '%s'",
paste((args)[grepl(FALSE, unlist(validation_results))],
collapse=", ")), call. = FALSE)
} else {
return(args)
Expand Down
15 changes: 3 additions & 12 deletions R/dependencies.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@

#' @rdname dependencies
#' @export
output <- function(id = NULL, property = "children") {
output <- function(id, property) {
structure(
dependency(id, property),
class = c("dash_dependency", "output")
Expand All @@ -22,7 +22,7 @@ output <- function(id = NULL, property = "children") {

#' @rdname dependencies
#' @export
input <- function(id = NULL, property = "value") {
input <- function(id, property) {
structure(
dependency(id, property),
class = c("dash_dependency", "input")
Expand All @@ -31,22 +31,13 @@ input <- function(id = NULL, property = "value") {

#' @rdname dependencies
#' @export
state <- function(id = NULL, property = "value") {
state <- function(id, property) {
structure(
dependency(id, property),
class = c("dash_dependency", "state")
)
}

#' @rdname dependencies
#' @export
event <- function(id = NULL, property = "value") {
structure(
dependency(id, property),
class = c("dash_dependency", "event")
)
}

dependency <- function(id = NULL, property = NULL) {
if (is.null(id)) stop("Must specify an id", call. = FALSE)
list(
Expand Down
8 changes: 4 additions & 4 deletions R/internal.R
Original file line number Diff line number Diff line change
Expand Up @@ -48,11 +48,11 @@
all_files = FALSE),
class = "html_dependency"),
`dash-renderer` = structure(list(name = "dash-renderer",
version = "0.13.0",
src = list(href = "https://unpkg.com/dash-renderer@0.13.0",
file = "lib/dash-renderer@0.13.0"),
version = "0.18.0",
src = list(href = "https://unpkg.com/dash-renderer@0.18.0",
file = "lib/dash-renderer@0.18.0"),
meta = NULL,
script = "dash_renderer/bundle.js",
script = "dash_renderer/dash_renderer.min.js",
stylesheet = NULL,
head = NULL,
attachment = NULL,
Expand Down
Loading