R/import.R

In wch/staticimports: Statically Import Utility Functions

# @staticimports pkg:staticimports
#   is_string cat0
#   map_chr walk

#' Statically import objects
#'
#' @description
#'
#' This function finds staticimports declarations and copies the objects to a
#' target file.
#'
#' staticmports declartions are comment blocks that look like this:

#'
#' ```
#' # @staticimports pkg:staticimports
#' #   map map_chr map_lgl os_name any_named any_unnamed
#' #   all_named all_unnamed
#' ```

#'
#' The `pkg:staticimports` means to import objects from the package named
#' **staticimports**. If you use `pkg:mypackage`, it will import from
#' **mypackage**.
#'
#' On the following lines are the names of the objects to import.
#'

#'
#' The import declaration can also use a path. For example:
#'
#' ```
#' # @staticimports ../mystaticexports
#' #   map map_chr map_lgl os_name any_named any_unnamed
#' #   all_named all_unnamed
#' ```

#'
#' If a relative path is used, it will be relative to the top-leve of this
#' project, as determined by [here::here()].
#'
#' The statically imported objects are written a file, by default
#' `R/staticimports.R`.
#'
#' @param dir A directory containing .R files to scan for import declarations.
#' @param outfile File to write to. Defaults to R/staticimports.R in the current
#'   project. Use `stdout()` to output to console.
#'
#' @export
import <- function(
  dir     = here::here("R/"),
  outfile = here::here("R/staticimports.R")
)
{
  imports <- find_staticimports(dir)

  if (is.character(outfile) && file.exists(outfile)) {
    file.remove(outfile)
  }
  for (import in imports) {
    import_objs(
      names   = import$names,
      source  = import$path,
      outfile = outfile,
      label   = import$label,
      append  = TRUE
    )
  }
}


#' Statically import specific objects
#'
#' @inheritParams import
#' @param names A character vector of names of objects to import.
#' @param source A directory containing source files, or an environment to use
#'   as the source.
#' @param label A label to write to the file, to indicate where the objects were
#'   imported from.
#' @param append If `TRUE`, append to the output file; otherwise overwrite.
#'
#' @examples
#' if (interactive()) {
#' # Import `os_name` and `walk` into your project
#' import_objs(c("os_name", "walk"))
#' }
#'
#' # Write to stdout instead of R/staticimports.R
#' import_objs(c("os_name", "walk"), outfile = stdout())
#' @export
import_objs <- function(
  names,
  source  = system.file("staticexports", package = "staticimports"),
  outfile = here::here("R/staticimports.R"),
  label   = NULL,
  append  = FALSE
) {
  if (is.environment(source)) {
    env <- source
  } else {
    env <- new.env()
    files <- dir(source, pattern = "\\.[r|R]$", full.names = TRUE)
    source_text <- list() # The contents of each file
    for (file in files) {
      source(file, local = env, keep.source = TRUE)
      source_text[[file]] <- readLines(file)
    }
  }

  if ("*" %in% names) {
    explicit_names <- setdiff(names, "*")
    all_names <- ls(env, all.names = TRUE)
    # Include any names that were explicitly requested alongside "*" so the user
    # will get an error if any names could not be found.
    all_dep_names <- c(explicit_names, all_names)
  } else {
    dep_table <- find_internal_deps(env)
    all_dep_names <- c(names, unlist(dep_table[names], recursive = FALSE, use.names = FALSE))
  }

  all_dep_names <- sort(unique(all_dep_names))

  all_dep_objs <- mget(all_dep_names, env)

  all_source_text <- process_source_texts(source_text)

  # Given a list of functions (with source refs), write the source to a file.
  write_deps <- function(fns, outfile) {
    if (is_string(outfile)) message("Writing to ", outfile)

    cat(paste(
      sep = "",
      "# Generated by staticimports; do not edit by hand.\n",
      "# ======================================================================\n",
      if (!is.null(label)) {
        paste0(
          "# Imported from ", label, "\n",
          "# ======================================================================\n",
          sep = ""
        )
      }
    ), file = outfile, append = append)

    for (i in seq_along(fns)) {
      fn_name <- names(fns)[i]
      fn_txt <- all_source_text[[fn_name]]
      if (is.null(fn_txt)) {
        stop("Source for `", fn_name, "` not found.")
      }

      cat0(
        "\n",
        paste0(fn_txt, collapse = "\n"),
        "\n",
        file = outfile,
        append = TRUE
      )
    }
  }

  write_deps(all_dep_objs, outfile)
}


#' Find any static imports in the comments of the R/ directory
#'
#' This finds staticimports declarations, which are comment blocks that look
#' like:
#'
#' ```
#' # @staticimports pkg:staticimports
#' #   map map_chr map_lgl os_name any_named any_unnamed
#' #   all_named all_unnamed
#' ```
#'
#' @param dir A directory to look in. Defaults to
#'
#' @return A list of lists. Each sub-list has a `source` field and `names`.
#'
#' @export
find_staticimports <- function(dir = here::here("R/")) {
  files <- dir(dir, pattern = "\\.[r|R]$", full.names = TRUE)

  comment_blocks <- lapply(files, function(file) {
    text <- readLines(file)
    match_line_idxs <- grep("^#\\s+@staticimports", text)
    if (length(match_line_idxs) == 0) {
      return(NULL)
    }

    comment_blocks <- list()
    # Find any lines after this that start with #
    comment_start_line_idxs <-  grep("^#", text)
    for (i in seq_along(match_line_idxs)) {
      match_line_idx <- match_line_idxs[[i]]
      comment_block_lines <- text[[match_line_idx]]

      j <- match_line_idx + 1
      while (j %in% comment_start_line_idxs) {
        comment_block_lines[length(comment_block_lines) + 1] <- text[[j]]
        j <- j + 1
      }

      comment_blocks[[i]] <- list(
        file = file,
        start_line = match_line_idx,
        text = comment_block_lines
      )
    }

    comment_blocks
  })

  comment_blocks <- unlist(comment_blocks, recursive = FALSE)

  imports <- lapply(comment_blocks, function(block) {
    # First line of each block starts is "# @staticimports xxxxx"
    first <- block$text[[1]]
    source <- sub("^#\\s+@staticimports\\s+", "", first)
    source <- sub("\\s+$", "", source)

    if (!grepl("^\\S+$", source)) {
      stop(
        'staticimports spec does not have format "# @staticimports xxxxx" ',
        'in ', block$file, ", ", "line ", block$start_line, ":\n",
        first
      )
    }

    lines <- sub("^#", "", block$text[-1])
    names <- unique(unlist(strsplit(lines, " +")))
    names <- setdiff(names, "")

    list(
      source = source,
      names = names
    )
  })


  # Merge together staticimport specifications that come from the same file.
  sources <- unique(map_chr(imports, "source"))
  # Use radix to ensure consistent sorting across locales.
  sources <- sort(sources, method = "radix")
  imports <- lapply(sources, function(source) {
    names <- lapply(imports, function(x) {
      if (x$source == source) x$names
      else                    NULL
    })

    list(
      source = source,
      names = sort(unlist(names), method = "radix")
    )
  })

  # Convert "pkg:foo" to the path in the package.
  imports <- lapply(imports, function(x) {
    if (grepl("^pkg:\\S+$", x$source)) {
      pkg_name <- sub("^pkg:", "", x$source)
      source_path <- system.file("staticexports", package = pkg_name)
    } else {
      source_path <- here::here(x$source)
      source_path <- normalizePath(source_path)
    }

    list(
      label = x$source,
      path  = source_path,
      names = x$names
    )
  })

  imports
}