R/main.R

In rfold: Working with many R Folders Within an R Package

.get_necessary_r_files <- function(folders_to_ignore, type) {

  r_folder_exists <- unname(fs::dir_exists(here::here(type)))

  if (!r_folder_exists) {
    message(glue::glue("{type} folder does not exist, creating it"))

    if (type == "R") {
      fs::dir_create(here::here("R"))
    }

    if (type == "tests") {
      usethis::use_testthat()
    }

  }

  if (type == "R") {

    r_folders <- list.dirs(here::here(type))

    if (length(r_folders) > 1) {
      stop(glue::glue("Looks like you've folders insider your R folder, please inspect"))
    }

  }

  regex_to_use <- "\\.R$|\\.r$"

  if (type == "tests") {
    regex_to_use <- "test-.*\\.R$|test-.*\\.r$"
  }

  all_r_files <- fs::dir_ls(
    path = ".",
    regexp = regex_to_use,
    recurse = TRUE
  )

  all_r_files_base <- basename(all_r_files)

  test_files_to_check <- grepl(pattern = "^test-", x = all_r_files_base)

  if (type == "R") {
    all_r_files <- all_r_files[!test_files_to_check]
  }

  if (type == "tests") {
    all_r_files <- all_r_files[test_files_to_check]
  }

  tmp_df <- data.frame(
    r_files = all_r_files,
    dir_name = dirname(all_r_files),
    row.names = NULL,
    stringsAsFactors = FALSE
  )

  r_files_without_dir <- tmp_df[tmp_df$dir_name == ".", ]

  if (nrow(r_files_without_dir) > 0) {
    stop(
      "The following .R files are on the top-level
      of the package and don't have a parent directory, please inspect: ",
      toString(r_files_without_dir$r_files)
    )
  }

  folders_to_be_ignored <- c("R", "tests", "tests/testthat", folders_to_ignore)

  r_files_not_in_r_dir_df <- tmp_df[!tmp_df$dir_name %in% folders_to_be_ignored, ]

  r_files_not_in_r_dir <- r_files_not_in_r_dir_df$r_files

  r_check_folder <- grepl(".Rcheck/", x = r_files_not_in_r_dir)

  r_files_not_in_r_dir <- r_files_not_in_r_dir[!r_check_folder]

  if (length(r_files_not_in_r_dir) == 0) {

    msg <- "No R files available outside of the R directory, nothing to do"

    if (type == "tests") {
      msg <- "No test files available outside of the tests folder, did you append the name
      with the prefix 'test-'? "
    }

    cli::cli_alert_warning(msg)
    return(character(0))
  }

  r_files_names_not_in_r_dir <- basename(r_files_not_in_r_dir)

  dupli <- duplicated(r_files_names_not_in_r_dir)

  duplicated_files <- r_files_names_not_in_r_dir[dupli]

  if (length(duplicated_files) > 0) {
    stop(
      "The following file(s) are duplicated across your package: ",
      toString(duplicated_files)
    )
  }

  r_files_not_in_r_dir

}


.move_files_in_dir <- function(r_files, type, script_name_prefix) {
  dir_components <- unique(unlist(strsplit(r_files, "/")))

  dir_components <- dir_components[!grepl("\\.R$", dir_components)]

  usethis::use_build_ignore(dir_components)

  r_files_string <- paste(toString(r_files), collapse = ", ")

  file_names <- basename(r_files)

  if (type == "R") {
    new_file_names <- paste0(script_name_prefix, file_names)
  }

  if (type == "tests") {
   file_names <-  gsub(".R", "", file_names)
   file_names <-  gsub("test-", "", file_names)
   new_file_names <- paste0("test-", script_name_prefix, file_names, ".R")
  }

  dir_to_consider <- "R"

  if (type == "tests") {
    dir_to_consider <- "tests/testthat"
  }

  cli::cli_alert_info(
    "Copying the following {type} files with prefix '{script_name_prefix}' into the {dir_to_consider} folder: {r_files_string}"
  )

  fs::file_copy(
    path = r_files,
    new_path = here::here(dir_to_consider, new_file_names),
    overwrite = TRUE
  )

  for (i in seq_along(new_file_names)) {

    script_to_consider <- here::here(dir_to_consider, new_file_names[i])

    existing_script_content <- readLines(script_to_consider)

    comment <- "# GENERATED BY RFOLD: DO NOT EDIT BY HAND ####"

    if (length(existing_script_content) == 0) {
      writeLines(comment, con = script_to_consider)
      next()
    }

    if (existing_script_content[1] == comment) {
      next()
    }

    new_content <- c(
      comment,
      existing_script_content,
      comment
    )

    writeLines(new_content, con = script_to_consider)
  }

}

#' Transfer .R files into the R directory
#'
#' @return called for the side effect of transferring all R files
# available inside a project into the R folder
#' @param folders_to_ignore a string vector of plain names folders that should be ignored
#' where transferring .R files into the main R folder (for example a dev folder). Defaults to NULL
#'
#' @param script_name_prefix characters string of length 1 that will be appended to the start of the .R scripts when transferring them to the R folder. Defaults to 'DO_NOT_EDIT', set it to NULL for no appending
#'
#' @export
#'

rfold <- function(
    folders_to_ignore = NULL,
    script_name_prefix = "DO_NOT_EDIT_"
) {

  if (length(script_name_prefix) > 1) {
    stop("script_name_prefix must be of length 1")
  }

  if (is.null(script_name_prefix)) {
    script_name_prefix <- ""
  }

  if (!is.null(folders_to_ignore)) {
    dir_exist <- dir.exists(folders_to_ignore)

    if (!any(dir_exist)) {
      dir_no_exist <- folders_to_ignore[!dir_exist]
      stop("The following directories do not exist. Can't ignore them: ", dir_no_exist)

    }
  }

  normal_r_files <- .get_necessary_r_files(folders_to_ignore, type = "R")
  test_files <- .get_necessary_r_files(folders_to_ignore, type = "tests")

  if (length(normal_r_files) > 0) {
    .move_files_in_dir(
      r_files = normal_r_files,
      type = "R",
      script_name_prefix = script_name_prefix
    )
  }

  if (length(test_files) > 0) {
    .move_files_in_dir(
      r_files = test_files,
      type = "tests",
      script_name_prefix = script_name_prefix
    )
  }

}