R/register_config_file.R

In fusen: Build a Package from Rmarkdown Files

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

#' Show in a table files that are not already registered in the yaml config file
#'
#' If user start their package without 'fusen' or with version < 0.4, they need to create the config file, with already existing functions.
#'
#' @param path Path to package to check for not registered files
#' @param guess Logical. Guess if the file was inflated by a specific flat file
#' @param to_csv Logical. Whether to store along the config file, the outputs in a csv for the user to clean it manually
#' @param open Logical. Whether to open the csv of unregistered files.
#' @return Path to csv file if `to_csv` is TRUE. `dput()` of the dataframe otherwise.
#' @importFrom utils write.csv
#'
#' @seealso
#'   [register_all_to_config()] for automatically registering all files already present in the project,
#'   [inflate_all()] to inflate every flat files according to the configuration file.
#'
#' @export
#' @examples
#' \dontrun{
#' # Run this on the current package in development
#' out_csv <- check_not_registered_files()
#' file.edit(out_csv)
#' }
#'
#' # Or you can try on the reproducible example
#' dummypackage <- tempfile("clean")
#' dir.create(dummypackage)
#'
#' # {fusen} steps
#' fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
#' dev_file <- suppressMessages(add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE))
#' flat_file <- dev_file[grepl("flat_", dev_file)]
#' # Inflate once
#' usethis::with_project(dummypackage, {
#'   suppressMessages(
#'     inflate(
#'       pkg = dummypackage, flat_file = flat_file,
#'       vignette_name = "Get started", check = FALSE,
#'       open_vignette = FALSE
#'     )
#'   )
#'
#'   # Add a not registered file to the package
#'   cat("# test R file\n", file = file.path(dummypackage, "R", "to_keep.R"))
#'
#'   # Use the function to check the list of files
#'   out_csv <- check_not_registered_files(dummypackage)
#'   out_csv
#'   # Read the csv to see what is going on
#'   content_csv <- read.csv(out_csv, stringsAsFactors = FALSE)
#'   content_csv
#'   # Keep it all or delete some files, and then register all remaining
#'   out_config <- register_all_to_config()
#'   out_config
#'   # Open the out_config file to see what's going on
#'   yaml::read_yaml(out_config)
#' })
#' unlink(dummypackage, recursive = TRUE)
check_not_registered_files <- function(path = ".", guess = TRUE, to_csv = TRUE, open = FALSE) {
  path <- normalize_path_winslash(path)

  all_r <- list.files(file.path(path, "R"), pattern = "[.]R$|[.]r$", full.names = TRUE)
  all_test <- list.files(file.path(path, "tests", "testthat"), pattern = "[.]R$|[.]r$", full.names = TRUE)
  all_vignette <- list.files(file.path(path, "vignettes"), pattern = "[.]Rmd$|[.]rmd$", full.names = TRUE)

  res <- data.frame(
    type = c(
      rep("R", length(all_r)),
      rep("test", length(all_test)),
      rep("vignette", length(all_vignette))
    ),
    path = c(
      all_r, all_test, all_vignette
    ),
    stringsAsFactors = FALSE
  )

  if (nrow(res) == 0) {
    message("There are no files in the package. Did you inflate it once?")
    return(NULL)
  }

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

  if (file.exists(config_file)) {
    # Read config file, and remove those already there
    config_list <- yaml::read_yaml(config_file)
    config_list_path <- normalize_path_winslash(get_list_paths(config_list), mustWork = FALSE)
    res_existing <- res[res$path %in% config_list_path, ]
    res_new <- res[!res$path %in% config_list_path, ]
    config_flat_paths <- sapply(config_list, function(x) x[["path"]])
    config_flat_paths <- config_flat_paths[!names(config_flat_paths) == "keep"]
  } else {
    res_existing <- res[FALSE, ]
    res_new <- res
    config_flat_paths <- NULL
  }

  if (nrow(res_new) == 0) {
    cli::cli_alert_success("There are no unregistered files.")
    return(NULL)
  }

  # Guess those not in config_file
  # All files without path, are changed for "keep"
  if (isTRUE(guess)) {
    # List all files
    res_new$origin <- unlist(lapply(res_new$path, guess_flat_origin))
    # Change if guessed origin is already in the config file
    # This may mean that the package is not clean
    if (!is.null(config_flat_paths)) {
      res_new$origin[which(res_new$origin %in% config_flat_paths)] <-
        paste0(
          "Possibly deprecated file. Please check its link with detected flat source: ",
          res_new$origin[which(res_new$origin %in% config_flat_paths)]
        )
    }
  } else {
    res_new$origin <- "keep"
  }

  # TODO go back to relative path
  res_new$path <- gsub(paste0(normalize_path_winslash(getwd()), "/"), "", normalize_path_winslash(res_new$path, mustWork = TRUE), fixed = TRUE)

  # config_file may not exist already
  csv_file <- file.path(
    gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), "config_not_registered.csv"
  )

  # Save for manual modification
  if (isTRUE(to_csv)) {
    write.csv(res_new, csv_file, row.names = FALSE)
    cli::cli_text(
      cli::cli_alert_info(c(
        "\nSome files in your package are not registered in the configuration file: {config_file}",
        "\n{.pkg fusen} uses a configuration file to store the structure of your package and help you clean it when needed.",
        "\nYou will find a list of unregistered files there: {.path csv_file}",
        " that you can open with {.run file.edit('{csv_file}')}",
        "\nDelete unregistered files that you do not need anymore. Then run {.fn fusen::register_all_to_config}.",
        "\nAfter that, this message should not appear in your next {.fn fusen::inflate_all} calls.",
        "\nFor more information, read `vignette('{.vignette [register-files-in-config](fusen::register-files-in-config)}', package = 'fusen')`"
      ))
    )

    if (isTRUE(open) & interactive()) {
      if (requireNamespace("rstudioapi") &&
        rstudioapi::isAvailable() &&
        rstudioapi::hasFun("navigateToFile")) {
        rstudioapi::navigateToFile(csv_file)
      } else {
        utils::file.edit(csv_file)
      }
    }

    return(csv_file)
  } else {
    # return a `dput()` to allow to add to `df_to_config()`
    # dput()
    # return(dput(res_new, file = nullfile()))
    return(res_new)
  }
}

