Add handout options

DESCRIPTION

@@ -35,6 +35,10 @@ Authors@R: c(
            family = "Gruson",
            role = c("ctb"),
            email = "hugo.gruson+R@normalesup.org"),
+    person(given = "Rob",
+           family = "Davey",
+           role = c("ctb"),
+           email = "robertdavey@carpentries.org"),
     person(given = "Milan",
            family = "Malfait",
            role = c("ctb"),

NEWS.md

@@ -2,6 +2,10 @@
 
 ## NEW FEATURES
 
+* Using `handout: true` in `config.yaml` will cause a handout to be generated
+  for the lesson website under `/files/code-handout.R`. At the moment, this is
+  only relevant for R-based lessons (implemented: @froggleston, #527) and
+  supersedes the need for specifying `options(sandpaper.handout = TRUE)`
 * Content for learners now accessible through instructor view. The instructor
   view "More" dropdown menu item will now have links to learner view items
   appended. Note that when clicking these links, the user will remain in

R/build_handout.R

@@ -1,5 +1,5 @@
 #' Create a code handout of challenges without solutions
-#' 
+#'
 #' This function will build a handout and save it to `files/code-handout.R`
 #' in your lesson website. This will build with your website if you enable it
 #' with `options(sandpaper.handout = TRUE)` or if you want to specify a path,
@@ -11,7 +11,7 @@
 #' @param out the path to the handout document. When this is `NULL` (default)
 #'   or `TRUE`, the output will be `site/built/files/code-handout.R`.
 #' @return NULL
-build_handout <- function(path = ".", out = getOption("sandpaper.handout", NULL)) {
+build_handout <- function(path = ".", out = NULL) {
   path <- root_path(path)
   lesson <- this_lesson(path)
   tmp <- fs::file_temp(ext = "R")

R/build_markdown.R

@@ -96,7 +96,13 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE, slug = NU
         error   = error
       )
     }
-    handout <- getOption("sandpaper.handout", default = FALSE)
+
+    handout <- this_metadata$get()[["handout"]]
+
+    # produces the default headings, challenges, code, etc
+    # TODO: this needs improving to allow users to choose what to include based
+    # on a yaml list
+    handout <- if (is.null(handout)) FALSE else handout
     should_build_handout <- !isFALSE(handout)
     if (should_build_handout) {
       build_handout(path, out = handout)

R/options.R

@@ -7,7 +7,6 @@
 #'@details 
 #' 
 #' ```
-#' option("sandpaper.handout" = TRUE)
 #' option("sandpaper.show_draft" = TRUE)
 #' option("sandpaper.links" = NULL)
 #' option("sandpaper.use_renv" = FALSE)
@@ -19,13 +18,6 @@
 #' may be manipulated by the user. This set may change in the future, but here
 #' are the description of these options and how they are set on startup:
 #'
-#' ### sandpaper.handout
-#' 
-#' **Default: `FALSE`** This option instructs {sandpaper} to create a handout
-#' of all RMarkdown files via {pegboard}, which uses [knitr::purl()] in the
-#' background after removing everything but the challenges (without solutions)
-#' and any code blocks where `purl = TRUE`.
-#'
 #' ### sandpaper.show_draft
 #'
 #' **Default: `TRUE`** This is for user messages. If `TRUE`, a message about

R/set_dropdown.R

@@ -110,6 +110,12 @@ set_dropdown <- function(path = ".", order = NULL, write = FALSE, folder) {
 #' - **overview** `[boolean]` All lessons must have episodes with the exception
 #'   of overview lessons. To indicate that your lesson serves as an overview for
 #'   other lessons, use `overview: true`
+#' - **handout** `[boolean]` or `[character]` This option instructs {sandpaper}
+#'   to create a handout of all RMarkdown files via {pegboard}, which uses
+#'   [knitr::purl()] in the background after removing everything but the
+#'   challenges (without solutions) and any code blocks where `purl = TRUE`. The
+#'   default path for the handout is `files/code-handout.R`
+#'
 #'
 #' As the workbench becomes more developed, some of these optional keys may
 #' disappear.

R/test-fixtures.R

@@ -177,18 +177,21 @@ remove_local_remote <- function(repo, name = "sandpaper-local") {
   }
   remotes <- tryCatch(gert::git_remote_list(repo = repo),
     error = function(e) {
-      e$message <- paste0("error from within: ", e$message)
+      cli::cli_alert_danger("Error listing remotes")
+      cli::cli_text(e$message)
       d <- data.frame(name = character(0))
       return(d)
     }
   )
   if (any(the_remote <- remotes$name %in% name)) {
     gert::git_remote_remove(name, repo)
     to_remove <- remotes$url[the_remote]
+    cli::cli_alert_info("removing '{name}' ({.file {to_remove}})")
     # don't error if we can not delete this.
     res <- tryCatch(fs::dir_delete(to_remove),
       error = function(e) {
-        e$message <- paste0("error from within: ", e$message)
+        cli::cli_alert_danger("Error trying to remove remote")
+        cli::cli_text(e$message)
         return(FALSE)
       }
     )

R/utils-yaml.R

@@ -158,6 +158,8 @@ create_pkgdown_yaml <- function(path) {
   # The user does not interact with this and {{mustache}} is logic-less, so we
   # can be super-verbose here and create any logic we need on the R-side.
   usr <- yaml::read_yaml(path_config(path), eval.expr = FALSE)
+  handout <- if (is.null(usr$handout)) "~" else usr$handout
+  handout <- if (isTRUE(handout)) "files/code-handout.R" else handout
   yaml <- get_yaml_text(template_pkgdown())
   yaml <- whisker::whisker.render(yaml,
     data = list(
@@ -174,7 +176,7 @@ create_pkgdown_yaml <- function(path) {
       carpentry      = siQuote(usr$carpentry),
       carpentry_icon = siQuote(which_icon_carpentry(usr$carpentry)),
       license        = siQuote(usr$license),
-      handout        = if (getOption("sandpaper.handout", default = FALSE)) "'files/code-handout.R'" else "~",
+      handout        = siQuote(handout),
       cp             = usr$carpentry == 'cp',
       lc             = usr$carpentry == 'lc',
       dc             = usr$carpentry == 'dc',

tests/testthat/setup.R

@@ -33,7 +33,10 @@ withr::defer({
   if (noise) {
     status <- if (identical(res, FALSE)) "could not be" else "successfully"
     cli::cli_alert_info("{.file {tf}} {status} removed")
-    status <- if (is.character(rem)) "successfully" else "could not be"
-    cli::cli_alert_info("local remote {.file {rem}} {status} removed")
+    if (is.character(rem)) {
+      cli::cli_alert_info("local remote {.file {rem}} successfully removed")
+    } else {
+      cli::cli_alert_info("local remote could not be removed")
+    }
   }
 }, teardown_env())