Nothing
# 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 = "")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.