#' Guess flat file of origin of a script
#'
#' @param path Path of the script to test
#' @noRd
guess_flat_origin <- function(path) {
  lines <- readLines(path)

  guess_path <- sub(
    ".* from\\s*(/){0,1}(.+[.].{1}md).*", "\\2",
    lines[grep("(G|g)enerated by \\{fusen\\} from", lines)][1]
  )

  guess_path <- normalize_path_winslash(guess_path, mustWork = FALSE)
  if (file.exists(guess_path)) {
    guess_path <- gsub(
      paste0(normalize_path_winslash(getwd()), "/"), "",
      normalize_path_winslash(guess_path, mustWork = FALSE)
    )
    return(guess_path)
  } else {
    return("No existing source path found.")
  }
}

#' Get all paths from a config list, except some
#' @param config_list List as read from config.yaml file
#' @noRd
get_list_paths <- function(config_list) {
  unlist(lapply(config_list, function(x) {
    if (x$path == "keep") x$path <- NULL
    x$state <- NULL
    x
  }))
}

#' Add a tibble of files and types to add to the 'fusen' config file along with inflate parameters
#'
#' @param df_files A data.frame with 'type' and 'path' columns
#' or a csv file path as issued from `[check_not_registered_files()]`
#' or nothing (and it will take the csv file in "dev/")
#' @param flat_file_path Character. Usually set to `"keep"` for users. You can use the name of the origin flat file but this is more of an internal use, as inflating the flat file should have the same result.
#' @param state Character. Whether if the flat file is `active` or `deprecated`.
#' @param force Logical. Whether to force writing the configuration file even is some files do not exist.
#' @param clean Logical. Delete list associated to a specific flat file before updating the whole list.
#' Default is set to TRUE during `inflate()` of a specific flat file, as the list should only contain files created during the inflate.
#' This could be set to FALSE with a direct use of `df_to_config()` too. This is forced to FALSE for "keep" section.
#' @param inflate_parameters list of parameters passed through a call to `inflate()`

