Use lazy presentation hint for promises

.gitignore

@@ -31,3 +31,5 @@ doc
 Meta
 vignettes/*.R
 vignettes/*.html
+/doc/
+/Meta/

.vscode/tasks.json

@@ -44,13 +44,13 @@
         {
             "label": "Build and install package for testing (SLOW)",
             "type": "shell",
-            "command": "%RCMD% build.R --args slow",
+            "command": "%RCMD% -f build.R --args slow",
             "problemMatcher": []
         },
         {
             "label": "Update documentation, do not install",
             "type": "shell",
-            "command": "Rscript build.R --args docOnly",
+            "command": "%RCMD% -f build.R --args docOnly",
             "presentation": {
                 "reveal": "silent"
             },

R/customVarInfo.R

@@ -133,47 +133,20 @@ toAtomicBoolean <- function(v, ...){
 }
 
 .vsc.addVarInfo <- function(
-  name = '',
-  doesApply = NULL,
-  childVars = NULL,
-  customAttributes = NULL,
-  hasChildren = NULL,
-  toString = NULL,
-  shortType = NULL,
-  longType = NULL,
-  includeAttributes = NULL,
-  varInfo = list(),
-  position = 1
+  varInfo,
+  overwrite = FALSE
 ) {
-  # start with empty varInfo if none given
-  if (is.null(varInfo)) {
-    varInfo <- list()
-  }
-
-  # check if there is a position given in varInfo
-  if (!is.null(varInfo$position)){
-    position <- varInfo$position
-  }
-
+  position <- lget(varInfo, 'position', 1)
   if (position < 0) {
     # negative positions count from the end, -1 = last position
     position <- length(session$varInfos) + 1 + position
-  } else if (position > 0) {
-    position <- position - 1 # position 1 == insert after 0
   }
 
-  # add entries to varInfo (entires already in varInfo will be overwritten)
-  varInfo$name <- name
-  varInfo$doesApply <- doesApply
-  varInfo$childVars <- childVars
-  varInfo$customAttributes <- customAttributes
-  varInfo$hasChildren <- hasChildren
-  varInfo$toString <- toString
-  varInfo$shortType <- shortType
-  varInfo$longType <- longType
-  varInfo$includeAttributes <- includeAttributes
-
-  session$varInfos <- append(session$varInfos, list(varInfo), position)
+  if(overwrite){
+    session$varInfos[[position]] <- varInfo
+  } else{
+    session$varInfos <- append(session$varInfos, list(varInfo), position - 1)
+  }
 }
 
 .vsc.removeVarInfo <- function(position = 1) {

R/defaultVarInfo.R

@@ -12,19 +12,50 @@ getDefaultVarInfos <- function() {
       type = 'NULL',
       toString = 'NULL'
     ),
-    # promise (custom type)
+    # promsie (custom type, click-to-eval)
     list(
       name = 'Promise',
+      type = 'promise',
+      toString = function(v) paste0(
+          '`',
+          paste0(format(v$code), collapse = '; '),
+          '` in ',
+          format(v$environment)
+      ),
       doesApply = function(v) inherits(v, '.vsc.promise'),
+      nChildVars = 1,
+      childVars = function(v, ind){
+          list(list(
+              rValue = eval(v$code, envir=v$environment),
+              name = '<VALUE>'
+          ))
+      },
+      internalAttributes = list(),
+      presentationHint = list(lazy = TRUE)
+    ),
+    # promise details (custom type, includes environment and code)
+    list(
+      name = 'PromiseDetails',
+      doesApply = function(v) inherits(v, '.vsc.promiseDetails'),
       childVars = list(),
       nChildVars = 0,
-      type = 'promise',
+      type = 'promise details',
       toString = function(v) paste0(format(v$code), collapse = "; "),
       internalAttributes = function(v) {
+        # Change class to render `__promiseValue` as simple promise
+        class(v) = c(".vsc.promise", ".vsc.internalClass")
         ret <- list(
           list(
             name = '__promiseEnv',
             rValue = v$environment
+          ),
+          list(
+            name = '__promiseCode',
+            rValue = v$code
+          ),
+          list(
+            name = '__promiseValue',
+            rValue = v
           )
         )
         if (getOption('vsc.previewPromises', default = FALSE)) {
@@ -464,6 +495,7 @@ getDefaultVarInfos <- function() {
       childVars = list(),
       nChildVars = 0,
       type = function(v) typeof(v),
+      presentationHint = function(v) NULL,
       internalAttributes = function(v) {
         if(getOption('vsc.groupAttributes', FALSE)){
           return(list())

R/defaultVarInfoHelpers.R

@@ -142,8 +142,10 @@ getDotVars <- function(env) {
 #' @param name The name of the variable
 #' @param env The environment in which to evaluate
 #' @return
-#' An object of class `.vsc.promise`;
-#' a named list containing the expression that will be evaluated,
+#' An object of class `.vsc.promise` or `.vc.promiseDetails`,
+#' depending on the option `vsc.showPromiseDetails`.
+#' The two classes are functionally identical and only rendered differently.
+#' A named list containing the expression that will be evaluated,
 #' the status whether the promise has already been evaluated,
 #' the value if it has already been evaluated,
 #' and the environment in which the unevaluated promise will be evaluated. 
@@ -166,9 +168,14 @@ getDotVars <- function(env) {
 #' 
 #' @keywords internal
 getPromiseVar <- function(name, env) {
+  if(getOption('vsc.showPromiseDetails', FALSE)){
+    promiseClass <- '.vsc.promiseDetails'
+  } else{
+    promiseClass <- '.vsc.promise'
+  }
   structure(
     getPromiseInfo(name, env),
-    class = c(".vsc.promise", ".vsc.internalClass")
+    class = c(promiseClass, ".vsc.internalClass")
   )
 }
 

R/stackTree.R

@@ -492,7 +492,8 @@ VariableNode <- R6::R6Class(
       infos <- c(
         "toString",
         "type",
-        "nChildVars"
+        "nChildVars",
+        "presentationHint"
       )
 
       if(getOption('vsc.showEvaluateName', TRUE)){
@@ -534,6 +535,7 @@ VariableNode <- R6::R6Class(
       self$value <- infos$toString
       self$type <- infos$type
       self$evaluateName <- infos$evaluateName
+      self$presentationHint <- infos$presentationHint
 
       if (self$indexedVariables + self$namedVariables > 0) {
         self$variablesReference <- self$getNewVarRef()
@@ -548,6 +550,7 @@ VariableNode <- R6::R6Class(
         type = self$type,
         evaluateName = self$evaluateName,
         variablesReference = self$variablesReference,
+        presentationHint = self$presentationHint,
         namedVariables = self$namedVariables,
         indexedVariables = self$indexedVariables
       )

build.R

@@ -30,7 +30,7 @@ if('docOnly' %in% args){
   try({
     libpath <- installed.packages()['vscDebugger', 'LibPath']
     trunc <- file.path(libpath, 'vscDebugger', 'libs')
-    f1 <- file(file.path(trunc, 'i386', 'vscDebugger.dll'), open='r')
+    # f1 <- file(file.path(trunc, 'i386', 'vscDebugger.dll'), open='r')
     f2 <- file(file.path(trunc, 'x64', 'vscDebugger.dll'), open='r')
     remove.packages('vscDebugger')
   })