implement tutorial_package_dependencies()

NAMESPACE

@@ -42,6 +42,7 @@ export(safe_env)
 export(tutorial)
 export(tutorial_html_dependency)
 export(tutorial_options)
+export(tutorial_package_dependencies)
 import(rmarkdown)
 import(shiny)
 importFrom(evaluate,evaluate)

NEWS.md

@@ -5,6 +5,8 @@ learnr 0.10.0.9000 (unreleased)
 
 ## Minor new features and improvements
 
+* `learnr` gained the function `learnr::tutorial_package_dependencies()`, used to enumerate a tutorial's R package dependencies. Front-ends can use this to ensure a tutorial's dependencies are satisfied before attempting to run that tutorial. `learnr::available_tutorials()` gained the column `package_dependencies` containing the required packages to run the document. ([#329](https://github.com/rstudio/learnr/pull/329))
+
 * Include vignette about publishing learnr tutorials on shinyapps.io
 
 * `learnr`'s built-in tutorials now come with a description as part of the YAML header, with the intention of this being used in front-end software that catalogues available `learnr` tutorials on the system. ([#312](https://github.com/rstudio/learnr/issues/312))

R/available_tutorials.R

@@ -10,7 +10,7 @@
 #'   development of the package (i.e. the corresponding tutorial .html file for
 #'   the .Rmd file must exist).
 #'
-#' @return \code{available_tutorials} will return a \code{data.frame} containing "package", "name", and "title".
+#' @return \code{available_tutorials} will return a \code{data.frame} containing "package", "name", "title", "description", "package_dependencies", "private", and "yaml_front_matter".
 #' @rdname available_tutorials
 #' @export
 available_tutorials <- function(package = NULL) {
@@ -39,6 +39,7 @@ available_tutorials <- function(package = NULL) {
 #'    "name": Tutorial directory. (can be passed in as `run_tutorial(NAME, PKG)`; string
 #'    "title": Tutorial title from yaml header; [NA]
 #'    "description": Tutorial description from yaml header; [NA]
+#'    "package_dependencies": Packages needed to run tutorial; [lsit()]
 #'    "private": Boolean describing if tutorial should be indexed / displayed; [FALSE]
 #'    "yaml_front_matter": list column of all yaml header info; [list()]
 #' @noRd
@@ -87,6 +88,7 @@ available_tutorials_for_package <- function(package) {
       title = yaml_front_matter$title %||% NA,
       description = yaml_front_matter$description %||% NA,
       private = yaml_front_matter$private %||% FALSE,
+      package_dependencies = I(list(tutorial_dir_package_dependencies(tut_dir))),
       yaml_front_matter = I(list(yaml_front_matter)),
       stringsAsFactors = FALSE,
       row.names = FALSE

R/tutorial_package_dependencies.R

@@ -0,0 +1,81 @@
+get_needed_pkgs <- function(dir) {
+
+  pkgs <- tutorial_dir_package_dependencies(dir)
+
+  pkgs[!pkgs %in% utils::installed.packages()]
+}
+
+format_needed_pkgs <- function(needed_pkgs) {
+  paste("  -", needed_pkgs, collapse = "\n")
+}
+
+ask_pkgs_install <- function(needed_pkgs) {
+  question <- sprintf("Would you like to install the following packages?\n%s",
+                      format_needed_pkgs(needed_pkgs))
+
+  utils::menu(choices = c("yes", "no"),
+              title = question)
+}
+
+install_tutorial_dependencies <- function(dir) {
+  needed_pkgs <- get_needed_pkgs(dir)
+
+  if(length(needed_pkgs) == 0) {
+    return(invisible(NULL))
+  }
+
+  if(!interactive()) {
+    stop("The following packages need to be installed:\n",
+         format_needed_pkgs(needed_pkgs))
+  }
+
+  answer <- ask_pkgs_install(needed_pkgs)
+
+  if(answer == 2) {
+    stop("The tutorial is missing required packages and cannot be rendered.")
+  }
+
+  utils::install.packages(needed_pkgs)
+}
+
+
+
+
+#' List Tutorial Dependencies
+#'
+#' List the \R packages required to run a particular tutorial.
+#'
+#' @param name The tutorial name. If \code{name} is \code{NULL}, then all
+#'   tutorials within \code{package} will be searched.
+#' @param package The \R package providing the tutorial. If \code{package} is
+#'   \code{NULL}, then all tutorials will be searched.
+#'
+#' @export
+#' @return A character vector of package names that are required for execution.
+#' @examples
+#' tutorial_package_dependencies(package = "learnr")
+tutorial_package_dependencies <- function(name = NULL, package = NULL) {
+  if (identical(name, NULL)) {
+    info <- available_tutorials(package = package)
+    return(
+      sort(unique(unlist(info$package_dependencies)))
+    )
+  }
+
+  tutorial_dir_package_dependencies(
+    get_tutorial_path(name = name, package = package)
+  )
+}
+
+tutorial_dir_package_dependencies <- function(dir) {
+  # enumerate tutorial package dependencies
+  deps <- renv::dependencies(dir, quiet = TRUE)
+
+  # R <= 3.4 can not sort(NULL)
+  # if no deps are found, renv::dependencies returns NULL
+  if (is.null(deps)) {
+    return(NULL)
+  }
+
+  sort(unique(deps$Package))
+}

tests/testthat/test-dependency.R

@@ -6,3 +6,11 @@ test_that("tutor html dependencies can be retreived", {
   expect_equal(dep$name, "tutorial")
 })
 
+test_that("tutorial package dependencies can be enumerated", {
+  packages <- tutorial_package_dependencies("ex-data-summarise", "learnr")
+  expect_true("tidyverse" %in% packages)
+})
+test_that("Per package, tutorial package dependencies can be enumerated", {
+  packages <- tutorial_package_dependencies(package = "learnr")
+  expect_true("tidyverse" %in% packages)
+})

tests/testthat/test-install-dependencies.R

@@ -51,4 +51,3 @@ test_that("tutorial dependency check works (not interactive)", {
 
   expect_error(install_tutorial_dependencies(tutorial_dir))
 })
-