#' @importFrom stats setNames
#' @importFrom utils read.csv
#' @importFrom cli cli_alert_warning cli_alert_info
#'
#' @return Config file path.
#' Side effect: create a yaml config file.
#'
#' @seealso
#'   [check_not_registered_files()] for the list of files not already associated with a flat file in the config file,
#'   [register_all_to_config()] for automatically registering all files already present in the project
#'
#' @noRd

df_to_config <- function(df_files,
                         flat_file_path = "keep",
                         state = c("active", "deprecated"),
                         force = FALSE,
                         clean = TRUE,
                         inflate_parameters = NULL) {
  config_file <- getOption("fusen.config_file", default = "dev/config_fusen.yaml")
  state <- match.arg(state, several.ok = FALSE)

  # User entry verifications
  if (missing(df_files)) {
    df_files <- file.path(dirname(config_file), "config_not_registered.csv")
    df_files <- deal_with_registered_keep(df_files)
  }

  if (!is.data.frame(df_files) && file.exists(df_files)) {
    df_files <- read.csv(df_files, stringsAsFactors = FALSE)
  } else if (!is.data.frame(df_files) && !file.exists(df_files)) {
    stop("'", df_files, "' does not exist. You can run `check_not_registered_files()` before.")
  }

  # Then if is.data.frame(df_files)
  if (!all(c("type", "path") %in% names(df_files))) {
    stop("df_files should contains two columns named: 'type' and 'path'")
  }

  if (!"origin" %in% names(df_files)) {
    df_files[["origin"]] <- flat_file_path
  } else {
    # check origin exists
    df_files_origin <- df_files[["origin"]]
    df_files_origin <- df_files_origin[df_files_origin != "keep"]
    all_exists <- file.exists(df_files_origin)
    if (!all(all_exists)) {
      msg <- paste(
        "Some 'origin' in df_files do not exist:",
        paste(
          paste0(
            "row ", which(!all_exists), ": ",
            df_files[["origin"]][!all_exists]
          ),
          collapse = ", "
        )
      )
      if (isTRUE(force)) {
        cli_alert_warning(
          paste(msg, "\nHowever, you forced to write it in the yaml file with `force = TRUE`.")
        )
      } else {
        stop(msg)
      }
    }
  }

  if (flat_file_path != "keep") {
    flat_file_path_relative <- gsub(
      paste0(normalize_path_winslash("."), "/"),
      "",
      normalize_path_winslash(flat_file_path, mustWork = TRUE),
      fixed = TRUE
    )
  }

  if (!all(grepl("^R$|^r$|^test$|^tests$|^vignette$|^vignettes$", df_files[["type"]]))) {
    stop("Only types 'R', 'test' or 'vignette' are allowed")
  }
  all_exists <- file.exists(df_files[["path"]])
  if (!all(all_exists)) {
    msg <- paste(
      "Some 'path' in df_files do not exist:",
      paste(
        paste0(
          "row ", which(!all_exists), "- ",
          df_files[["type"]][!all_exists], ": ",
          df_files[["path"]][!all_exists]
        ),
        collapse = ", "
      )
    )

    if (isTRUE(force)) {
      cli_alert_warning(
        paste(msg, "\nHowever, you forced to write it in the yaml file with `force = TRUE`.")
      )
    } else {
      stop(msg)
    }
  }

  if (!is.null(inflate_parameters) & flat_file_path == "keep") {
    stop("The purpose of using \"keep\" is to store files created without inflate(). Therefore it is not allowed to provide inflate_parameters")
  }

  # Remove common part between config_file and all path
  # to get relative paths to project

  # TODO - When path does not exists, normalizePath does not correctly
  # use path.expand.
  # All path should exists. It is tested above.
  if (!isTRUE(force) || isTRUE(all(file.exists(df_files$path)))) {
    df_files$path <- gsub(
      paste0(normalize_path_winslash("."), "/"),
      "",
      normalize_path_winslash(df_files$path, mustWork = TRUE),
      fixed = TRUE
    )
  }

  # All origin path should exist, if not "keep"
  if (!isTRUE(force) || isTRUE(all(file.exists(df_files$origin[df_files$origin != "keep"])))) {
    df_files$origin[df_files$origin != "keep"] <- gsub(
      paste0(normalize_path_winslash("."), "/"),
      "",
      normalize_path_winslash(df_files$origin[df_files$origin != "keep"], mustWork = TRUE),
      fixed = TRUE
    )
  } else if (isFALSE(all(file.exists(df_files$origin[df_files$origin != "keep"])))) {
    warning(
      "Please open a bug on {fusen} package with this complete message:\n",
      "There is an error in the df_to_config process.\n",
      "Files origin do not exist but will be registered as is in the config file:\n",
      paste(df_files$origin[!file.exists(df_files$origin[df_files$origin != "keep"])],
        collapse = ", "
      )
    )
  }

  if (any(duplicated(df_files$path))) {
    msg <- paste("Some paths appear multiple times in df_files. Please remove duplicated rows: ", paste(unique(df_files$path[duplicated(df_files$path)]), collapse = ", "))

    if (isTRUE(force)) {
      cli_alert_warning(
        paste(msg, "\nHowever, you forced to write it in the yaml file with `force = TRUE`.")
      )
    } else {
      stop(msg)
    }
  }

  if (file.exists(config_file)) {
    complete_yaml <- read_yaml(config_file)

    yaml_paths <- get_list_paths(complete_yaml)
    yaml_paths <- yaml_paths[!grepl("inflate\\.", names(yaml_paths))]
    all_exists <- file.exists(yaml_paths)
    if (!all(all_exists)) {
      msg <- paste(
        "Some paths in config_file do not exist:",
        paste(
          yaml_paths[!all_exists],
          collapse = ", "
        ), ".\n",
        "Please open the configuration file: ", config_file, " to verify, and delete the non-existing files if needed."
      )
      if (isTRUE(force)) {
        cli_alert_warning(
          paste(msg, "However, you forced to write it in the yaml file with `force = TRUE`.")
        )
      } else {
        stop(msg)
      }
    }
  } else {
    complete_yaml <- list()
  }

  each_flat_file_path <- unique(c(flat_file_path, df_files[["origin"]]))
  if (length(state) != length(each_flat_file_path)) {
    state <- rep(state, length.out = length(each_flat_file_path))
  }
  all_groups_list <- lapply(
    seq_along(each_flat_file_path),
    function(x) {
      update_one_group_yaml(
        df_files, complete_yaml,
        each_flat_file_path[x],
        state = state[x],
        clean = ifelse(each_flat_file_path[x] == "keep", FALSE, clean),
        inflate_parameters = inflate_parameters
      )
    }
  ) %>%
    setNames(basename(each_flat_file_path))

  all_modified <- names(complete_yaml)[names(complete_yaml) %in% names(all_groups_list)]

  if (length(all_modified) != 0) {
    cli_alert_info(
      paste0(
        "Some files group already existed and were ", ifelse(isTRUE(clean), "overwritten: ", "modified: "),
        paste(all_modified, collapse = ", ")
      )
    )
    complete_yaml[all_modified] <- NULL
  }

  # Combine with complete_yaml
  complete_yaml <- c(complete_yaml, all_groups_list)
  # order according to name without path so that flat_2 is after flat.Rmd
  complete_yaml <- complete_yaml[order(
    sub("(?<!^|[.]|/)[.][^.]+$", "", names(complete_yaml), perl = TRUE)
  )]

  # Get duplicated paths after update
  yaml_paths <- unlist(complete_yaml)
  # Except info on state
  yaml_paths <- yaml_paths[!grepl("[.]state$", names(yaml_paths))]
  yaml_paths <- yaml_paths[!grepl("inflate\\.", names(yaml_paths))]

  if (any(duplicated(yaml_paths))) {
    which_file <- files_list_to_vector(
      lapply(complete_yaml, files_list_to_vector)
    )

    if (isTRUE(force)) {
      cli_alert_warning("Some paths appear multiple times in the config file. The yaml was forced with `force = TRUE`. Please verify the source of these scripts in the existing yaml file or in the df_files provided:\n", paste(which_file[duplicated(yaml_paths)], collapse = ",\n"))
    } else {
      stop("Some paths would appear multiple times in the future config file. The yaml has not been created. Please verify the source of these scripts in the existing yaml file or in the df_files provided:\n", paste(which_file[duplicated(yaml_paths)], collapse = ",\n"), "\nOr use `force = TRUE`")
    }
  }

  write_yaml_verbatim(complete_yaml, file = config_file)

  return(config_file)
}


