Shiny call stack example

shiny-callstack.txt

> shinyApp(
+   ui = fluidPage(
+     numericInput("n", "n", 1),
+     plotOutput("plot")
+   ),
+   server = function(input, output) {
+     
+     output$plot <- renderPlot({
+       print(sys.calls())
+       plot(head(cars, input$n)) 
+     })
+   },
+   options = list(port = 1234)
+ )

Listening on http://127.0.0.1:1234
[[1]]
function (x, ...) 
UseMethod("print")(x)

[[2]]
print.shiny.appobj(x)

[[3]]
do.call("runApp", args)

[[4]]
runApp(x, port = 1234)

[[5]]
..stacktraceoff..(captureStackTraces({
    scheduleFlush()
    while (!.globals$stopped) {
        serviceApp()
        Sys.sleep(0.001)
    }
}))

[[6]]
captureStackTraces({
    scheduleFlush()
    while (!.globals$stopped) {
        serviceApp()
        Sys.sleep(0.001)
    }
})

[[7]]
withCallingHandlers(expr, error = function(e) {
    if (is.null(attr(e, "stack.trace", exact = TRUE))) {
        calls <- sys.calls()
        attr(e, "stack.trace") <- calls
        stop(e)
    }
})

[[8]]
serviceApp()

[[9]]
service(timeout)

[[10]]
run(timeoutMs)

[[11]]
tryCatch(evalq((function (handle, binary, message) 
{
    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {
        result <- try(handler(binary, message))
        if (inherits(result, "try-error")) {
            .wsconns[[as.character(handle)]]$close()
            return()
        }
    }
})("4483948272", FALSE, "{\\"method\\":\\"init\\",\\"data\\":{\\"n:shiny.number\\":1,\\".clientdata_output_plot_width\\":930,\\".clientdata_output_plot_height\\":400,\\".clientdata_output_plot_hidden\\":false,\\".clientdata_pixelratio\\":2,\\".clientdata_url_protocol\\":\\"http:\\",\\".clientdata_url_hostname\\":\\"127.0.0.1\\",\\".clientdata_url_port\\":\\"1234\\",\\".clientdata_url_pathname\\":\\"/\\",\\".clientdata_url_search\\":\\"\\",\\".clientdata_url_hash_initial\\":\\"\\",\\".clientdata_url_hash\\":\\"\\",\\".clientdata_singletons\\":\\"\\",\\".clientdata_allowDataUriScheme\\":true}}"), 
    <environment>), error = function (x) 
x, interrupt = function (x) 
x)

[[12]]
tryCatchList(expr, classes, parentenv, handlers)

[[13]]
tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])

[[14]]
doTryCatch(return(expr), name, parentenv, handler)

[[15]]
tryCatchList(expr, names[-nh], parentenv, handlers[-nh])

[[16]]
tryCatchOne(expr, names, parentenv, handlers[[1L]])

[[17]]
doTryCatch(return(expr), name, parentenv, handler)

[[18]]
evalq((function (handle, binary, message) 
{
    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {
        result <- try(handler(binary, message))
        if (inherits(result, "try-error")) {
            .wsconns[[as.character(handle)]]$close()
            return()
        }
    }
})("4483948272", FALSE, "{\\"method\\":\\"init\\",\\"data\\":{\\"n:shiny.number\\":1,\\".clientdata_output_plot_width\\":930,\\".clientdata_output_plot_height\\":400,\\".clientdata_output_plot_hidden\\":false,\\".clientdata_pixelratio\\":2,\\".clientdata_url_protocol\\":\\"http:\\",\\".clientdata_url_hostname\\":\\"127.0.0.1\\",\\".clientdata_url_port\\":\\"1234\\",\\".clientdata_url_pathname\\":\\"/\\",\\".clientdata_url_search\\":\\"\\",\\".clientdata_url_hash_initial\\":\\"\\",\\".clientdata_url_hash\\":\\"\\",\\".clientdata_singletons\\":\\"\\",\\".clientdata_allowDataUriScheme\\":true}}"), 
    <environment>)

