R/sepuku_utils.R

Defines functions clean_fusen_tags_in_files find_files_with_fusen_tags list_flat_files list_flat_files_in_dev_folder list_flat_files_in_config_file

Documented in list_flat_files

# WARNING - Generated by {fusen} from dev/flat_sepuku-utils.Rmd: do not edit by hand # nolint: line_length_linter.

#' @importFrom yaml read_yaml
#' @noRd
#' @rdname sepuku_utils
list_flat_files_in_config_file <- function(
  config_file = getOption(
    "fusen.config_file",
    default = "dev/config_fusen.yaml"
  )) {
  if (!file.exists(config_file)) {
    return(character(0))
  } else {
    config_yml <- yaml::read_yaml(config_file)
    config_yml <- config_yml[!names(config_yml) %in% "keep"]
    return(
      unlist(
        lapply(config_yml, "[[", "path")
      )
    )
  }
}

#' @noRd
#' @rdname sepuku_utils
list_flat_files_in_dev_folder <- function(
  pkg = ".",
  folder = "dev"
) {
  files_identified <-
    c(
      list.files(
        path = file.path(pkg, folder),
        pattern = "^flat.*\\.Rmd",
        full.names = FALSE
      ),
      list.files(
        path = file.path(pkg, folder),
        pattern = "^flat.*\\.qmd",
        full.names = FALSE
      )
    )

  file.path(
    folder,
    files_identified
  )
}

#' List all flat files present in the package
#'
#' Search for flat files listed in fusen config file, and for Rmd and qmd files starting with "flat_" in dev/ folder, and dev/flat_history folder
#'
#' @param pkg Path to package
#' @return a vector of flat files paths
#'
#' @export
#' @rdname sepuku_utils
list_flat_files <- function(pkg = ".") {
  c(
    list_flat_files_in_config_file(),
    list_flat_files_in_dev_folder(folder = "dev"),
    list_flat_files_in_dev_folder(folder = "dev/flat_history")
  ) %>%
    unique()
}

#' @noRd
#' @rdname sepuku_utils
find_files_with_fusen_tags <- function(pkg = ".") {
  R_files_to_parse <-
    lapply(
      c("R", "tests/testthat"),
      function(folder) {
        file.path(
          folder,
          list.files(
            path = file.path(pkg, folder),
            pattern = "*\\.R",
            full.names = FALSE
          )
        )
      }
    ) %>%
    unlist()



  Rmd_files_to_parse <- lapply(
    "vignettes",
    function(folder) {
      file.path(
        folder,
        list.files(
          path = file.path(pkg, folder),
          pattern = "*\\.Rmd",
          full.names = FALSE
        )
      )
    }
  ) %>%
    unlist()

  files_to_parse <- c(R_files_to_parse, Rmd_files_to_parse)

  if (length(files_to_parse) == 0) {
    return(character(0))
  }

  fusen_tags <- tolower(
    c("WARNING - Generated by", "Previously generated by", "WARNING - This vignette is generated by")
  )
  files_with_fusen_tags <-
    lapply(
      files_to_parse,
      function(file) {
        if (
          length(
            grep(
              paste(fusen_tags, collapse = "|"),
              tolower(
                suppressWarnings(readLines(file))
              )
            )
          ) > 0
        ) {
          return(file)
        } else {
          return(character(0))
        }
      }
    ) %>%
    unlist() %>%
    unique()

  return(files_with_fusen_tags)
}

#' @noRd
#' @rdname sepuku_utils
clean_fusen_tags_in_files <- function(
  pkg = ".",
  files_to_clean
) {
  fusen_tags <- tolower(
    c("WARNING - Generated by", "Previously generated by", "WARNING - This vignette is generated by")
  )
  fusen_tags <- tolower(c(
    "WARNING - Generated by.*do not edit by hand",
    "Previously generated by.*now deprecated",
    "This vignette is generated by.*do not edit by hand"
  ))

  for (file in files_to_clean) {
    lines <- readLines(file.path(pkg, file))
    lines <- lines[!grepl(paste(fusen_tags, collapse = "|"), tolower(lines))]
    writeLines(lines, file)
  }

  return(files_to_clean)
}

Try the fusen package in your browser

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

fusen documentation built on April 4, 2025, 5:26 a.m.