#' Make sure yaml returns true/false as is, and not "yes/no"
#' @importFrom yaml write_yaml read_yaml
#' @noRd
write_yaml_verbatim <- function(x, file) {
  write_yaml(x,
    file = file,
    handlers = list(
      logical = function(x) {
        result <- ifelse(x, "true", "false")
        class(result) <- "verbatim"
        return(result)
      }
    )
  )
}

#' Extract name of file along with type to inform the user
#' @param list_of_files A named list of files
#' @noRd
files_list_to_vector <- function(list_of_files) {
  lapply(seq_along(list_of_files), function(x) {
    if (length(list_of_files[[x]]) != 0) {
      paste(names(list_of_files[x]), list_of_files[[x]], sep = ": ")
    }
  }) %>% unlist()
}

#' Update one group in the complete yaml as list
#' @param complete_yaml The list as output of config_yaml file
#' @param flat_file_path The group to update
#' @param state Character. See `df_to_config()`.
#' @param clean Logical. See `df_to_config()`.
#' @param inflate_parameters See `df_to_config()`.
#' @importFrom cli cli_alert_warning cli_alert_success
#' @noRd
update_one_group_yaml <- function(df_files,
                                  complete_yaml,
                                  flat_file_path,
                                  state = c("active", "deprecated"),
                                  clean = TRUE,
                                  inflate_parameters = NULL) {
  state <- match.arg(state, several.ok = FALSE)
  all_keep_before <- complete_yaml[[basename(flat_file_path)]]

  # Only files from df_files will be listed
  df_files_filtered <- df_files[df_files[["origin"]] == flat_file_path, ]

  # All already in the list will be deleted except if clean is FALSE
  if (isTRUE(clean)) {
    this_group_list <- list(
      path = flat_file_path,
      state = state,
      R = c(df_files_filtered[["path"]][
        grepl("^R$|^r$", df_files_filtered[["type"]])
      ]),
      tests = c(df_files_filtered[["path"]][
        grepl("^test$|^tests$", df_files_filtered[["type"]])
      ]),
      vignettes = c(df_files_filtered[["path"]][
        grepl("^vignette$|^vignettes$", df_files_filtered[["type"]])
      ])
    )
  } else {
    this_group_list <- list(
      path = flat_file_path,
      state = state,
      R = unique(c(
        # new ones
        df_files_filtered[["path"]][
          grepl("^R$|^r$", df_files_filtered[["type"]])
        ],
        # previous ones
        unlist(all_keep_before[["R"]])
      )),
      tests = unique(c(
        # new ones
        df_files_filtered[["path"]][
          grepl("^test$|^tests$", df_files_filtered[["type"]])
        ],
        # previous ones
        unlist(all_keep_before[["tests"]])
      )),
      vignettes = unique(c(
        # new ones
        df_files_filtered[["path"]][grepl("^vignette$|^vignettes$", df_files_filtered[["type"]])],
        # previous ones
        unlist(all_keep_before[["vignettes"]])
      ))
    )
  }

  this_group_list_return <- this_group_list
  this_group_list_message <- this_group_list
  if (!is.null(inflate_parameters)) {
    this_group_list_return <- c(this_group_list, list(inflate = inflate_parameters))
    this_group_list_message <- c(this_group_list, list(inflate = "each parameter"))
  }

  # Messages only
  all_names <- names(this_group_list_message)
  those_removed <- lapply(
    all_names,
    function(x) {
      setdiff(
        all_keep_before[[x]],
        this_group_list_message[[x]]
      )
    }
  ) %>%
    setNames(all_names)

  those_removed_vec <- files_list_to_vector(those_removed)
  those_added <- lapply(
    all_names,
    function(x) {
      setdiff(
        this_group_list_message[[x]],
        all_keep_before[[x]]
      )
    }
  ) %>%
    setNames(all_names)
  those_added_vec <- files_list_to_vector(those_added)

  if (!is.null(those_removed_vec) || length(those_removed_vec) != 0) {
    silent <- lapply(paste(those_removed_vec, "was removed from the config file"), cli_alert_warning)
  }
  if (!is.null(those_added_vec) || length(those_added_vec) != 0) {
    silent <- lapply(paste(those_added_vec, "was added to the config file"), cli_alert_success)
  }

  return(this_group_list_return)
}

