Merge pull request #135 from carpentries/list-draft-episodes

List draft episodes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.0.0.9032
+Version: 0.0.0.9033
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",

NAMESPACE

@@ -9,6 +9,7 @@ export(create_episode)
 export(create_lesson)
 export(fetch_github_workflows)
 export(get_config)
+export(get_drafts)
 export(get_dropdown)
 export(get_episodes)
 export(get_instructors)

NEWS.md

@@ -1,3 +1,18 @@
+# sandpaper 0.0.0.9033
+
+NEW FEATURES
+------------
+
+ - `get_drafts()` will report any markdown files that are not currently 
+   published in the lesson.
+ - Draft alert notifications are controlled by the `"sandpaper.show_draft"`
+   option. To turn off these messages, use 
+   `options(sandpaper.show_draft = FALSE)`
+ - The `set_dropdown()` family of functions will now throw an error if an 
+   author attempts to add a file that does not exist
+ - An error will occurr if the files listed in `config.yaml` do not exist in the
+   lesson with an informative message highlighting the files that are missing.
+
 # sandpaper 0.0.0.9032
 
 MISC

R/build_lesson.R

@@ -24,7 +24,7 @@
 #' create_lesson(tmp, open = FALSE)
 #' create_episode("first-script", path = tmp)
 #' check_lesson(tmp)
