From cff1b4561cb52485ac0b6c823a6f19d00a0ea272 Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Wed, 16 Oct 2019 10:29:44 -0400 Subject: [PATCH 1/7] use KeepSource to retrieve internal srcrefs --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 9a7f5c78..57db7519 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,6 +37,7 @@ Remotes: plotly/dash-html-components@17da1f4, License: MIT + file LICENSE Encoding: UTF-8 LazyData: true +KeepSource: true RoxygenNote: 6.1.1 Roxygen: list(markdown = TRUE) URL: https://github.com/plotly/dashR From 2776612b57815eeea9215f6260f5a081bceed69a Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Wed, 16 Oct 2019 10:30:53 -0400 Subject: [PATCH 2/7] :sparkles: support line #s when in debug mode --- R/dash.R | 10 +++++----- R/utils.R | 56 +++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 51 insertions(+), 15 deletions(-) diff --git a/R/dash.R b/R/dash.R index 00ad4c6f..29ac4501 100644 --- a/R/dash.R +++ b/R/dash.R @@ -525,18 +525,18 @@ Dash <- R6::R6Class( private$updateReloadHash() private$index() - viewer <- getOption("viewer") + show_viewer <- !(is.null(getOption("viewer"))) && (dynGet("show_viewer") == TRUE) host <- dynGet("host") port <- dynGet("port") app_url <- paste0("http://", host, ":", port) - if (!is.null(viewer) && host %in% c("localhost", "127.0.0.1")) + if (show_viewer && host %in% c("localhost", "127.0.0.1")) rstudioapi::viewer(app_url) - else { + else if (show_viewer) { warning("RStudio viewer not supported; ensure that host is 'localhost' or '127.0.0.1' and that you are using RStudio to run your app. Opening default browser...") utils::browseURL(app_url) - } + } }) # user-facing fields @@ -611,7 +611,7 @@ Dash <- R6::R6Class( port = Sys.getenv('DASH_PORT', 8050), block = TRUE, showcase = FALSE, - viewer = FALSE, + show_viewer = FALSE, dev_tools_prune_errors = TRUE, debug = FALSE, dev_tools_ui = NULL, diff --git a/R/utils.R b/R/utils.R index cafabb1b..aa68e97e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -684,7 +684,7 @@ encode_plotly <- function(layout_objs) { # so that it is pretty printed to stderr() printCallStack <- function(call_stack, header=TRUE) { if (header) { - write(crayon::yellow$bold(" ### DashR Traceback (most recent/innermost call last) ###"), stderr()) + write(crayon::yellow$bold(" ### Dash for R Traceback (most recent/innermost call last) ###"), stderr()) } write( crayon::white( @@ -694,7 +694,9 @@ printCallStack <- function(call_stack, header=TRUE) { call_stack ), ": ", - call_stack + call_stack, + " ", + lapply(call_stack, attr, "lineref") ) ), stderr() @@ -707,7 +709,7 @@ stackTraceToHTML <- function(call_stack, if(is.null(call_stack)) { return(NULL) } - header <- " ### DashR Traceback (most recent/innermost call last) ###" + header <- " ### Dash for R Traceback (most recent/innermost call last) ###" formattedStack <- c(paste0( " ", @@ -716,6 +718,8 @@ stackTraceToHTML <- function(call_stack, ), ": ", call_stack, + " ", + lapply(call_stack, attr, "lineref"), collapse="
" ) ) @@ -761,7 +765,17 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { } functionsAsList <- lapply(calls, function(completeCall) { - currentCall <- completeCall[[1]] + # avoid attempting to cast closures as strings, which will fail + # some calls in the stack are symbol (name) objects, while others + # are calls, which must be deparsed; the first element in the vector + # should be the function signature + if (is.name(completeCall[[1]])) + currentCall <- as.character(completeCall[[1]]) + else if (is.call(completeCall[[1]])) + currentCall <- deparse(completeCall)[1] + else + currentCall <- completeCall[[1]] + attr(currentCall, "lineref") <- getLineWithError(completeCall, formatted=TRUE) if (is.function(currentCall) & !is.primitive(currentCall)) { constructedCall <- paste0(" function(", @@ -773,7 +787,7 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { } }) - + if (prune_errors) { # this line should match the last occurrence of the function # which raised the error within the call stack; prune here @@ -813,18 +827,16 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { functionsAsList <- removeHandlers(functionsAsList) } - # use deparse in case the call throwing the error is a symbol, - # since this cannot be "printed" without deparsing the call warning(call. = FALSE, immediate. = TRUE, sprintf("Execution error in %s: %s", - deparse(functionsAsList[[length(functionsAsList)]]), + functionsAsList[[length(functionsAsList)]], conditionMessage(e))) stack_message <- stackTraceToHTML(functionsAsList, - deparse(functionsAsList[[length(functionsAsList)]]), + functionsAsList[[length(functionsAsList)]], conditionMessage(e)) assign("stack_message", value=stack_message, - envir=sys.frame(1)$private) + envir=sys.frame(countEnclosingEnvs("private"))$private) printCallStack(functionsAsList) } @@ -836,8 +848,24 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { ) } else { evalq(expr) + } +} + +getLineWithError <- function(currentCall, formatted=TRUE) { + srcref <- attr(currentCall, "srcref", exact = TRUE) + if (!is.null(srcref) & !(getAppPath()==FALSE)) { + # filename + srcfile <- attr(srcref, "srcfile", exact = TRUE) + # line number + if (formatted) { + crayon::yellow$italic(sprintf('Line %s in %s', srcref[[1]], srcfile$filename)) + } else { + sprintf('Line %s in %s', srcref[[1]], srcfile$filename) } + } else { + "" } +} # This helper function drops error # handling functions from the call @@ -969,6 +997,14 @@ setModtimeAsAttr <- function(path) { } } +countEnclosingEnvs <- function(object) { + for (i in 1:sys.nframe()) { + objs <- ls(envir=sys.frame(i)) + if (object %in% objs) + return(i) + } +} + changedAssets <- function(before, after) { # identify files that used to exist in the asset map, # but which have been removed From f91b85f050097a28aa4338a5c9e782aee6e51e5e Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Wed, 16 Oct 2019 10:33:48 -0400 Subject: [PATCH 3/7] rename to countEnclosingFrames --- R/utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index aa68e97e..4b24dc4e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -836,7 +836,7 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { conditionMessage(e)) assign("stack_message", value=stack_message, - envir=sys.frame(countEnclosingEnvs("private"))$private) + envir=sys.frame(countEnclosingFrames("private"))$private) printCallStack(functionsAsList) } @@ -997,7 +997,7 @@ setModtimeAsAttr <- function(path) { } } -countEnclosingEnvs <- function(object) { +countEnclosingFrames <- function(object) { for (i in 1:sys.nframe()) { objs <- ls(envir=sys.frame(i)) if (object %in% objs) From 23cc3148d6067412f11eeb332af8a954562969ee Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Wed, 16 Oct 2019 11:56:56 -0400 Subject: [PATCH 4/7] capture fmt/unfmt versions for stack message --- R/utils.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 4b24dc4e..6de5de02 100644 --- a/R/utils.R +++ b/R/utils.R @@ -696,7 +696,7 @@ printCallStack <- function(call_stack, header=TRUE) { ": ", call_stack, " ", - lapply(call_stack, attr, "lineref") + lapply(call_stack, attr, "flineref") ) ), stderr() @@ -775,7 +775,9 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { currentCall <- deparse(completeCall)[1] else currentCall <- completeCall[[1]] - attr(currentCall, "lineref") <- getLineWithError(completeCall, formatted=TRUE) + + attr(currentCall, "flineref") <- getLineWithError(completeCall, formatted=TRUE) + attr(currentCall, "lineref") <- getLineWithError(completeCall, formatted=FALSE) if (is.function(currentCall) & !is.primitive(currentCall)) { constructedCall <- paste0(" function(", From 674347a01c596da1030e08c56f6c2bc74745bccc Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Wed, 16 Oct 2019 12:06:43 -0400 Subject: [PATCH 5/7] rename show_viewer to use_viewer --- R/dash.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/dash.R b/R/dash.R index 29ac4501..1b074b1c 100644 --- a/R/dash.R +++ b/R/dash.R @@ -525,15 +525,15 @@ Dash <- R6::R6Class( private$updateReloadHash() private$index() - show_viewer <- !(is.null(getOption("viewer"))) && (dynGet("show_viewer") == TRUE) + use_viewer <- !(is.null(getOption("viewer"))) && (dynGet("use_viewer") == TRUE) host <- dynGet("host") port <- dynGet("port") app_url <- paste0("http://", host, ":", port) - if (show_viewer && host %in% c("localhost", "127.0.0.1")) + if (use_viewer && host %in% c("localhost", "127.0.0.1")) rstudioapi::viewer(app_url) - else if (show_viewer) { + else if (use_viewer) { warning("RStudio viewer not supported; ensure that host is 'localhost' or '127.0.0.1' and that you are using RStudio to run your app. Opening default browser...") utils::browseURL(app_url) } @@ -611,7 +611,7 @@ Dash <- R6::R6Class( port = Sys.getenv('DASH_PORT', 8050), block = TRUE, showcase = FALSE, - show_viewer = FALSE, + use_viewer = FALSE, dev_tools_prune_errors = TRUE, debug = FALSE, dev_tools_ui = NULL, From d4d4f2e084864b21a6d009ea2446641f175d2e8b Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Thu, 17 Oct 2019 11:03:47 -0400 Subject: [PATCH 6/7] :necktie: fix whitespace --- R/utils.R | 54 +++++++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/R/utils.R b/R/utils.R index 6de5de02..2493cbe5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -769,13 +769,13 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { # some calls in the stack are symbol (name) objects, while others # are calls, which must be deparsed; the first element in the vector # should be the function signature - if (is.name(completeCall[[1]])) + if (is.name(completeCall[[1]])) currentCall <- as.character(completeCall[[1]]) - else if (is.call(completeCall[[1]])) + else if (is.call(completeCall[[1]])) currentCall <- deparse(completeCall)[1] else currentCall <- completeCall[[1]] - + attr(currentCall, "flineref") <- getLineWithError(completeCall, formatted=TRUE) attr(currentCall, "lineref") <- getLineWithError(completeCall, formatted=FALSE) @@ -789,7 +789,7 @@ getStackTrace <- function(expr, debug = FALSE, prune_errors = TRUE) { } }) - + if (prune_errors) { # this line should match the last occurrence of the function # which raised the error within the call stack; prune here @@ -865,7 +865,7 @@ getLineWithError <- function(currentCall, formatted=TRUE) { sprintf('Line %s in %s', srcref[[1]], srcfile$filename) } } else { - "" + "" } } @@ -968,12 +968,12 @@ getAppPath <- function() { cmd_args <- commandArgs(trailingOnly = FALSE) file_argument <- "--file=" matched_arg <- grep(file_argument, cmd_args) - + # if app is instantiated via Rscript, cmd_args should contain path if (length(matched_arg) > 0) { # Rscript return(normalizePath(sub(file_argument, "", cmd_args[matched_arg]))) - } + } # if app is instantiated via source(), sys.frames should contain path else if (!is.null(sys.frames()[[1]]$ofile)) { return(normalizePath(sys.frames()[[1]]$ofile)) @@ -1009,23 +1009,23 @@ countEnclosingFrames <- function(object) { changedAssets <- function(before, after) { # identify files that used to exist in the asset map, - # but which have been removed + # but which have been removed deletedElements <- before[which(is.na(match(before, after)))] - + # identify files which were added since the last refresh addedElements <- after[which(is.na(match(after, before)))] - + # identify any items that have been updated since the last # refresh based on modification time attributes set in map - # + # # in R, attributes are discarded when subsetting, so it's # necessary to subset the attributes being compared instead. # here we only compare objects which overlap before_modtimes <-attributes(before)$modtime[before %in% after] after_modtimes <- attributes(after)$modtime[after %in% before] - + changedElements <- after[which(after_modtimes > before_modtimes)] - + if (length(deletedElements) == 0) { deletedElements <- NULL } @@ -1043,13 +1043,13 @@ changedAssets <- function(before, after) { ) } -dashLogger <- function(event = NULL, - message = NULL, - request = NULL, - time = Sys.time(), +dashLogger <- function(event = NULL, + message = NULL, + request = NULL, + time = Sys.time(), ...) { orange <- crayon::make_style("orange") - + # dashLogger is being called from within fiery, and the Fire() object generator # is called from a private method within the Dash() R6 class; this makes # accessing variables set within Dash's private fields somewhat complicated @@ -1057,22 +1057,22 @@ dashLogger <- function(event = NULL, # the following line retrieves the value of the silence_route_logging parameter, # which is nearly 20 frames up the stack; if it's not found, we'll assume FALSE silence_routes_logging <- dynGet("self", ifnotfound = FALSE)$config$silence_routes_logging - + if (!is.null(event)) { msg <- sprintf("%s: %s", event, message) - - msg <- switch(event, error = crayon::red(msg), warning = crayon::yellow(msg), + + msg <- switch(event, error = crayon::red(msg), warning = crayon::yellow(msg), message = crayon::blue(msg), msg) - + # assign the status group for color coding if (event == "request") { - status_group <- as.integer(cut(request$respond()$status, + status_group <- as.integer(cut(request$respond()$status, breaks = c(100, 200, 300, 400, 500, 600), right = FALSE)) - - msg <- switch(status_group, crayon::blue$bold(msg), crayon::green$bold(msg), + + msg <- switch(status_group, crayon::blue$bold(msg), crayon::green$bold(msg), crayon::cyan$bold(msg), orange$bold(msg), crayon::red$bold(msg)) } - + # if log messages are suppressed, report only server stop/start messages, errors, and warnings # otherwise, print everything to console if (event %in% c("start", "stop", "error", "warning") || !(silence_routes_logging)) { @@ -1081,7 +1081,7 @@ dashLogger <- function(event = NULL, } } } - + clientsideFunction <- function(namespace, function_name) { return(list(namespace=namespace, function_name=function_name)) } From ff632ceff0bc3b6344e62475fa3ec97e261477c9 Mon Sep 17 00:00:00 2001 From: Ryan Patrick Kyle Date: Thu, 17 Oct 2019 11:23:10 -0400 Subject: [PATCH 7/7] :pencil2: add separator and :camel: --- R/utils.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/R/utils.R b/R/utils.R index 2493cbe5..99db66d1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -859,14 +859,12 @@ getLineWithError <- function(currentCall, formatted=TRUE) { # filename srcfile <- attr(srcref, "srcfile", exact = TRUE) # line number - if (formatted) { - crayon::yellow$italic(sprintf('Line %s in %s', srcref[[1]], srcfile$filename)) - } else { - sprintf('Line %s in %s', srcref[[1]], srcfile$filename) - } - } else { + context <- sprintf("-- %s, Line %s", srcfile$filename, srcref[[1]]) + if (formatted) + context <- crayon::yellow$italic(context) + return(context) + } else "" - } } # This helper function drops error