R/rename_flat_file.R

Defines functions rename_flat_file

Documented in rename_flat_file

# WARNING - Generated by {fusen} from dev/flat_deal_with_flat_files.Rmd: do not edit by hand

#' Rename a flat file
#'
#' @param flat_file Path to the flat file to rename
#' @param new_name New name for the flat file
#'
#' @return Used for side effect. Flat file renamed, config file updated,
#' inflated files modified when needed.
#'
#' @export
#' @examples
#' \dontrun{
#' # These functions change the current user workspace
#' dev_file <- suppressMessages(
#'   add_flat_template(
#'     template = "add",
#'     pkg = ".", overwrite = TRUE, open = FALSE
#'   )
#' )
#' rename_flat_file(
#'   flat_file = "dev/flat_additional.Rmd",
#'   new_name = "flat_new.Rmd"
#' )
#' }

rename_flat_file <- function(flat_file, new_name) {
  if (!file.exists(flat_file)) {
    stop(
      paste0(
        "The flat file ", basename(flat_file),
        " does not exist."
      )
    )
  }

  if (new_name == basename(new_name)) {
    new_name_path <- file.path(dirname(flat_file), new_name)
  } else if (new_name != basename(new_name)) {
    new_name_path <- new_name
  }

  if (!grepl("[.](R|r|q|Q)md$", new_name_path)) {
    new_name_path <- paste0(new_name_path, ".Rmd")
  }

  if (file.exists(new_name_path)) {
    stop(
      paste0(
        "The new file ", new_name_path,
        " already exists."
      )
    )
  }



  # Get smaller relative paths in
  flat_file_small <- gsub(
    paste0(normalize_path_winslash("."), "/"),
    "",
    normalize_path_winslash(flat_file, mustWork = TRUE),
    fixed = TRUE
  )
  # Rename flat file
  file.rename(flat_file, new_name_path)

  # Get smaller relative paths out
  new_name_path_small <- gsub(
    paste0(normalize_path_winslash("."), "/"),
    "",
    normalize_path_winslash(new_name_path, mustWork = TRUE),
    fixed = TRUE
  )
  # Rename inside the flat file
  lines <- readLines(new_name_path_small)
  lines <- gsub(flat_file_small, new_name_path_small, lines)
  lines <- gsub(basename(flat_file_small), basename(new_name_path_small), lines)
  write_utf8(lines = lines, path = new_name_path_small)


  cli_alert_info(
    paste0(
      "The flat file ", flat_file,
      " has been renamed to ", new_name_path
    )
  )

  config_file <- getOption("fusen.config_file", "dev/config_fusen.yaml")

  if (!file.exists(config_file)) {
    return(invisible(new_name_path))
  }

  config <- yaml::read_yaml(config_file)

  if (basename(flat_file) %in% names(config)) {
    names(config)[names(config) == basename(flat_file)] <-
      basename(new_name_path)
    config[[basename(new_name_path)]]$path <- new_name_path
    config[[basename(new_name_path)]]$inflate$flat_file <- new_name_path
    config[[basename(flat_file)]] <- NULL

    write_yaml_verbatim(config, config_file)

    cli_alert_info(
      paste0(
        "The flat file ", basename(flat_file),
        " has been updated in the config file."
      )
    )
  }

  # Update inflated files
  all_linked_files <- unlist(
    config[[basename(new_name_path)]][
      c("R", "tests", "vignettes")
    ]
  )

  if (length(all_linked_files) > 0) {
    for (file in all_linked_files) {
      lines <- readLines(file)
      lines <- gsub(
        basename(flat_file),
        basename(new_name_path),
        lines
      )
      write_utf8(lines = lines, path = file)
    }
    cli_alert_info(
      paste0(
        "The flat file ", basename(new_name_path),
        " has been updated in the inflated files."
      )
    )
  }

  return(invisible(new_name_path))
}

Try the fusen package in your browser

Any scripts or data that you put into this service are public.

fusen documentation built on May 29, 2024, 6:42 a.m.