#' Include all existing package files in the config file
#'
#' Helps transition from non-fusen packages or made with earlier version
#'
#' @param pkg Path to the package from which to add file to configuration file
#' @return Invisible path to 'fusen' configuration file
#'
#' @seealso
#'   [check_not_registered_files()] for the list of files not already associated with a flat file in the config file,
#'
#' @export
#' @examples
#' \dontrun{
#' # Usually run this one inside the current project
#' # Note: running this will write "dev/config_fusen.yaml" in your working directory
#' register_all_to_config()
#' }
#'
#' # Or you can try on the reproducible example
#' dummypackage <- tempfile("register")
#' dir.create(dummypackage)
#'
#' # {fusen} steps
#' fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
#' dev_file <- suppressMessages(add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE))
#' flat_file <- dev_file[grepl("flat_", dev_file)]
#' # Inflate once
#' usethis::with_project(dummypackage, {
#'   suppressMessages(
#'     inflate(
#'       pkg = dummypackage, flat_file = flat_file,
#'       vignette_name = "Get started", check = FALSE,
#'       open_vignette = FALSE
#'     )
#'   )
#'   out_path <- register_all_to_config(dummypackage)
#'
#'   # Look at the output
#'   yaml::read_yaml(out_path)
#' })
register_all_to_config <- function(pkg = ".") {
  # Use the function to check the list of files
  out_df <- check_not_registered_files(pkg, to_csv = FALSE, open = FALSE)

  config_file <- getOption("fusen.config_file", default = "dev/config_fusen.yaml")
  if (is.null(out_df)) {
    message("There is no file to register or everything was already registered")
    return(config_file)
  }

  # Deal with files linked to a flat file that is already registered
  # Change them to "keep"
  out_df_keep <- deal_with_registered_keep(out_df)
  out_config <- df_to_config(df_files = out_df_keep, clean = FALSE)

  # Delete out_df
  csv_file <- file.path(
    gsub(paste0(normalize_path_winslash(getwd()), "/"), "", dirname(normalize_path_winslash(config_file, mustWork = FALSE)), fixed = TRUE), "config_not_registered.csv"
  )
  if (file.exists(csv_file)) {
    cli::cat_rule(paste("Delete", csv_file))
    file.remove(csv_file)
  }

  return(invisible(out_config))
}

#' Deal with files linked to a flat file that is already registered and other files to keep
#' @param df dataframe as read from [check_not_registered_files()]
#' @noRd
deal_with_registered_keep <- function(df) {
  w.keep <- grep("No existing source path found|Possibly deprecated file", df[["origin"]])
  df[["origin"]][w.keep] <- "keep"

  return(df)
}