From 05d49ee45e6757e401f4e669fefb3d47fe4ea801 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Mon, 16 Apr 2018 09:47:58 -0400 Subject: [PATCH] use MessageLogger for node information cache --- R/graph.R | 127 +++++++++++++++++++++++++++--------------------------- 1 file changed, 64 insertions(+), 63 deletions(-) diff --git a/R/graph.R b/R/graph.R index 30834f47b..1a065aae4 100644 --- a/R/graph.R +++ b/R/graph.R @@ -59,6 +59,12 @@ showReactLog <- function(time = TRUE) { utils::browseURL(renderReactLog(time = as.logical(time))) } +displayReactLogMessages <- function() { + for (msg in rLogMsg$messages) { + message(msg) + } +} + renderReactLog <- function(sessionToken = NULL, time = TRUE) { templateFile <- system.file('www/reactive-graph.html', package='shiny') html <- paste(readLines(templateFile, warn=FALSE), collapse='\r\n') @@ -89,47 +95,8 @@ rlogAppend <- function(logEntry, domain = getDefaultReactiveDomain()) { } -MessageLogger = R6Class( - 'Stack', - portable = FALSE, - class = FALSE, - public = list( - depth = 0L, - display = TRUE, - messages = c(), - - initialize = function(display, depth) { - if (!missing(display)) self$display <- display - if (!missing(depth)) self$depth <- depth - }, - depthIncrement = function() { - self$depth <- self$depth + 2 - }, - depthDecrement = function() { - self$depth <- self$depth - 2 - }, - log = function(...) { - msg <- paste0( - paste0(rep(" ", depth), collapse = ""), " - ", paste0(..., collapse = ""), - collapse = "" - ) - self$messages[length(self$messages) + 1] <- msg - if (display) { - message(msg) - } - } - ) -) -rLogMsg <- MessageLogger$new(TRUE, 0) - - -displayReactLogMessages <- function() { - for (msg in rLogMsg$messages) { - message(msg) - } -} rlogDependsOnReactiveValueKey <- function(reactId, depOnReactId, key) { - rLogMsg$log("dependsOnReactiveValueKey: ", pn(reactId), " ", pn(depOnReactId), " ", key) + rLogMsg$log("dependsOnReactiveValueKey: ", rLogMsg$node(reactId), " ", rLogMsg$node(depOnReactId), " ", key) rlogAppend(list( action = "depReactiveValueKey", reactId = reactId, @@ -138,7 +105,7 @@ rlogDependsOnReactiveValueKey <- function(reactId, depOnReactId, key) { )) } rlogDependsOnReactiveValueNames <- function(reactId, depOnReactId) { - rLogMsg$log("dependsOnReactiveValueNames: ", pn(reactId), " ", pn(depOnReactId)) + rLogMsg$log("dependsOnReactiveValueNames: ", rLogMsg$node(reactId), " ", rLogMsg$node(depOnReactId)) rlogAppend(list( action = "depReactiveValueNames", reactId = reactId, @@ -146,7 +113,7 @@ rlogDependsOnReactiveValueNames <- function(reactId, depOnReactId) { )) } rlogDependsOnReactiveValueToList <- function(reactId, depOnReactId) { - rLogMsg$log("dependsOnReactiveValueToList: ", pn(reactId), " ", pn(depOnReactId)) + rLogMsg$log("dependsOnReactiveValueToList: ", rLogMsg$node(reactId), " ", rLogMsg$node(depOnReactId)) rlogAppend(list( action = "dependsOnReactiveValuetoList", reactId = reactId, @@ -155,7 +122,7 @@ rlogDependsOnReactiveValueToList <- function(reactId, depOnReactId) { } rlogDependsOn <- function(reactId, depOnReactId) { - rLogMsg$log("dependsOn: ", pn(reactId), " on ", pn(depOnReactId)) + rLogMsg$log("dependsOn: ", rLogMsg$node(reactId), " on ", rLogMsg$node(depOnReactId)) rlogAppend(list( action = "dep", reactId = reactId, @@ -163,7 +130,7 @@ rlogDependsOn <- function(reactId, depOnReactId) { )) } rlogDependsOnRemove <- function(reactId, depOnReactId) { - rLogMsg$log("dependsOnRemove: ", pn(reactId), " on ", pn(depOnReactId)) + rLogMsg$log("dependsOnRemove: ", rLogMsg$node(reactId), " on ", rLogMsg$node(depOnReactId)) rlogAppend(list( action = "depOnRemove", reactId = reactId, @@ -171,21 +138,13 @@ rlogDependsOnRemove <- function(reactId, depOnReactId) { )) } -nodeCache <- list() -pn <- function(reactId) { - nodeInfo <- nodeCache[[reactId]] - paste( - nodeInfo$reactId, nodeInfo$type, nodeInfo$label, - sep = ":" - ) -} # init a node id with a label rlogAddNodeDef <- function(reactId, label, type) { if (!is.null(nodeCache[[reactId]])) { stop("node definition for id: ", reactId, " already found!!", "Label: ", label, "Type: ", type) } nodeCache[[reactId]] <<- list(reactId = reactId, label = label, type = type) - rLogMsg$log("nodeDef: ", pn(reactId)) + rLogMsg$log("nodeDef: ", rLogMsg$node(reactId)) rlogAppend(list( action = "nodeDef", reactId = reactId, @@ -195,7 +154,7 @@ rlogAddNodeDef <- function(reactId, label, type) { } rlogUpdateNodeLabel <- function(reactId, label) { nodeCache[[reactId]]$label <<- label - rLogMsg$log("updateNodeLabel: ", pn(reactId)) + rLogMsg$log("updateNodeLabel: ", rLogMsg$node(reactId)) rlogAppend(list( action = "updateNodeLabel", reactId = reactId, @@ -213,7 +172,7 @@ rlogUpdateNodeLabel <- function(reactId, label) { # } rlogEnter <- function(reactId, ctxId, type) { - rLogMsg$log("enter: ", pn(reactId), " ", ctxId, " ", type) + rLogMsg$log("enter: ", rLogMsg$node(reactId), " ", ctxId, " ", type) rLogMsg$depthIncrement() rlogAppend(list( action = 'enter', @@ -225,7 +184,7 @@ rlogEnter <- function(reactId, ctxId, type) { rlogExit <- function(reactId, ctxId, type) { rLogMsg$depthDecrement() - rLogMsg$log("exit: ", pn(reactId), " ", ctxId, " ", type) + rLogMsg$log("exit: ", rLogMsg$node(reactId), " ", ctxId, " ", type) rlogAppend(list( action = 'exit', reactId = reactId, @@ -237,7 +196,7 @@ rlogExit <- function(reactId, ctxId, type) { # id = ctx id # domain is like session rlogValueChange <- function(reactId, value) { - rLogMsg$log("valueChange: ", pn(reactId), " '", paste(utils::capture.output(utils::str(value)), collapse='\n'), "'") + rLogMsg$log("valueChange: ", rLogMsg$node(reactId), " '", paste(utils::capture.output(utils::str(value)), collapse='\n'), "'") rLogMsg$depthIncrement() rlogAppend( list( @@ -249,7 +208,7 @@ rlogValueChange <- function(reactId, value) { } rlogValueChangeEnd <- function(reactId, value) { rLogMsg$depthDecrement() - rLogMsg$log("valueChangeEnd: ", pn(reactId), " '", paste(utils::capture.output(utils::str(value)), collapse='\n'), "'") + rLogMsg$log("valueChangeEnd: ", rLogMsg$node(reactId), " '", paste(utils::capture.output(utils::str(value)), collapse='\n'), "'") rlogAppend( list( action = 'valueChangeEnd', @@ -260,7 +219,7 @@ rlogValueChangeEnd <- function(reactId, value) { } rlogReactValueNames <- function(reactId, values) { namesStr <- paste(utils::capture.output(utils::str(ls(values, all.names=TRUE))), collapse='\n') - rLogMsg$log("valueChangeReactValueNames: ", pn(reactId), " ", namesStr) + rLogMsg$log("valueChangeReactValueNames: ", rLogMsg$node(reactId), " ", namesStr) rlogAppend(list( action = 'valueChangeReactValueNames', reactId = reactId, @@ -270,7 +229,7 @@ rlogReactValueNames <- function(reactId, values) { rlogReactValueValues <- function(reactId, values) { valuesStr <- paste(utils::capture.output(utils::str(as.list(values))), collapse='\n') # pm("valueChangeReactValue: ", reactId, " ", valuesStr) - rLogMsg$log("valueChangeReactValueValues: ", pn(reactId)) + rLogMsg$log("valueChangeReactValueValues: ", rLogMsg$node(reactId)) rlogAppend(list( action = 'valueChangeReactValueValues', reactId = reactId, @@ -279,7 +238,7 @@ rlogReactValueValues <- function(reactId, values) { } rlogReactValueKey <- function(reactId, key, value) { valueStr <- paste(utils::capture.output(utils::str(value)), collapse='\n') - rLogMsg$log("valueChangeReactValueKey: ", pn(reactId), " ", key, " ", valueStr) + rLogMsg$log("valueChangeReactValueKey: ", rLogMsg$node(reactId), " ", key, " ", valueStr) rlogAppend(list( action = 'valueChangeReactValueKey', reactId = reactId, key = key, @@ -290,7 +249,7 @@ rlogReactValueKey <- function(reactId, key, value) { # id = ctx id # domain is like session rlogInvalidateStart <- function(reactId, ctxId, type, domain) { - rLogMsg$log("invalidateStart: ", pn(reactId), " ", ctxId, " ", type) + rLogMsg$log("invalidateStart: ", rLogMsg$node(reactId), " ", ctxId, " ", type) rLogMsg$depthIncrement() rlogAppend( list( @@ -304,7 +263,7 @@ rlogInvalidateStart <- function(reactId, ctxId, type, domain) { } rlogInvalidateEnd <- function(reactId, ctxId, type, domain) { rLogMsg$depthDecrement() - rLogMsg$log("invalidateEnd: ", pn(reactId), " ", ctxId, " ", type) + rLogMsg$log("invalidateEnd: ", rLogMsg$node(reactId), " ", ctxId, " ", type) rlogAppend( list( action = 'invalidateEnd', @@ -316,6 +275,48 @@ rlogInvalidateEnd <- function(reactId, ctxId, type, domain) { ) } +MessageLogger = R6Class( + 'Stack', + portable = FALSE, + class = FALSE, + public = list( + depth = 0L, + display = TRUE, + messages = c(), + nodeCache = list(), + + initialize = function(display, depth) { + if (!missing(display)) self$display <- display + if (!missing(depth)) self$depth <- depth + }, + depthIncrement = function() { + self$depth <- self$depth + 2 + }, + depthDecrement = function() { + self$depth <- self$depth - 2 + }, + node = function(reactId) { + nodeInfo <- nodeCache[[reactId]] + paste( + nodeInfo$reactId, nodeInfo$type, nodeInfo$label, + sep = ":" + ) + }, + log = function(...) { + msg <- paste0( + paste0(rep(" ", depth), collapse = ""), " - ", paste0(..., collapse = ""), + collapse = "" + ) + self$messages[length(self$messages) + 1] <- msg + if (display) { + message(msg) + } + } + ) +) +rLogMsg <- MessageLogger$new(TRUE, 0) + + #' @include stack.R rlogStack <- Stack$new()