wip: rethink the way attachment detect packages / functions

[ColinFay]

Notes :

{attachment} will incorrectly parse the following file :

write(
  c(
    "# There will be some code like library(dplyr)", # <- ignored ✅
    "library(gglot2)", # <- detected ✅
    "sprintf('%s::plot()', 'ggplot2')", # <- incorrectly detecting s ❌
    "# And some comments with blabla::pif", # <- ignored ✅
    "library(thispackagedoesntexist)", # <- There should be an error here ❌
    "print(toTitleCase('hello'))", # <- incorrectly ignoring toTitleCase ❌
    "plot(iris)", # <- ✅
    "print('You can also use library(matplotlib)')", # <- incorrectly detecting matplotlib ❌
    "use('golem', 'run_dev')", # <- not detecting golem ❌
    "getFromNamespace('replace_na', 'tidyr')", # <- not detecting tidyr ❌
    "library(lib.loc = '/tmp', package = 'tidyverse')", # <- not detecting tidyverse ❌
    "requireNamespace('pak')", # <- detected ✅
    "requireNamespace(lib.loc = '/tmp', 'usethis')", # <- not detecting usethis  ❌
    "require(lib.loc = '/tmp', package = 'attachment')" # <- not detecting attachment ❌
  ),
  file = "test_file.R"
)
attachment::att_from_rscript(
  "test_file.R"
)
[1] "gglot2"                 "thispackagedoesntexist" "matplotlib"            
[4] "s" 

The expected values here would be:

• first, an error for thispackagedoesntexist

Then :

• gglot2
• tools
• golem
• tidyr
• tidyverse
• attachment

I'll work on finding a different approach.

[ColinFay]

Here is a piece of code to detect all the function calls :

(funs <- purrr::map_df(
  "test_file.R",
  \(file_name){
    getParseData(x = parse(text = readLines(file_name))) |>
      dplyr::filter(token == "SYMBOL_FUNCTION_CALL") |>
      dplyr::mutate(
        file = file_name
      )
  }
) |>
  dplyr::select(
    file,
    line1,
    text
  ) )
         file line1             text
1 test_file.R     2          library
2 test_file.R     3          sprintf
3 test_file.R     5          library
4 test_file.R     6            print
5 test_file.R     6      toTitleCase
6 test_file.R     7             plot
7 test_file.R     8            print
8 test_file.R     9              use
9 test_file.R    10 getFromNamespace

> purrr::map(
   funs$text,
   \(x){
     getAnywhere(x)$where  
   }
 )
[[1]]
[1] "package:base"   "namespace:base"

[[2]]
[1] "package:base"   "namespace:base"

[[3]]
[1] "package:base"   "namespace:base"

[[4]]
[1] "package:base"   "namespace:base"

[[5]]
[1] "namespace:tools"

[[6]]
[1] "package:graphics"     "package:base"         "namespace:base"      
[4] "namespace:colorspace"

[[7]]
[1] "package:base"   "namespace:base"

[[8]]
[1] "package:base"   "namespace:base"

[[9]]
[1] "package:utils"   "namespace:utils"

[ColinFay]

Here is a draft of working with codetools to get library(), use(), requireNamespace() and require().

We use the codetools::walkCode() functions, which is (more or less) undocumented.

exprs <- parse(text = "library(lib.loc = '.', 'dplyr');select(iris, Species);require('matplotlib');use('golem', 'run_dev');requireNamespace('usethis');")

reorder_and_name_args <- function(expr) {
  match.call(eval(expr[[1]]), expr)
}

funs <- c(
  "library",
  "require",
  "use",
  "requireNamespace"
)

pkgs <- c()

purrr::walk(
  exprs,
  function(one_expr) {
   codetools::walkCode(
      one_expr,
      codetools::makeCodeWalker(
        call = function(expr, w) {
          # on the first iteration, the expr is
          # fun(bla = 12, 22)
          # and the first object of expr
          # should be the function call
          # so we check this
          fn <- expr[[1]]
          if (
            is.symbol(fn) &&
              as.character(fn) %in% funs
          ) {
            
            # given that the loading funs are 
            # from base they can be match.call
            # but there should be a better way to 
            # do that ?
            expr <- reorder_and_name_args(expr)
            # Then, we get the args of this function.
            # it has been named by default with reorder_and_name_args
            args <- as.list(expr)[-1]
            if ("package" %in% names(args)) {
              pkg <- as.character(args$package)
            }
            pkgs <<- c(pkgs, pkg)
          }
          # We go recursively in the args of the code
          # if ever there is a weird pattern but I'm
          # pretty sure this should be ok
          for (e in as.list(expr)[-1L]) {
            walkCode(e, w)
          }
          invisible()
        },
        leaf = function(expr, w) {
          NULL
        }
      )
    )
  }
)
unique(pkgs)

[1] "dplyr"      "matplotlib" "golem"      "usethis" 

Here is a rough explanation of the code above. This is undocumented in the package so here is a breakdown of what I've understood.

walkCode() & the codewalker structure