[[19]]
evalq((function (handle, binary, message) 
{
    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {
        result <- try(handler(binary, message))
        if (inherits(result, "try-error")) {
            .wsconns[[as.character(handle)]]$close()
            return()
        }
    }
})("4483948272", FALSE, "{\\"method\\":\\"init\\",\\"data\\":{\\"n:shiny.number\\":1,\\".clientdata_output_plot_width\\":930,\\".clientdata_output_plot_height\\":400,\\".clientdata_output_plot_hidden\\":false,\\".clientdata_pixelratio\\":2,\\".clientdata_url_protocol\\":\\"http:\\",\\".clientdata_url_hostname\\":\\"127.0.0.1\\",\\".clientdata_url_port\\":\\"1234\\",\\".clientdata_url_pathname\\":\\"/\\",\\".clientdata_url_search\\":\\"\\",\\".clientdata_url_hash_initial\\":\\"\\",\\".clientdata_url_hash\\":\\"\\",\\".clientdata_singletons\\":\\"\\",\\".clientdata_allowDataUriScheme\\":true}}"), 
    <environment>)

[[20]]
(function (handle, binary, message) 
{
    for (handler in .wsconns[[as.character(handle)]]$.messageCallbacks) {
        result <- try(handler(binary, message))
        if (inherits(result, "try-error")) {
            .wsconns[[as.character(handle)]]$close()
            return()
        }
    }
})("4483948272", FALSE, "{\\"method\\":\\"init\\",\\"data\\":{\\"n:shiny.number\\":1,\\".clientdata_output_plot_width\\":930,\\".clientdata_output_plot_height\\":400,\\".clientdata_output_plot_hidden\\":false,\\".clientdata_pixelratio\\":2,\\".clientdata_url_protocol\\":\\"http:\\",\\".clientdata_url_hostname\\":\\"127.0.0.1\\",\\".clientdata_url_port\\":\\"1234\\",\\".clientdata_url_pathname\\":\\"/\\",\\".clientdata_url_search\\":\\"\\",\\".clientdata_url_hash_initial\\":\\"\\",\\".clientdata_url_hash\\":\\"\\",\\".clientdata_singletons\\":\\"\\",\\".clientdata_allowDataUriScheme\\":true}}")

[[21]]
try(handler(binary, message))

[[22]]
tryCatch(expr, error = function(e) {
    call <- conditionCall(e)
    if (!is.null(call)) {
        if (identical(call[[1L]], quote(doTryCatch))) 
            call <- sys.call(-4L)
        dcall <- deparse(call)[1L]
        prefix <- paste("Error in", dcall, ": ")
        LONG <- 75L
        msg <- conditionMessage(e)
        sm <- strsplit(msg, "\\n")[[1L]]
        w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")
        if (is.na(w)) 
            w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], 
                type = "b")
        if (w > LONG) 
            prefix <- paste0(prefix, "\\n  ")
    }
    else prefix <- "Error : "
    msg <- paste0(prefix, conditionMessage(e), "\\n")
    .Internal(seterrmessage(msg[1L]))
    if (!silent && identical(getOption("show.error.messages"), 
        TRUE)) {
        cat(msg, file = outFile)
        .Internal(printDeferredWarnings())
    }
    invisible(structure(msg, class = "try-error", condition = e))
})

[[23]]
tryCatchList(expr, classes, parentenv, handlers)

[[24]]
tryCatchOne(expr, names, parentenv, handlers[[1L]])

[[25]]
doTryCatch(return(expr), name, parentenv, handler)

[[26]]
handler(binary, message)

[[27]]
withLogErrors(messageHandler(binary, msg))

[[28]]
withCallingHandlers(captureStackTraces(expr), error = function(cond) {
    if (inherits(cond, "shiny.silent.error")) 
        return()
    if (isTRUE(getOption("show.error.messages"))) {
        printError(cond, full = full, offset = offset)
    }
})

[[29]]
captureStackTraces(expr)

