210 bring get_code_dependency (#214)

BLOCKED by 
- insightsengineering/teal.data#340

Closes 
- #210 

Companion to 
- insightsengineering/teal.data#343 
- insightsengineering/teal#1388

# Description

Brings `names` parameter to `get_code` so that you can limit returned
code to specific objects (and the lines that create those objects).
`get_code_dependency` was moved from `teal.data`

# Tested with

``` r
library(teal.code)

# EVAL CODE
q <- qenv()
q <- eval_code(q, code = c("a <- 1", "b <- 2"))
q@code
#> [1] "a <- 1\nb <- 2"
get_code(q, names = "a")
#> [1] "a <- 1"

# WITHIN
q <- qenv()
q <- within(q, {a <- 1; b <- 2})
q@code
#> [1] "a <- 1\nb <- 2"
get_code(q, names = "a")
#> [1] "a <- 1"

# OLD TEAL.DATA
t <- teal.data::teal_data(a = 5, code = c("a <- 1", "b <- 2"))
t@code
#> [1] "a <- 1\nb <- 2"
teal.data::get_code(t, datanames = 'a')
#> Warning in .local(object, deparse, ...): get_code(datanames) was deprecated in
#> teal.data 0.6.1, use get_code(names) instead.
#> [1] "a <- 1"
```

<sup>Created on 2024-10-16 with [reprex
v2.1.1](https://reprex.tidyverse.org)</sup>

# Local tests

```r
> devtools::test()
ℹ Testing teal.code
✔ | F W  S  OK | Context
✔ |         12 | qenv_concat                                                 
✔ |          8 | qenv_constructor                                            
✔ |         26 | qenv_eval_code                                              
✔ |      2  60 | qenv_get_code [1.1s]                                        
✔ |         10 | qenv_get_var                                                
✔ |          7 | qenv_get_warnings                                           
✔ |         40 | qenv_join                                                   
✔ |         14 | qenv_within                                                 
✔ |         12 | utils                                                       

══ Results ══════════════════════════════════════════════════════════════════
Duration: 2.2 s

── Skipped tests (2) ────────────────────────────────────────────────────────
• This is not urgent and can be ommitted with @linksto tag. (1):
  test-qenv_get_code.R:526:3
• We will not resolve this, as this requires code evaluation. (1):
  test-qenv_get_code.R:318:3

[ FAIL 0 | WARN 0 | SKIP 2 | PASS 189 ]
````

# Local R CMD CHECK

```r
── R CMD check results ──────────────────────────────────── teal.code 0.5.0.9010 ────
Duration: 33.5s

❯ checking for future file timestamps ... NOTE
  unable to verify current time

0 errors ✔ | 0 warnings ✔ | 1 note ✖

R CMD check succeeded
```

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>

Author: 3 people

DESCRIPTION

@@ -66,4 +66,5 @@ Collate:
     'qenv-show.R'
     'qenv-within.R'
     'teal.code-package.R'
+    'utils-get_code_dependency.R'
     'utils.R'

NEWS.md

@@ -1,5 +1,10 @@
 # teal.code 0.5.0.9010
 
+### Enhancements
+
+* `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in
+`qenv` but limited to `names`.
+
 # teal.code 0.5.0
 
 ### Breaking Change

R/qenv-get_code.R

@@ -5,23 +5,100 @@
 #'
 #' @param object (`qenv`)
 #' @param deparse (`logical(1)`) flag specifying whether to return code as `character` or `expression`.
+#' @param names `r lifecycle::badge("experimental")` (`character`) vector of object names to return the code for.
+#' For more details see the "Extracting dataset-specific code" section.
 #' @param ... see `Details`
 #'
+#'
+#' @section Extracting dataset-specific code:
+#' When `names` is specified, the code returned will be limited  to the lines needed to _create_
+#' the requested objects. The code stored in the `@code` slot is analyzed statically to determine
+#' which lines the objects of interest depend upon. The analysis works well when objects are created
+#' with standard infix assignment operators (see `?assignOps`) but it can fail in some situations.
+#'
+#' Consider the following examples:
+#'
+#' _Case 1: Usual assignments._
+#' ```r
+#' q1 <- qenv() |>
+#'   within({
+#'     foo <- function(x) {
+#'       x + 1
+#'     }
+#'     x <- 0
+#'     y <- foo(x)
+#'   })
+#' get_code(q1, names = "y")
+#' ```
+#' `x` has no dependencies, so `get_code(data, names = "x")` will return only the second call.\cr
+#' `y` depends on `x` and `foo`, so `get_code(data, names = "y")` will contain all three calls.
+#'
+#' _Case 2: Some objects are created by a function's side effects._
+#' ```r
+#' q2 <- qenv() |>
+#'   within({
+#'     foo <- function() {
+#'       x <<- x + 1
+#'     }
+#'     x <- 0
+#'     foo()
+#'     y <- x
+#'   })
+#' get_code(q2, names = "y")
+#' ```
+#' Here, `y` depends on `x` but `x` is modified by `foo` as a side effect (not by reassignment)
+#' and so `get_code(data, names = "y")` will not return the `foo()` call.\cr
+#' To overcome this limitation, code dependencies can be specified manually.
+#' Lines where side effects occur can be flagged by adding "`# @linksto <object name>`" at the end.\cr
+#' Note that `within` evaluates code passed to `expr` as is and comments are ignored.
+#' In order to include comments in code one must use the `eval_code` function instead.
+#'
+#' ```r
+#' q3 <- qenv() |>
+#'   eval_code("
+#'     foo <- function() {
+#'       x <<- x + 1
+#'     }
+#'     x <- 0
+#'     foo() # @linksto x
+#'     y <- x
+#'   ")
+#' get_code(q3, names = "y")
+#' ```
+#' Now the `foo()` call will be properly included in the code required to recreate `y`.
+#'
+#' Note that two functions that create objects as side effects, `assign` and `data`, are handled automatically.
+#'
+#' Here are known cases where manual tagging is necessary:
+#' - non-standard assignment operators, _e.g._ `%<>%`
+#' - objects used as conditions in `if` statements: `if (<condition>)`
+#' - objects used to iterate over in `for` loops: `for(i in <sequence>)`
+#' - creating and evaluating language objects, _e.g._ `eval(<call>)`
+#'
 #' @return
 #' `get_code` returns the traced code (from `@code` slot) in the form specified by `deparse`.
 #'
 #' @examples
 #' # retrieve code
+#' q <- within(qenv(), {
+#'   a <- 1
+#'   b <- 2
+#' })
 #' get_code(q)
 #' get_code(q, deparse = FALSE)
+#' get_code(q, names = "a")
+#'
+#' q <- qenv()
+#' q <- eval_code(q, code = c("a <- 1", "b <- 2"))
+#' get_code(q, names = "a")
 #'
 #' @name get_code
 #' @rdname qenv
 #' @aliases get_code,qenv-method
 #' @aliases get_code,qenv.error-method
 #'
 #' @export
-setGeneric("get_code", function(object, deparse = TRUE, ...) {
+setGeneric("get_code", function(object, deparse = TRUE, names = NULL, ...) {
   # this line forces evaluation of object before passing to the generic
   # needed for error handling to work properly
   grDevices::pdf(nullfile())
@@ -31,16 +108,29 @@ setGeneric("get_code", function(object, deparse = TRUE, ...) {
   standardGeneric("get_code")
 })
 
-setMethod("get_code", signature = "qenv", function(object, deparse = TRUE) {
+setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names = NULL, ...) {
   checkmate::assert_flag(deparse)
+  checkmate::assert_character(names, min.len = 1L, null.ok = TRUE)
+
+  # Normalize in case special it is backticked
+  if (!is.null(names)) {
+    names <- gsub("^`(.*)`$", "\\1", names)
+  }
+
+  code <- if (!is.null(names)) {
+    get_code_dependency(object@code, names, ...)
+  } else {
+    object@code
+  }
+
   if (deparse) {
-    if (length(object@code) == 0) {
-      object@code
+    if (length(code) == 0) {
+      code
     } else {
-      paste(object@code, collapse = "\n")
+      paste(code, collapse = "\n")
     }
   } else {
-    parse(text = paste(c("{", object@code, "}"), collapse = "\n"), keep.source = TRUE)
+    parse(text = paste(c("{", code, "}"), collapse = "\n"), keep.source = TRUE)
   }
 })