R/get_package_structure.R

In fusen: Build a Package from Rmarkdown Files

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

#' Get structure and information of a 'fusen' built package for developers
#'
#' @param config_file Path to a source configuration file
#' to get the structure from
#' @param emoji Add emojis to the output
#' @param silent Whether to print messages
#'
#' @return A list of information about the package
#' @export
#'
#' @examples
#' \dontrun{
#' # This only works inside a 'fusen' built package
#' pkg_structure <- get_package_structure()
#' draw_package_structure(pkg_structure)
#' }
#'
#' # Example with a dummy package
#' dummypackage <- tempfile("drawpkg.structure")
#' 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)]
#'
#' usethis::with_project(dummypackage, {
#'   # Add an extra R file with internal function
#'   # to list in "keep"
#'   dir.create("R")
#'   cat("extra_fun <- function() {1}\n", file = "R/my_extra_fun.R")
#'
#'   # Works with classical package
#'   pkg_structure <- get_package_structure()
#'   draw_package_structure(pkg_structure)
#' })
#'
#' usethis::with_project(dummypackage, {
#'   # Works with 'fusen' package
#'   suppressMessages(
#'     inflate(
#'       pkg = dummypackage, flat_file = flat_file,
#'       vignette_name = "Get started", check = FALSE,
#'       open_vignette = FALSE
#'     )
#'   )
#'
#'   pkg_structure <- get_package_structure()
#'   draw_package_structure(pkg_structure)
#' })
get_package_structure <- function(
    config_file,
    emoji = TRUE,
    silent = FALSE) {
  if (missing(config_file)) {
    yaml_fusen_file_orig <- getOption(
      "fusen_config_file",
      default = "dev/config_fusen.yaml"
    )
  }

  yaml_fusen_file <- tempfile(fileext = ".yaml")
  if (!file.exists(yaml_fusen_file_orig)) {
    # Not 'fusen' package or not inflated
    file.create(yaml_fusen_file)
  } else {
    file.copy(yaml_fusen_file_orig, yaml_fusen_file)
  }

  # Add not registered files in a copy of the config file
  suppressMessages(
    register_all_to_config(
      pkg = ".",
      config_file = yaml_fusen_file
    )
  )

  yaml_fusen <- yaml::read_yaml(yaml_fusen_file)
  file.remove(yaml_fusen_file)

  # For each element, add the title of the flat file
  if (file.exists("NAMESPACE")) {
    namespace <- readLines("NAMESPACE")
    if (isFALSE(silent)) {
      cat_rule("Reading NAMESPACE file")
    }
  } else {
    namespace <- NULL
    if (isFALSE(silent)) {
      cat_rule(paste("No NAMESPACE file found there: ", getwd()))
    }
  }

  for (flat_file in names(yaml_fusen)) {
    if (isFALSE(silent)) {
      cat_rule(flat_file)
    }
    yaml_fusen[[flat_file]]$inflate <- NULL

    # Extract title from the flat Rmd file
    if (flat_file != "keep") {
      flat_lines <- readLines(yaml_fusen[[flat_file]]$path)
      yaml_begin <- which(grepl("^---", flat_lines))[1]
      yaml_end <- which(grepl("^---", flat_lines))[2]
      flat_yaml <- yaml::yaml.load(flat_lines[yaml_begin:yaml_end])
      yaml_fusen[[flat_file]] <- c(
        list(flat_title = flat_yaml$title),
        yaml_fusen[[flat_file]]
      )
    }

    # Add emoji
    if (emoji) {
      flat_state <- yaml_fusen[[flat_file]]$state
      yaml_fusen[[flat_file]]$state <-
        paste(ifelse(
          flat_state == "active",
          "\U0001f34f", "\U0001f6d1"
        ), flat_state)
    }

    # Get the list of R files with their functions
    r_files <- yaml_fusen[[flat_file]][["R"]]
    list_r_files <- list()
    for (r_file in r_files) {
      functions <- get_all_created_funs(r_file)
      # Get if function is exported from namespace
      exported <- paste0("export(", functions, ")") %in% namespace
      if (emoji) {
        functions <- paste(
          ifelse(exported,
            "\U0001f440", "\U0001f648"
          ), functions
        )
      } else {
        functions <- paste(
          ifelse(exported, "exported", "not exported"),
          functions
        )
      }

      list_r_files <- c(
        list_r_files,
        setNames(list(functions), r_file)
      )
    }

    yaml_fusen[[flat_file]][["R"]] <- list_r_files
  }

  return(yaml_fusen)
}

#' Draw a tree of the package structure in the console
#'
#' @param structure_list A list of information about the package as issued
#' from `[get_package_structure()]`
#' @param silent Whether to print messages
#'
#' @export
#' @rdname get_package_structure
#'
draw_package_structure <- function(structure_list, silent = FALSE) {
  if (missing(structure_list)) {
    structure_list <- get_package_structure(silent = silent)
  }
  # Calculate the depth of a list
  depth <- function(structure_list) {
    if (!is.list(structure_list)) {
      return(0)
    }
    if (length(structure_list) == 0) {
      return(1)
    }
    return(1 + max(sapply(structure_list, depth)))
  }

  to_tree <- function(xlist) {
    to_tree_max(xlist, maxdepth = depth(xlist))
  }

  to_tree_max <- function(xlist, maxdepth) {
    d <- depth(xlist)
    if (d > 0) {
      result <- lapply(
        seq_along(xlist),
        function(w) {
          paste0(
            "\n",
            paste(rep("  ", maxdepth - d), collapse = ""),
            "- ",
            names(xlist)[w],
            paste0(
              unlist(to_tree_max(xlist[[w]], maxdepth)),
              collapse = ""
            )
          )
        }
      )
      return(result)
    } else if (d == 0) {
      paste0(
        "\n",
        paste(
          paste0(
            paste0(rep("  ", maxdepth), collapse = ""),
            "+ ",
            xlist
          ),
          collapse = "\n"
        )
      )
    }
  }

  cat(unlist(to_tree(structure_list)), sep = "")
}