[[30]]
withCallingHandlers(expr, error = function(e) {
    if (is.null(attr(e, "stack.trace", exact = TRUE))) {
        calls <- sys.calls()
        attr(e, "stack.trace") <- calls
        stop(e)
    }
})

[[31]]
messageHandler(binary, msg)

[[32]]
withReactiveDomain(shinysession, {
    if (is.character(msg)) 
        msg <- charToRaw(msg)
    traceOption <- getOption("shiny.trace", FALSE)
    if (isTRUE(traceOption) || traceOption == "recv") {
        if (binary) 
            message("RECV ", "$$binary data$$")
        else message("RECV ", rawToChar(msg))
    }
    if (isEmptyMessage(msg)) 
        return()
    msg <- decodeMessage(msg)
    if (is.null(shinysession$restoreContext)) {
        bookmarkStore <- getShinyOption("bookmarkStore", default = "disable")
        if (bookmarkStore == "disable") {
            shinysession$restoreContext <- RestoreContext$new()
        }
        else {
            shinysession$restoreContext <- RestoreContext$new(msg$data$.clientdata_url_search)
        }
    }
    withRestoreContext(shinysession$restoreContext, {
        msg$data <- applyInputHandlers(msg$data)
        switch(msg$method, init = {
            serverFunc <- withReactiveDomain(NULL, serverFuncSource())
            if (!identicalFunctionBodies(serverFunc, appvars$server)) {
                appvars$server <- serverFunc
                if (!is.null(appvars$server)) {
                  attr(appvars$server, "shinyServerFunction") <- TRUE
                  registerDebugHook("server", appvars, "Server Function")
                }
            }
            if (.globals$showcaseOverride && exists(".clientdata_url_search", 
                where = msg$data)) {
                mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)
                if (!is.null(mode)) shinysession$setShowcase(mode)
            }
            shinysession$manageInputs(msg$data)
            if (!is.null(msg$data$.clientdata_singletons)) {
                shinysession$singletons <- strsplit(msg$data$.clientdata_singletons, 
                  ",")[[1]]
            }
            local({
                args <- argsForServerFunc(serverFunc, shinysession)
                withReactiveDomain(shinysession, {
                  do.call(wrapFunctionLabel(appvars$server, "server", 
                    ..stacktraceon = TRUE), args)
                })
            })
        }, update = {
            shinysession$manageInputs(msg$data)
        }, shinysession$dispatch(msg))
        shinysession$manageHiddenOutputs()
        if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID", 
            ws$request)) {
            shiny_stdout <- get(".shiny__stdout", globalenv())
            writeLines(paste("_n_flushReact ", get("HTTP_GUID", 
                ws$request), " @ ", sprintf("%.3f", as.numeric(Sys.time())), 
                sep = ""), con = shiny_stdout)
            flush(shiny_stdout)
            flushReact()
            writeLines(paste("_x_flushReact ", get("HTTP_GUID", 
                ws$request), " @ ", sprintf("%.3f", as.numeric(Sys.time())), 
                sep = ""), con = shiny_stdout)
            flush(shiny_stdout)
        }
        else {
            flushReact()
        }
        flushAllSessions()
    })
})

