pkgslides

0.1.0

Automatically Generate Presentations for Source Code

When pointed at the root directory of an R Package Project, this function will automatically generate and render a Quarto/Revealjs presentation for that package. It will have a title slide and description slide generated from the package’s DESCRIPTION file and each exported function will have slides with its description and returns, parameters, examples, and source code.

build_presentation.R

Create a Revealjs Presentation with Quarto

Topic: build_presentation
Description: When pointed at the root directory of an R Package Project, this function will automatically generate and render a Quarto/Revealjs presentation for that package. It will have a title slide and description slide generated from the package’s DESCRIPTION file and each exported function will have slides with its description and returns, parameters, examples, and source code.
Return: This function creates and renders a .qmd presentation but does not return an R object.

Parameters

package: A file path to the root directory of an R package source folder, the name of an R package from CRAN, or an R package from GitHub in the username/repository format.
file: The file name for your .qmd file. This can be a path so long as it ends with a file_name.qmd
yaml: A _pkgslides.yml file or function call to create_yaml()

Code

build_presentation <- function(package = getwd(), file = NULL, yaml = create_yaml()) {

  package <- .find_package(package)
  file <- .find_file(package$path, file)

  yaml <- .parse_yaml(yaml)

  if (package$name %in% rownames(utils::installed.packages())) {
    chunk_opt <- "echo"
  } else { chunk_opt <- "eval" }

  credits <- .get_credits(package$path)

  title_contents <-
    .get_title(package$path, credits) |>
    .collate_title(yaml)

  package_contents <-
    .get_description(package$path, credits) |>
    .collate_description(chunk_opt)

  contents <- .get_roxygen(package$path, yaml)

  function_contents <- .get_functions(contents$functions, yaml)
  r_files <-
    sapply(contents$functions, \(b) .get_file_from_path(b$file))
  function_contents <-
    r_files |>
    unique() |>
    lapply(
      .construct_verticals,
      r_files, function_contents, chunk_opt
    ) |>
    unlist()

  data_contents <-
    .get_datasets(contents$datasets, yaml) |>
    lapply(.collate_datasets) |>
    unlist()

  file_contents <- c(
    title_contents,
    package_contents,
    function_contents,
    data_contents
  )

  print(file)
  file.create(file)
  fileConn <- file(file)
  writeLines(file_contents, fileConn)
  close(fileConn)

  quarto::quarto_render(file)
}

`.find_file`

Topic: .find_file
Return: A file path to write the .qmd to

Parameters

package: A path to a package source
file: A file path

Code

.find_file <- function(package, file) {
  if (is.null(file)) {
    file <- .get_file_from_path(package)
  }

  if (!grepl("\\.qmd$", file)) {
    file <- paste0(file, ".qmd")
  }

  file <- glue::glue("{getwd()}/{file}")

  return(file)
}

Tries to Find or Download a Package

Topic: .find_package
Return: A path to a package source

Parameters

package: A package name or file path to a package source

Code

.find_package <- function(package) {
  if (package == getwd() | dir.exists(package)) {
    name <- rev(strsplit(package, "/")[[1]])[1]
    return(list(name = name, path = package))
  }

  source_path <- tempdir()

  if (package %in% rownames(utils::available.packages())) {
    print("cran")
    utils::download.packages(package, source_path)
    source_name <-
      list.files(source_path, pattern = glue::glue("{package}.*\\.tar\\.gz"))
    utils::untar(
      glue::glue("{source_path}/{source_name}"),
      exdir = glue::glue("{source_path}")
    )
  } else {
    print("github")
    repo <- remotes::parse_repo_spec(package)
    package <- repo$repo
    stopifnot(repo$username != "" & repo$repo != "")
    zip <- glue::glue("{source_path}/{package}.zip")
    utils::download.file(url = glue::glue("https://github.com/{repo$username}/{repo$repo}/archive/master.zip"), zip)
    if (file.exists(zip)) {
      utils::unzip(zip, exdir = glue::glue("{source_path}"), overwrite = TRUE)
    }
    dirs <- list.dirs(glue::glue("{source_path}"), recursive = FALSE)
    dirs <- grep(glue::glue("({package}-(main|master))"), dirs, value = TRUE)
    new_name <- glue::glue("{source_path}/{package}")
    unlink(new_name, recursive = TRUE)
    file.rename(dirs, new_name)
    # file.copy(glue::glue("{getwd()}/_pkgslides.yml"), source_path)
  }

  package_path <- glue::glue("{source_path}/{package}")
  return(list(name = package, path = package_path))
}

yaml.R

Create `_pkgslides.yml`

Topic: create_yaml
Return: This will create the file and write to it, then return the file path.

Parameters

path: A file path to where you want the yaml file written. This should not end in a slash of any kind.
format_theme: A length-one character vector of theme details
format_functions: A named list of format function options
format_datasets: A named list of format dataset options
choose_functions: A list of file or function names
choose_datasets: A vector of dataset names

