R/inflate_all_utils.R

In fusen: Build a Package from Rmarkdown Files

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

#' This function evaluates whether flat files can or can not be inflated with `inflate_all()`
#'
#' Internal function used in `inflate_all()`
#'
#' @param config_yml List. Content of the fusen config_file
#' @param pkg Character. Path of the current package
#'
#' @importFrom glue glue
#' @importFrom tibble tibble
#'
#' @return a tibble with the ability to each flat file to be inflated by inflate_all()
#' @noRd
#' @examples
#' \dontrun{
#' dummypackage <- tempfile("register")
#' dir.create(dummypackage)
#' fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
#' dev_file <-
#'   suppressMessages(add_minimal_package(
#'     pkg = dummypackage,
#'     overwrite = TRUE,
#'     open = FALSE
#'   ))
#' # let's create 2 flat files
#' flat_file <- dev_file[grepl("flat_", dev_file)]
#' flat_file2 <-
#'   gsub(
#'     x = flat_file,
#'     pattern = "flat_minimal.Rmd",
#'     replacement = "flat_minimal_2.Rmd"
#'   )
#' file.copy(
#'   from = flat_file,
#'   to = flat_file2,
#'   overwrite = TRUE
#' )
#'
#' # let's inflate them to have dev/config_fusen.yml
#' suppressMessages(
#'   inflate(
#'     pkg = dummypackage,
#'     flat_file = flat_file,
#'     vignette_name = "Get started",
#'     check = FALSE,
#'     open_vignette = FALSE
#'   )
#' )
#'
#' suppressMessages(
#'   inflate(
#'     pkg = dummypackage,
#'     flat_file = flat_file2,
#'     vignette_name = "Get started2",
#'     check = FALSE,
#'     open_vignette = FALSE
#'   )
#' )
#'
#' config_yml_ref <-
#'   yaml::read_yaml(file.path(dummypackage, "dev/config_fusen.yaml"))
#'
#' # all files can be inflated with inflate_all()
#' config_yml <- config_yml_ref
#' diag <-
#'   pre_inflate_all_diagnosis(config_yml = config_yml, pkg = dummypackage)
#' print(diag)
#'
#' # let's consider the first flat file is deprecated
#' config_yml <- config_yml_ref
#' config_yml[["flat_minimal.Rmd"]][["state"]] <- "deprecated"
#' diag <-
#'   pre_inflate_all_diagnosis(config_yml = config_yml, pkg = dummypackage)
#' print(diag)
#'
#' # let's consider the first flat file is missing from config_fusen.yaml
#' config_yml <- config_yml_ref
#' config_yml[["flat_minimal.Rmd"]] <- NULL
#' diag <-
#'   pre_inflate_all_diagnosis(config_yml = config_yml, pkg = dummypackage)
#' print(diag)
#'
#' # let's consider that the first flat file has not inflate related params in config_fusen.yaml
#' config_yml <- config_yml_ref
#' config_yml[["flat_minimal.Rmd"]][["inflate"]] <- NULL
#' diag <-
#'   pre_inflate_all_diagnosis(config_yml = config_yml, pkg = dummypackage)
#' print(diag)
#'
#' # let's consider a file is in config.yml but missing from dev/
#' config_yml <- config_yml_ref
#' config_yml[["missing_file.Rmd"]] <- config_yml[["flat_minimal.Rmd"]]
#' diag <-
#'   pre_inflate_all_diagnosis(config_yml = config_yml, pkg = dummypackage)
#' print(diag)
#'
#' unlink(dummypackage, recursive = TRUE)
#' }
pre_inflate_all_diagnosis <- function(config_yml, pkg) {
  flat_file_in_config <- setdiff(names(config_yml), "keep")
  flat_files_in_dev_folder <- list.files(file.path(pkg, "dev"), pattern = "^flat_.*[.](r|R|q|Q)md$")

  flat_files_to_diag <- unique(c(flat_files_in_dev_folder, flat_file_in_config))

  if (length(flat_files_to_diag) == 0) {
    stop("There are no flat files listed in config or files starting with 'flat_' in the 'dev/' directory")
  }

  config_paths <- sapply(config_yml[which(names(config_yml) != "keep")], function(x) x$path)
  flat_files_in_config_that_dontexist <- character(0)
  if (length(config_paths) != 0) {
    flat_files_in_config_that_dontexist <- names(config_paths)[!file.exists(config_paths)]
  }


  flat_files_status <- lapply(flat_files_to_diag, function(flat) {
    # flat <- flat_files_to_diag[2]
    if (flat %in% flat_files_in_config_that_dontexist) {
      return(tibble(
        flat = flat,
        status = glue(
          "The file {flat} is not going to be inflated because it was not found,",
          " have you changed the name or did you move in another place ?",
          " Maybe you want to set the state as 'state: deprecated' in the config file"
        ),
        type = "stop",
        params = "call. = FALSE"
      ))
    } else if (flat %in% names(config_yml) &&
      "inflate" %in% names(config_yml[[flat]]) &&
      !is.null(config_yml[[flat]][["state"]]) &&
      config_yml[[flat]][["state"]] == "active") {
      return(tibble(
        flat = flat,
        status = glue("The flat file {flat} is going to be inflated"),
        type = "cli::cli_alert_success",
        params = NA
      ))
    } else if (flat %in% names(config_yml) &&
      is.null(config_yml[[flat]][["state"]])) {
      return(tibble(
        flat = flat,
        status = glue(
          "The flat file {flat} is not going to be inflated because there is no 'state'",
          " in the configuration file. ",
          "\nPlease inflate() it manually once to get the full configuration file.",
          " Then you will be able to use `inflate_all*()` again."
        ),
        type = "cli::cli_alert_warning",
        params = NA
      ))
    } else if (flat %in% names(config_yml) &&
      config_yml[[flat]][["state"]] != "active") {
      return(tibble(
        flat = flat,
        status = glue(
          "The flat file {flat} is not going to be inflated because",
          " it is in state 'inactive or deprecated'"
        ),
        type = "cli::cli_alert_warning",
        params = NA
      ))
    } else if (!flat %in% names(config_yml)) {
      return(tibble(
        flat = flat,
        status = glue(
          "The flat file {flat} is not going to be inflated.",
          " It was detected in your flats directory but it is absent from the config file.",
          "\nPlease inflate() it manually when you are ready, so that it is accounted the next time.",
          " Then you will be able to fully use `inflate_all*()`."
        ),
        type = "cli::cli_alert_danger",
        params = NA
      ))
    } else if (flat %in% names(config_yml) &&
      is.null(config_yml[[flat]][["inflate"]])) {
      return(tibble(
        flat = flat,
        status = glue(
          "The flat file {flat} is not going to be inflated because",
          " although present in the config file, it has no inflate() parameters.",
          " Please inflate() again from the flat file with this 'fusen' version.",
          " Then you will be able to use `inflate_all*()` again."
        ),
        type = "stop",
        params = "call. = FALSE"
      ))
    }
  })

  flat_files_status <- do.call(rbind, flat_files_status)

  return(invisible(flat_files_status))
}

#' Read inflate-related parameters in config_fusen.yaml
#'
#' Internal function used in `inflate_all()`
#'
#' @param config_yml List. Content of the fusen config_file
#'
#' @return a named list with the flat files listed in config_fusen.yaml
#' and the parameters used to inflate them
#' @noRd
#' @examples
#' \dontrun{
#' config_yml <- yaml::read_yaml(system.file("inflate_all/config_fusen_with_inflate_parameters.yaml", package = "fusen"))
#' read_inflate_params(config_yml = config_yml)
#' }
read_inflate_params <- function(config_yml) {
  config_yml <- config_yml[sapply(config_yml, function(flat) isTRUE(flat[["state"]] == "active"))]

  flat_files_names <- names(config_yml)

  flat_files_names <- flat_files_names[!flat_files_names %in% "keep"]

  if (length(flat_files_names) == 0) {
    return(NULL)
  }

  # inflate-related parameters are at level 2 of the list
  inflate_params <- lapply(flat_files_names, function(flat) {
    config_yml[[flat]][["inflate"]]
  }) %>% setNames(flat_files_names)

  inflate_params
}