[[33]]
withRestoreContext(shinysession$restoreContext, {
    msg$data <- applyInputHandlers(msg$data)
    switch(msg$method, init = {
        serverFunc <- withReactiveDomain(NULL, serverFuncSource())
        if (!identicalFunctionBodies(serverFunc, appvars$server)) {
            appvars$server <- serverFunc
            if (!is.null(appvars$server)) {
                attr(appvars$server, "shinyServerFunction") <- TRUE
                registerDebugHook("server", appvars, "Server Function")
            }
        }
        if (.globals$showcaseOverride && exists(".clientdata_url_search", 
            where = msg$data)) {
            mode <- showcaseModeOfQuerystring(msg$data$.clientdata_url_search)
            if (!is.null(mode)) shinysession$setShowcase(mode)
        }
        shinysession$manageInputs(msg$data)
        if (!is.null(msg$data$.clientdata_singletons)) {
            shinysession$singletons <- strsplit(msg$data$.clientdata_singletons, 
                ",")[[1]]
        }
        local({
            args <- argsForServerFunc(serverFunc, shinysession)
            withReactiveDomain(shinysession, {
                do.call(wrapFunctionLabel(appvars$server, "server", 
                  ..stacktraceon = TRUE), args)
            })
        })
    }, update = {
        shinysession$manageInputs(msg$data)
    }, shinysession$dispatch(msg))
    shinysession$manageHiddenOutputs()
    if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID", 
        ws$request)) {
        shiny_stdout <- get(".shiny__stdout", globalenv())
        writeLines(paste("_n_flushReact ", get("HTTP_GUID", ws$request), 
            " @ ", sprintf("%.3f", as.numeric(Sys.time())), sep = ""), 
            con = shiny_stdout)
        flush(shiny_stdout)
        flushReact()
        writeLines(paste("_x_flushReact ", get("HTTP_GUID", ws$request), 
            " @ ", sprintf("%.3f", as.numeric(Sys.time())), sep = ""), 
            con = shiny_stdout)
        flush(shiny_stdout)
    }
    else {
        flushReact()
    }
    flushAllSessions()
})

[[34]]
force(expr)

[[35]]
flushReact()

[[36]]
.getReactiveEnvironment()$flush()

[[37]]
ctx$executeFlushCallbacks()

[[38]]
lapply(.flushCallbacks, function(flushCallback) {
    flushCallback()
})

[[39]]
FUN(X[[i]], ...)

[[40]]
flushCallback()

[[41]]
tryCatch({
    if (!.destroyed) 
        shinyCallingHandlers(run())
}, error = function(e) {
    printError(e)
    if (!is.null(.domain)) {
        .domain$unhandledError(e)
    }
})

[[42]]
tryCatchList(expr, classes, parentenv, handlers)

[[43]]
tryCatchOne(expr, names, parentenv, handlers[[1L]])

[[44]]
doTryCatch(return(expr), name, parentenv, handler)

[[45]]
shinyCallingHandlers(run())

[[46]]
withCallingHandlers(captureStackTraces(expr), error = function(e) {
    if (inherits(e, "shiny.silent.error")) 
        return()
    handle <- getOption("shiny.error")
    if (is.function(handle)) 
        handle()
})

[[47]]
captureStackTraces(expr)

[[48]]
withCallingHandlers(expr, error = function(e) {
    if (is.null(attr(e, "stack.trace", exact = TRUE))) {
        calls <- sys.calls()
        attr(e, "stack.trace") <- calls
        stop(e)
    }
})

[[49]]
run()

[[50]]
ctx$run(.func)

[[51]]
withReactiveDomain(.domain, {
    env <- .getReactiveEnvironment()
    .graphEnterContext(id)
    on.exit(.graphExitContext(id), add = TRUE)
    env$runWith(self, func)
})

[[52]]
env$runWith(self, func)

[[53]]
contextFunc()

[[54]]
tryCatch(if (..stacktraceon) ..stacktraceon..(observerFunc()) else observerFunc(), 
    shiny.silent.error = function(e) NULL)

[[55]]
tryCatchList(expr, classes, parentenv, handlers)

[[56]]
tryCatchOne(expr, names, parentenv, handlers[[1L]])

[[57]]
doTryCatch(return(expr), name, parentenv, handler)

[[58]]
observerFunc()

[[59]]
tryCatch(shinyCallingHandlers(func()), shiny.custom.error = function(cond) {
    if (isTRUE(getOption("show.error.messages"))) 
        printError(cond)
    structure(list(), class = "try-error", condition = cond)
}, shiny.output.cancel = function(cond) {
    structure(list(), class = "cancel-output")
}, shiny.silent.error = function(cond) {
    structure(list(), class = "try-error", condition = cond)
}, error = function(cond) {
    if (isTRUE(getOption("show.error.messages"))) 
        printError(cond)
    if (getOption("shiny.sanitize.errors", FALSE)) {
        cond <- simpleError(paste("An error has occurred. Check your", 
            "logs or contact the app author for", "clarification."))
    }
    invisible(structure(list(), class = "try-error", condition = cond))
}, finally = {
    private$sendMessage(recalculating = list(name = name, status = "recalculated"))
})