walkCode() takes an expression and a list also called codewalker. This codewalker can be created with makeCodeWalker() if we want to keep the default values and only override some vals (which we'll do here, using the default handler fun).

A codewalker is a list containing three functions, each one taking the expression and the walker itself as parameter (so that it can be called recursively.

The list needs:

call = function(e,w) { whatever() },
handler = function(e,w) { whatever() },
leaf = function(e,w) { whatever() }

At the top level, walkCode() takes an expression as entry, then, depending of the type of expression, calls one of the function from the codewalker.

How the function behaves

The codewalker is called that way :

walkCode enters with an object e and the walker w.

Then :

1. If e is a language object, then it tests if the first element of e is a symbol or a character, and if it is, it calls the handler from the codewalker.

If this handler returns NULL, then the function calls w$call(), otherwise it calls the handler (so handler should return a function).

If the first element is not a symbol or a character, it calls call() directly.

Not that all top expression of the parsed text are language objects :

> e <- parse(text = "library(lib.loc = '/tmp', 'dplyr');select(iris, Species)")
> typeof(e[[1]])
[1] "language"
> typeof(e[[2]])
[1] "language"

2. If e is not a language object, then we are at the end of the tree, so the
   leaf() handler is called.

Example

Count the number of "leaves" of the tree :

exprs <- parse(text = "library(lib.loc = '/tmp', 'dplyr');select(iris, Species)")
leaves <- NULL
lapply(
  exprs,
  function(e) {
    walkCode(
      e,
      makeCodeWalker(
        call = function(expr, walker) {
          for (sub_expr in as.list(expr)[-1L]) {
            walkCode(sub_expr, walker)
          }
        },
        handler = function(expr, walker) {
          return(NULL)
        },
        leaf = function(expr, walker) {
          leaves <<- c(leaves, as.character(expr))
          return(NULL)
        }
      )
    )
  }
)
> leaves
[1] "/tmp"    "dplyr"   "iris"    "Species"

[ColinFay]

Then if we have the following fun:

reorder_and_name_args <- function(expr) {
  match.call(eval(expr[[1]]), expr)
}

funs <- c(
  "library",
  "require",
  "use",
  "requireNamespace",
  "getFromNamespace"
)

pkg_from_lib_calls <- function(
  file) {
  ## Getting either the parse text or the file
  if (
    length(file) == 1 &&
      file.exists(file)
  ) {
    exprs <- parse(
      file,
      keep.source = FALSE
    )
  } else {
    exprs <- parse(
      text = file,
      keep.source = FALSE
    )
  }

  ## We'll collect the values here
  pkgs <- character()
  pkgs <- c()

  purrr::walk(
    exprs,
    function(one_expr) {
      codetools::walkCode(
        one_expr,
        codetools::makeCodeWalker(
          call = function(expr, w) {
            # on the first iteration, the expr is
            # fun(bla = 12, 22)
            # and the first object of expr
            # should be the function call
            # so we check this
            fn <- expr[[1]]
            if (
              is.symbol(fn) &&
                as.character(fn) %in% funs
            ) {
              # given that the loading funs are
              # from base they can be match.call
              # but there should be a better way to
              # do that ?
              expr <- reorder_and_name_args(expr)
              # Then, we get the args of this function.
              # it has been named by default with reorder_and_name_args
              args <- as.list(expr)[-1]
              if ("package" %in% names(args)) {
                pkg <- as.character(args$package)
              }
              # For getFromNamespace
              if ("ns" %in% names(args)) {
                pkg <- as.character(args$ns)
              }
              pkgs <<- c(pkgs, pkg)
            }
            # We go recursively in the args of the code
            # if ever there is a weird pattern but I'm
            # pretty sure this should be ok
            for (e in as.list(expr)[-1L]) {
              walkCode(e, w)
            }
            invisible()
          },
          leaf = function(expr, w) {
            NULL
          }
        )
      )
    }
  )
  unique(pkgs)
}

Then

write(
  c(
    "# There will be some code like library(dplyr)", # <- ignored ✅
    "library(gglot2)", # <- detected ✅
    "sprintf('%s::plot()', 'ggplot2')", # <- undetected ✅
    "# And some comments with blabla::pif", # <- ignored ✅
    "library(thispackagedoesntexist)", # <- There should be an error here ❌
    "print(toTitleCase('hello'))", # <- incorrectly ignoring toTitleCase ❌
    "plot(iris)", # <- ignored as it's from base
    "print('You can also use library(matplotlib)')", # <- undetected ✅
    "use('golem', 'run_dev')", # <- detected ✅
    "getFromNamespace('replace_na', 'tidyr')", # <- detected ✅
    "library(lib.loc = '/tmp', package = 'tidyverse')", # <- detected ✅
    "requireNamespace('pak')", # <- detected ✅
    "require(lib.loc = '/tmp', package = 'attachment')" # <- detected ✅
  ),
  file = "test_file.R"
)

> pkg_from_lib_calls(
   "test_file.R"
 )
[1] "gglot2"                 "thispackagedoesntexist" "golem"                 
[4] "tidyr"                  "tidyverse"              "pak"                   
[7] "attachment"