Display available tutorials

NAMESPACE

@@ -1,13 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(format,learnr_available_tutorials)
 S3method(mutate_tags,"NULL")
 S3method(mutate_tags,character)
 S3method(mutate_tags,default)
 S3method(mutate_tags,list)
 S3method(mutate_tags,logical)
 S3method(mutate_tags,numeric)
 S3method(mutate_tags,shiny.tag)
+S3method(print,learnr_available_tutorials)
 export(answer)
+export(available_tutorials)
 export(duplicate_env)
 export(filesystem_storage)
 export(initialize_tutorial)
@@ -60,5 +63,6 @@ importFrom(shiny,reactive)
 importFrom(shiny,reactiveValues)
 importFrom(shiny,req)
 importFrom(stats,runif)
+importFrom(utils,adist)
 importFrom(utils,getFromNamespace)
 importFrom(withr,with_envvar)

NEWS.md

@@ -15,12 +15,13 @@ learnr 0.10.0 (unreleased)
 
 * Question width will expand to the container width. ([#222](https://github.com/rstudio/learnr/pull/222))
 
+* Available tutorial names will be displayed when no `name` parameter or an incorrect `name` is provided to `run_tutorial()`. ([#234](https://github.com/rstudio/learnr/pull/234))
+
 ## Bug fixes
 
 * Fixed a spurious console warning when running exercises using Pandoc 2.0. ([#154](https://github.com/rstudio/learnr/issues/154))
 
 
-
 learnr 0.9.2
 ===========
 

R/available_tutorials.R

@@ -0,0 +1,183 @@
+
+#' Run a tutorial
+#'
+#' Run a tutorial which is contained within an R package.
+#'
+#' @param name Tutorial name (subdirectory within \code{tutorials/}
+#'   directory of installed package).
+#' @param package Name of package
+#' @param shiny_args Additional arguments to forward to
+#'   \code{\link[shiny:runApp]{shiny::runApp}}.
+#'
+#' @details Note that when running a tutorial Rmd file with \code{run_tutorial}
+#'   the tutorial Rmd should have already been rendered as part of the
+#'   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".
+#' @rdname available_tutorials
+#' @export
+available_tutorials <- function(package = NULL) {
+
+  info <-
+    if (is.null(package)) {
+      all_available_tutorials()
+    } else {
+      available_tutorials_for_package(package)
+    }
+
+  if (!is.null(info$error)) {
+    stop.(info$error)
+  }
+
+  tutorials <- info$tutorials
+
+  # return a data frame of tutorial pkg, name, and title
+  return(tutorials)
+}
+
+
+#' @return will return a list of `error` and `tutorials` which is a \code{data.frame} containing "package", "name", and "title".
+#' @noRd
+available_tutorials_for_package <- function(package) {
+
+  an_error <- function(...) {
+    list(
+      tutorials = NULL,
+      error = paste0(...)
+    )
+  }
+
+  if (!file.exists(
+    system.file(package = package)
+  )) {
+    return(an_error(
+      "No package found with name: \"", package, "\""
+    ))
+  }
+
+  tutorials_dir <- system.file("tutorials", package = package)
+  if (!file.exists(tutorials_dir)) {
+    return(an_error(
+      "No tutorials found for package: \"", package, "\""
+    ))
+  }
+
+  tutorial_folders <- list.dirs(tutorials_dir, full.names = TRUE, recursive = FALSE)
+  names(tutorial_folders) <- basename(tutorial_folders)
+  rmd_info <- lapply(tutorial_folders, function(tut_dir) {
+    dir_rmd_files <- dir(tut_dir, pattern = "\\.Rmd$", recursive = FALSE, full.names = TRUE)
+    dir_rmd_files_length <- length(dir_rmd_files)
+    if (dir_rmd_files_length == 0) {
+      return(NULL)
+    }
+    if (dir_rmd_files_length > 1) {
+      warning("Found multiple .Rmd files in \"", package, "\"'s \"", tut_dir, "\" folder.  Using: ", dir_rmd_files[1])
+    }
+    data.frame(
+      package = package,
+      name = basename(tut_dir),
+      title = rmarkdown::yaml_front_matter(dir_rmd_files[1])$title %||% NA,
+      stringsAsFactors = FALSE,
+      row.names = FALSE
+    )
+  })
+
+  has_no_rmd <- vapply(rmd_info, is.null, logical(1))
+  if (all(has_no_rmd)) {
+    return(an_error(
+      "No tutorial .Rmd files found for package: \"", package, "\""
+    ))
+  }
+
+  rmd_info <- rmd_info[!has_no_rmd]
+
+  tutorials <- do.call(rbind, rmd_info)
+  class(tutorials) <- c("learnr_available_tutorials", class(tutorials))
+
+  list(
+    tutorials = tutorials,
+    error = NULL
+  )
+}
+
+#' @return will return a list of `error` and `tutorials` which is a \code{data.frame} containing "package", "name", and "title".
+#' @noRd
+all_available_tutorials <- function() {
+  ret <- list()
+  all_pkgs <- installed.packages()[,"Package"]
+
+  for (pkg in all_pkgs) {
+    info <- available_tutorials_for_package(pkg)
+    if (!is.null(info$tutorials)) {
+      ret[[length(ret) + 1]] <- info$tutorials
+    }
+  }
+
+  # do not check for size 0, as learnr contains tutorials.
+
+  tutorials <- do.call(rbind, ret)
+
+  list(
+    tutorials = tutorials, # will maintain class
+    error = NULL
+  )
+}
+
+
+get_tutorial_path <- function(name, package) {
+
+  tutorial_path <- system.file("tutorials", name, package = package)
+
+  # validate that it's a direcotry
+  if (!utils::file_test("-d", tutorial_path)) {
+    tutorials <- available_tutorials(package)
+    possible_tutorials <- tutorials$name
+    msg <- paste0("Tutorial \"", name, "\" was not found in the \"", package, "\" package.")
+    # if any tutorial names are _close_ tell the user
+    adist_vals <- adist(possible_tutorials, name, ignore.case = TRUE)
+    if (any(adist_vals <= 3)) {
+      best_match <- possible_tutorials[which.min(adist_vals)]
+      msg <- paste0(
+        msg, "\n",
+        "Did you mean \"", best_match, "\"?"
+      )
+    }
+    stop.(msg, "\n", format(tutorials))
+  }
+
+  tutorial_path
+}
+
+#' @rdname available_tutorials
+#' @export
+format.learnr_available_tutorials <- function(x, ...) {
+  tutorials <- x
+  ret <- "Available tutorials:"
+
+  for (pkg in unique(tutorials$package)) {
+    tutorials_sub <- subset(tutorials, package == pkg)
+
+    tutorial_names <- format(tutorials_sub$name)
+    txts <- mapply(tutorial_names, tutorials_sub$title, SIMPLIFY = FALSE, FUN = function(name, title) {
+      txt <- paste0("  - ", name)
+      if (!is.na(title)) {
+        txt <- paste0(txt, " : \"", title, "\"")
+      }
+      txt
+    })
+
+    ret <- paste0(
+      ret, "\n",
+      "* ", pkg, "\n",
+      paste0(txts, collapse = "\n")
+    )
+  }
+
+  ret
+}
+#' @rdname available_tutorials
+#' @export
+print.learnr_available_tutorials <- function(x, ...) {
+  cat(format(x, ...), "\n")
+}

R/quiz.R

@@ -152,8 +152,7 @@ question <- function(text,
   }
 
   ## no partial matching for s3 methods
-  # type <- match.arg(type)
-  if (missing(type)) {
+  if (missing(type)) { # can not use match.arg(type) because of comment above
     type <- "auto"
   }
   if (isTRUE(all.equal(type, "auto"))) {

R/run.R

@@ -14,24 +14,38 @@
 #'   development of the package (i.e. the corresponding tutorial .html file for
 #'   the .Rmd file must exist).
 #'
-#' @seealso \code{\link{safe}}
+#' @seealso \code{\link{safe}} and \code{\link{available_tutorials}}
+#' @importFrom utils adist
 #' @export
-run_tutorial <- function(name, package, shiny_args = NULL) {
+#' @examples
+#' # display all "learnr" tutorials
+#' available_tutorials("learnr")
+#'
+#' # run basic example within learnr
+#' \dontrun{run_tutorial("hello", "learnr")}
+run_tutorial <- function(name = NULL, package = NULL, shiny_args = NULL) {
 
-  # get path to tutorial
-  tutorial_path <- system.file("tutorials", name, package = package)
+  if (is.null(package) && !is.null(name)) {
+    stop.("`package` must be provided if `name` is provided.")
+  }
 
-  # validate that it's a direcotry
-  if (!utils::file_test("-d", tutorial_path))
-    stop("Tutorial ", name, " was not found in the ", package, " package.")
+  # works for package = NULL and if package is provided
+  tutorials <- available_tutorials(package = package)
+  if (is.null(name)) {
+    message(format(tutorials))
+    return(invisible(tutorials))
+  }
+
+  # get path to tutorial
+  tutorial_path <- get_tutorial_path(name, package)
 
   # provide launch_browser if it's not specified in the shiny_args
   if (is.null(shiny_args))
     shiny_args <- list()
   if (is.null(shiny_args$launch.browser)) {
     shiny_args$launch.browser <- (
       interactive() ||
-      identical(Sys.getenv("LEARNR_INTERACTIVE", "0"), "1")
+        identical(Sys.getenv("LEARNR_INTERACTIVE", "0"), "1")
     )
   }
 

R/utils.R

@@ -21,6 +21,10 @@ is_localhost <- function(location) {
     FALSE
 }
 
+stop. <- function(...) {
+  stop(..., call. = FALSE)
+}
+
 
 #' Create a duplicate of an environment
 #'

inst/tutorials/slidy/slidy.Rmd

@@ -1,6 +1,7 @@
 ---
 output: slidy_presentation
 runtime: shiny_prerendered
+title: "Slidly demo"
 ---
 
 ```{r setup, include=FALSE}
@@ -13,7 +14,6 @@ library(dygraphs)
 Modify the dyOptions to customize the graph's appearance:
 
 ```{r dygraph-options, exercise=TRUE, exercise.eval=TRUE, fig.height=5.5}
-dygraph(ldeaths) %>% 
+dygraph(ldeaths) %>%
   dyOptions(fillGraph = TRUE, drawGrid = TRUE)
 ```
-

tests/testthat/test-available-tutorials.R

@@ -0,0 +1,23 @@
+
+context("available tutorials")
+
+test_that("Tutorial names are retrieved", {
+
+  expect_error(available_tutorials("not a package"), "No package found")
+  expect_error(available_tutorials("base"), "No tutorials found")
+  expect_true("hello" %in% available_tutorials("learnr")$name)
+  expect_true("hello" %in% suppressMessages(run_tutorial(package = "learnr")$name))
+  expect_s3_class(available_tutorials("learnr"), "learnr_available_tutorials")
+
+  expect_error(run_tutorial("helloo", package = "learnr"), "\"hello\"")
+  expect_error(run_tutorial("doesn't exist", package = "learnr"), "Available ")
+  expect_message(run_tutorial(package = "learnr"), "Available ")
+
+
+  expect_output(
+    fixed = TRUE,
+    print(available_tutorials("learnr")),
+"Available tutorials:\n* learnr\n  - hello         : \"Hello, Tutorial!\"\n  - question_type : \"Question Types in Learnr\"\n  - slidy         : \"Slidly demo\""
+  )
+
+})