Code

create_yaml <- function(
    path = getwd(),
    format_theme = c(), format_functions = list(), format_datasets = list(),
    choose_functions = list(), choose_datasets = c()
) {
  # package <- .find_package(package)
  file <- glue::glue("{path}/_pkgslides.yml")
  # stopifnot(!file.exists(file))

  # formatting
  format_theme <- format_theme[format_theme %in% c("theme")]
  format_functions <-
    format_functions[names(format_functions) %in% c("description", "return", "parameters", "examples", "code")]
  format_datasets <-
    format_datasets[names(format_datasets) %in% c("format", "source", "references")]

  .append_to_yaml <- function(yaml, obj, name) {
    if (length(obj) > 0) { yaml$format[[name]] <- obj }
    return(yaml)
  }

  yaml <-
    list() |>
    .append_to_yaml(format_theme, "theme") |>
    .append_to_yaml(format_functions, "functions") |>
    .append_to_yaml(format_datasets, "datasets")

  # print options
  if (length(choose_functions) > 0) {
    yaml <- .process_choose_functions(yaml, choose_functions)
  }
  yaml$datasets <- choose_datasets

  yaml |>
    .check_yaml() |>
    yaml::write_yaml(file)

  print(glue::glue("Config written to '{file}'"))

  return(file)
}

Parse `_pkgslides.yml`

Topic: .parse_yaml
Return: A list representing a yaml file

Parameters

file: A file path the _pkgslides.yml file

Code

.parse_yaml <- function(file) {
  if (file.exists(file)) {
    yaml <-
      yaml::read_yaml(file) |>
      .check_yaml()
  } else {
    yaml <- .check_yaml(list())
  }
  return(yaml)
}

Fill an Incomplete `_pkgslides.yml`

Topic: .check_yaml
Return: A list representing a yaml file

Parameters

yaml: A list of properties from .parse_yaml()

Code

.check_yaml <- function(yaml) {
  if (is.null(yaml$functions)) { yaml$functions <- "auto" }

  if (is.null(yaml$datasets)) { yaml$datasets <- "all" }

  if (is.null(yaml$format$theme)) { yaml$format$theme <- "default" }

  yaml <-
    yaml |>
    .set_as_true(
      "functions",
      c("description", "return", "parameters",
        "examples", "code")
    ) |>
    .set_as_true(
      "datasets",
      c("format", "source", "references")
    )

  return(yaml)
}

Set Empty Values as True

Topic: .set_as_true
Return: A yaml where non-included options are set to TRUE

Parameters

yaml: A yaml file as a list
type: “functions” or “datasets”
options: A vector of the options exposed to users in the yaml format

Code

.set_as_true <- function(yaml, type, options) {
  requested <- names(yaml$format[[type]])
  not_specified <- options[!(options %in% requested)]

  yaml$format[[type]] <-
    lapply(seq_along(not_specified), \(s) TRUE) |>
    `names<-`(not_specified) |>
    append(yaml$format[[type]])

  return(yaml)
}

Process Choose Functions

Topic: .process_choose_functions
Return: A list representing a yaml file

Parameters

yaml: A list representing a yaml file
choose: The list passed to choose_functions in the create_yaml function

Code

.process_choose_functions <- function(yaml, choose) {
  yaml2 <- list()
  dim <- vapply(choose, length, FUN.VALUE = 1)
  choose_names <- names(choose)

  opt_regex <- "^(auto|exported|all)$|\\.R$"

  if (all(dim == 1) & is.null(choose_names)) {
    stopifnot(all(grepl(opt_regex, choose)))
    yaml2$functions <- lapply(choose, \(x) { list(file = x) })
  } else {
    if (any(choose_names == "")) {
      needs_name <- which(choose_names == "" & dim == 1)
      names(choose)[needs_name] <- unlist(sapply(choose, unlist)[needs_name])
      choose[needs_name] <- "all"
      choose_names <- names(choose)
    }
    stopifnot(all(grepl(opt_regex, choose_names)))
    yaml2$functions <-
      mapply(\(x, y) {
        list(file = x, slides = y)
      }, choose_names, choose, SIMPLIFY = FALSE, USE.NAMES = FALSE)
  }


  yaml <-
    list(yaml, yaml2) |>
    unlist(recursive = FALSE)

  return(yaml)
}

pkgslides

Automatically Generate Presentations for Source Code

build_presentation.R

Create a Revealjs Presentation with Quarto

Parameters

Code

.find_file

Parameters

Code

Tries to Find or Download a Package

Parameters

Code

yaml.R

Create _pkgslides.yml

Parameters

Code

Parse _pkgslides.yml

Parameters

Code

Fill an Incomplete _pkgslides.yml

Parameters

Code

Set Empty Values as True

Parameters

Code

Process Choose Functions

Parameters

Code

`.find_file`

Create `_pkgslides.yml`

Parse `_pkgslides.yml`

Fill an Incomplete `_pkgslides.yml`