-#' if (rmarkdown::pandoc_available())
+#' if (rmarkdown::pandoc_available("2.11"))
 #'   build_lesson(tmp)
 build_lesson <- function(path = ".", rebuild = FALSE, quiet = !interactive(), preview = TRUE, override = list()) {
 

R/build_markdown.R

@@ -22,7 +22,7 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE) {
   outdir       <- path_built(path)
 
   # Determine build status for the episodes ------------------------------------
-  source_list    <- get_resource_list(path)
+  source_list    <- get_resource_list(path, warn = !quiet)
   sources        <- unlist(source_list, use.names = FALSE)
   names(sources) <- get_slug(sources)
 
@@ -92,8 +92,6 @@ build_markdown <- function(path = ".", rebuild = FALSE, quiet = FALSE) {
   invisible(db$build)
 }
 
-
-
 remove_rendered_html <- function(episodes) {
   htmls <- fs::path_ext_set(episodes, "html")
   exists <- fs::file_exists(htmls)

R/check_pandoc.R

@@ -32,7 +32,8 @@ check_pandoc <- function(quiet = TRUE, pv = "2.11", rv = "1.4") {
       pan_msg <- "You do not have pandoc installed on your PATH"
     }
     if (Sys.getenv("RSTUDIO", "0") == "1") {
-      rs_ver <- rstudioapi::getVersion()
+      # catch error for tests
+      rs_ver <- tryCatch(rstudioapi::getVersion(), error = function(e) "0.99")
       if (rs_ver < rv) {
         install_msg <- paste(
           "Please update your version of RStudio Desktop to version", 

R/get_drafts.R

@@ -0,0 +1,40 @@
+#' Show files in draft form
+#'
+#' By default, {sandpaper} will use the files in alphabetical order as they are
+#' presented in the folders, however, it is **strongly** for authors to specify
+#' the order of the files in their lessons, so that it's easy to rearrange or
+#' add, split, or rearrange files. 
+#'
+#' This mechanism also allows authors to work on files in a draft form without
+#' them being published. This function will list and show the files in draft for
+#' automation and audit.
+#'
+#' @param path path to the the sandpaper lesson
+#' @param folder the specific folder for which to list the draft files. Defaults
+#'   to `NULL`, which indicates all folders listed in `config.yaml`.
+#' @param message if `TRUE` (default), an informative message about the files
+#'   that are in draft status are printed to the screen.
+#' @export
+#'
+#' @return a vector of paths to files in draft and a message (if specified)
+get_drafts <- function(path, folder = NULL, message = getOption("sandpaper.show_draft", TRUE)) {
+  cfg <- get_config(path)
+  if (is.null(folder)) {
+    folder <- c("episodes", "learners", "instructors", "profiles")
+  }
+  res <- character(0)
+  for (f in folder) {
+    if (is.null(cfg[[f]])) {
+      if (message) message_default_draft(f)
+      next
+    }
+    drafts <- get_sources(path, f)
+    if (any(in_draft <- fs::path_file(drafts) %nin% cfg[[f]])) {
+      if (message) message_draft_files(cfg[[f]], fs::path_file(drafts), f)
+      res <- c(res, drafts[in_draft])
+    } else {
+      if (message) message_no_draft(f)
+    }
+  }
+  fs::path(res)
+}

R/get_dropdown.R

@@ -44,12 +44,3 @@ get_profiles <- function(path = ".", trim = TRUE) {
   as.character(get_resource_list(path, trim, "profiles", warn = TRUE))
 }
 
-warn_schedule <- function() {
-  msg  <- "No schedule set, using Rmd files in {.file episodes/} directory."
-  msg2 <- "To remove this message, define your schedule in {.file config.yaml}"
-  msg3 <- "or use {.code set_episodes()} to generate it."
-  thm <- cli::cli_div(theme = sandpaper_cli_theme())
-  cli::cli_alert_info(msg)
-  cli::cli_alert(cli::style_dim(paste(msg2, msg3)), class = "alert-suggestion")
-  cli::cli_end(thm)
-}

R/get_syllabus.R

@@ -23,7 +23,7 @@ get_syllabus <- function(path = ".", questions = FALSE, use_built = TRUE) {
   # The syllabus is a table containing timings, links, and questions associated
   # with each episode.
 
-  sched    <- get_episodes(path)
+  sched    <- get_resource_list(path, trim = TRUE, subfolder = "episodes")
   lesson   <- pegboard::Lesson$new(path, jekyll = FALSE, fix_links = FALSE)
   episodes <- lesson$episodes[sched]
 

R/set_dropdown.R

@@ -26,6 +26,14 @@
 #'
 set_dropdown <- function(path = ".", order = NULL, write = FALSE, folder) {
   check_order(order, folder)
+  real_files <- fs::path_file(fs::dir_ls(
+    fs::path(path, folder), 
+    type = "file", 
+    regexp = "[.]R?md"
+  ))
+  if (any(!order %in% real_files)) {
+    error_missing_config(order, real_files, folder)
+  }
   yaml  <- get_config(path)
   sched <- yaml[[folder]] 
   sched <- if (is.null(sched) && folder == "episodes") yaml[["schedule"]] else sched
@@ -48,6 +56,7 @@ set_dropdown <- function(path = ".", order = NULL, write = FALSE, folder) {
   invisible()
 }
 
+
 #' @export
 #' @rdname set_dropdown
 set_episodes <- function(path = ".", order = NULL, write = FALSE) {

R/utils-cli.R

@@ -0,0 +1,108 @@
+remove_cli_decoration <- function(msg) {
+  msg <- gsub("[}] ", "` ", msg)
+  gsub(" [{][^ ]*[ ]?", " `", msg)
+}
+
+sandpaper_cli_theme <- function() {
+  list(
+    ul = list(
+      "list-style-type" = function() "-"
+      ),
+    ".alert-warning" = list(
+      before = function() paste0(cli::col_yellow(cli::symbol$cirle), " ")
+      ),
+    ".alert-danger" = list(
+      before = function() paste0(cli::col_red("!"), " ")
+      ),
+    ".alert-success" = list(
+      before = function() paste0(cli::col_cyan(cli::symbol$circle_filled), " ")
+      ),
+    ".alert-suggestion" = list(
+      "font-style" = "italic"
+      ),
+    NULL
+  )
+}
+
+warn_schedule <- function() {
+  msg  <- "No schedule set, using Rmd files in {.file episodes/} directory."
+  msg2 <- "To remove this message, define your schedule in {.file config.yaml}"
+  msg3 <- "or use {.code set_episodes()} to generate it."
+  thm <- cli::cli_div(theme = sandpaper_cli_theme())
+  cli::cli_alert_info(msg)
+  cli::cli_alert(cli::style_dim(paste(msg2, msg3)), class = "alert-suggestion")
+  cli::cli_end(thm)
+}
+
+show_changed_yaml <- function(sched, order, yaml, what = "episodes") {
+
+  # display for the user to distinguish what was added and what was taken 
+  removed <- sched %nin% order
+  added   <- order %nin% sched
+  thm <- cli::cli_div(theme = sandpaper_cli_theme())
+  on.exit(cli::cli_end(thm))
+  pid <- cli::cli_par()
+  cli::cli_text("{what}:")
+  lid <- cli::cli_ul()
+  for (i in seq(order)) {
+    if (added[i]) {
+      thing <- cli::style_bold(cli::col_cyan(order[i]))
+    } else {
+      thing <- order[i]
+    }
+    cli::cli_li("{thing}")
+  }
+  cli::cli_end(lid)
+  cli::cli_end(pid)
+  if (any(removed)) {
+    cli::cli_rule("Removed {what}")
+    lid <- cli::cli_ul()
+    the_removed <- sched[removed]
+    for (i in the_removed) {
+      cli::cli_li("{cli::style_italic(i)}")
+    }
+    cli::cli_end(lid)
+
+  }
+}
+
+message_default_draft <- function(subfolder) {
+  message_no_draft(subfolder, " (config.yaml empty)")
+}
+
+message_no_draft <- function(subfolder, append = "") {
+  thm <- cli::cli_div(theme = sandpaper_cli_theme())
+  on.exit(cli::cli_end(thm), add = TRUE)
+  cli::cli_alert_info("All files in {.file {subfolder}/} published{append}")
+}
+
+message_draft_files <- function(hopes, real_files, subfolder) {
+  thm <- cli::cli_div(theme = sandpaper_cli_theme())
+  on.exit(cli::cli_end(thm), add = TRUE)
+  dreams <- fs::path(subfolder, real_files[real_files %nin% hopes])
+  if (length(dreams)) {
+    cli::cli_alert_info(
+      "{.emph Files are in draft: {.file {dreams}}}"
+    )
+  }
+}
+
+error_missing_config <- function(hopes, reality, subfolder) {
+  thm <- cli::cli_div(theme = sandpaper_cli_theme())
+  on.exit(cli::cli_end(thm), add = TRUE)
+  broken_dreams <- hopes %nin% reality
+  cli::cli_text("{subfolder}:")
+  lid <- cli::cli_ul()
+  for (i in seq(hopes)) {
+    if (broken_dreams[i]) {
+      cli::cli_li("{cli::symbol$cross} {.strong {hopes[i]}}")
+    } else {
+      cli::cli_li("{.file {hopes[i]}}")
+    }
+  }
+  cli::cli_end(lid)
+  cli::cli_abort(c(
+    "All files in {.file config.yaml} must exist",
+    "*" = "Files marked with {cli::symbol$cross} are not present"
+  ))
+}

R/utils-paths-source.R

@@ -1,5 +1,5 @@
 # All of these helper functions target the source of the lesson... that is, all
-# of the files that git tracks. 
+# of the files that git tracks.
 path_config <- function(path) {
   home <- root_path(path)
   fs::path(home, "config.yaml")
@@ -31,7 +31,7 @@ path_profiles <- function(inpath) {
 #' @param trim if `TRUE`, trim the paths to be relative to the lesson directory.
 #'   Defaults to `FALSE`, which will return the absolute paths
 #' @param subfolder the subfolder to check. If this is `NULL`, all folders will
-#'   checked and returned (default), otherwise, this should be a string 
+#'   checked and returned (default), otherwise, this should be a string
 #'   specifying the folder name in the lesson (e.g. "episodes").
 #' @param warn if `TRUE` and `subfolder = "episodes"`, a message is issued to
 #'   the user if the episodes field of the configuration file is empty.
@@ -44,6 +44,7 @@ get_resource_list <- function(path, trim = FALSE, subfolder = NULL, warn = FALSE
   root_path <- root
   recurse <- 1L
   cfg  <- get_config(root)
+  should_warn <- warn && is.null(cfg[["episodes"]])
   use_subfolder <- !is.null(subfolder) &&
     length(subfolder) == 1L &&
     is.character(subfolder)
@@ -70,13 +71,13 @@ get_resource_list <- function(path, trim = FALSE, subfolder = NULL, warn = FALSE
       ), call. = FALSE)
     }
 
-    should_warn <- warn && is_episodes && is.null(cfg[["episodes"]])
-    if (should_warn) warn_schedule()
+    should_warn <- should_warn && is_episodes
 
     recurse   <- FALSE
     root_path <- fs::path(root, subfolder)
   }
 
+  if (should_warn) warn_schedule()
 
   res <- fs::dir_ls(
     root_path,
@@ -100,23 +101,17 @@ get_resource_list <- function(path, trim = FALSE, subfolder = NULL, warn = FALSE
   } else {
     res <- split(res, fs::path_rel(fs::path_dir(res), root))
   }
-  
+
   if (use_subfolder) {
     names(res) <- subfolder
   } else {
     subfolder <- c("episodes", "learners", "instructors", "profiles")
   }
 
-  # These are the only four items that we need to consider order for. 
+  # These are the only four items that we need to consider order for.
   for (i in subfolder) {
-    config_order <- cfg[[i]]
     # If the configuration is not missing, then we have to rearrange the order.
-    if (!is.null(config_order)) {
-      # Confirm that the order exists
-      paths         <- res[[i]]
-      default_order <- fs::path_file(paths)
-      res[[i]]      <- paths[match(config_order, default_order, nomatch = 0)]
-    }
+    res[[i]] <- parse_file_matches(res[[i]], cfg[[i]], warn = warn, i)
   }
   if (use_subfolder) res[[subfolder]] else res[names(res) != "site"]
 }
@@ -128,10 +123,32 @@ get_sources <- function(path, subfolder = "episodes") {
 
 get_artifacts <- function(path, subfolder = "episodes") {
   pe <- enforce_dir(fs::path(root_path(path), subfolder))
-  fs::dir_ls(pe, regexp = "*R?md", 
-    invert = TRUE, 
-    type = "file", 
+  fs::dir_ls(pe, regexp = "*R?md",
+    invert = TRUE,
+    type = "file",
     all = TRUE
   )
 }
 
+parse_file_matches <- function(reality, hopes = NULL, warn = FALSE, subfolder) {
+  if (is.null(hopes)) {
+    return(reality)
+  }
+  real_files <- fs::path_file(reality)
+  # Confirm that the order exists
+  matches <- match(hopes, real_files, nomatch = 0)
+
+  missing_config <- any(matches == 0)
+
+  if (missing_config) {
+    error_missing_config(hopes, real_files, subfolder)
+  }
+
+  show_drafts <- warn && getOption("sandpaper.show_draft", FALSE)
+
+  if (show_drafts) {
+    message_draft_files(hopes, real_files, subfolder)
+  }
+
+  reality[matches]
+}

R/utils-paths.R

@@ -50,11 +50,3 @@ get_markdown_files <- function(path = NULL) {
   )
 }
 
-get_built_buddy <- function(path) {
-  pat <- fs::path_ext_set(get_slug(path), "md")
-  # Returns nothing if the pattern cannot be found
-  fs::dir_ls(path_built(path), regexp = pat, fixed = TRUE)
-}
-
-
-