pkgslides.qmd

% Generated by pkgslides: do not edit by hand
---
title: pkgslides
subtitle: 0.1.0
format:
  revealjs:
    theme: default
    navigation-mode: vertical
    self-contained: true
    scrollable: true
    footer: Gus Lipkin [aut, cre]
---

## Automatically Generate Presentations for Source Code

::: {.r-fit-text}

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.

:::

```{r}
#| echo: false
library(pkgslides)
```
<script type='text/javascript' charset='utf-8'>
  function add_author_footer() {
    Reveal.on( 'slidechanged' , event => {
        let footer = document.querySelector('div.footer p');
        if (event.currentSlide.matches('#title-slide')) {
          footer.innerHTML = 'Gus Lipkin [aut, cre]';
        } else {
          footer.innerHTML = '';
        }
      });
  };
  window.addEventListener('load', (event) => {
    add_author_footer();
  });
</script>

# build_presentation.R

## Create a Revealjs Presentation with Quarto

::: {.r-fit-text}

- **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

::: {.r-fit-text}

- `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

::: {.r-fit-text}

```{.r}
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`

::: {.r-fit-text}

- **Topic:** `.find_file`

- **Return:** A file path to write the .qmd to

:::


## Parameters

::: {.r-fit-text}

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

:::



## Code

::: {.r-fit-text}

```{.r}
.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

::: {.r-fit-text}

- **Topic:** `.find_package`

- **Return:** A path to a package source

:::


## Parameters

::: {.r-fit-text}

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

:::



## Code

::: {.r-fit-text}

```{.r}
.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`

::: {.r-fit-text}

- **Topic:** `create_yaml`

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

:::


## Parameters

::: {.r-fit-text}

- `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

::: {.r-fit-text}

```{.r}
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`

::: {.r-fit-text}

- **Topic:** `.parse_yaml`

- **Return:** A list representing a yaml file

:::


## Parameters

::: {.r-fit-text}

- `file`: A file path the _pkgslides.yml file

:::



## Code

::: {.r-fit-text}

```{.r}
.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`

::: {.r-fit-text}

- **Topic:** `.check_yaml`

- **Return:** A list representing a yaml file

:::


## Parameters

::: {.r-fit-text}

- `yaml`: A list of properties from `.parse_yaml()`

:::



## Code

::: {.r-fit-text}

```{.r}
.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

::: {.r-fit-text}

- **Topic:** `.set_as_true`

- **Return:** A yaml where non-included options are set to TRUE

:::


## Parameters

::: {.r-fit-text}

- `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

::: {.r-fit-text}

```{.r}
.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

::: {.r-fit-text}

- **Topic:** `.process_choose_functions`

- **Return:** A list representing a yaml file

:::


## Parameters

::: {.r-fit-text}

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

:::



## Code

::: {.r-fit-text}

```{.r}
.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)
}
```

:::