[[60]]
tryCatchList(expr, classes, parentenv, handlers)

[[61]]
tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])

[[62]]
doTryCatch(return(expr), name, parentenv, handler)

[[63]]
tryCatchList(expr, names[-nh], parentenv, handlers[-nh])

[[64]]
tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])

[[65]]
doTryCatch(return(expr), name, parentenv, handler)

[[66]]
tryCatchList(expr, names[-nh], parentenv, handlers[-nh])

[[67]]
tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])

[[68]]
doTryCatch(return(expr), name, parentenv, handler)

[[69]]
tryCatchList(expr, names[-nh], parentenv, handlers[-nh])

[[70]]
tryCatchOne(expr, names, parentenv, handlers[[1L]])

[[71]]
doTryCatch(return(expr), name, parentenv, handler)

[[72]]
shinyCallingHandlers(func())

[[73]]
withCallingHandlers(captureStackTraces(expr), error = function(e) {
    if (inherits(e, "shiny.silent.error")) 
        return()
    handle <- getOption("shiny.error")
    if (is.function(handle)) 
        handle()
})

[[74]]
captureStackTraces(expr)

[[75]]
withCallingHandlers(expr, error = function(e) {
    if (is.null(attr(e, "stack.trace", exact = TRUE))) {
        calls <- sys.calls()
        attr(e, "stack.trace") <- calls
        stop(e)
    }
})

[[76]]
func()

[[77]]
orig(name = name, shinysession = self)

[[78]]
..stacktraceon..(`output$plot`(...))

[[79]]
`output$plot`(...)

[[80]]
origRenderFunc(...)

[[81]]
plotObj()

[[82]]
..stacktraceoff..(self$.updateValue())

[[83]]
self$.updateValue()

[[84]]
ctx$run(function() {
    result <- withCallingHandlers({
        .error <<- FALSE
        withVisible(.func())
    }, error = function(cond) {
        .value <<- cond
        .error <<- TRUE
        .visible <<- FALSE
    })
    .value <<- result$value
    .visible <<- result$visible
})

[[85]]
withReactiveDomain(.domain, {
    env <- .getReactiveEnvironment()
    .graphEnterContext(id)
    on.exit(.graphExitContext(id), add = TRUE)
    env$runWith(self, func)
})

[[86]]
env$runWith(self, func)

[[87]]
contextFunc()

[[88]]
withCallingHandlers({
    .error <<- FALSE
    withVisible(.func())
}, error = function(cond) {
    .value <<- cond
    .error <<- TRUE
    .visible <<- FALSE
})

[[89]]
withVisible(.func())

[[90]]
.func()

[[91]]
..stacktraceon..(`<reactive:plotObj>`(...))

[[92]]
`<reactive:plotObj>`(...)

[[93]]
..stacktraceoff..(do.call("plotPNG", c(quote(plotFunc), width = dims$width * 
    pixelratio, height = dims$height * pixelratio, res = res * 
    pixelratio, args)))

[[94]]
do.call("plotPNG", c(quote(plotFunc), width = dims$width * pixelratio, 
    height = dims$height * pixelratio, res = res * pixelratio, 
    args))

[[95]]
plotPNG(plotFunc, width = 1860L, height = 800L, res = 144)

[[96]]
func()

[[97]]
tryCatch({
    grDevices::dev.control(displaylist = "enable")
    result <- withVisible(func())
    success <- TRUE
}, finally = {
    if (!success) {
        getDims()
    }
})

[[98]]
tryCatchList(expr, classes, parentenv, handlers)

[[99]]
withVisible(func())

[[100]]
func()

[[101]]
..stacktraceon..(renderPlot(...))

[[102]]
renderPlot(...)